115 files changed, 127432 insertions, 4 deletions

diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in
index 0ec24cdef95..bd687a9ac8f 100644
--- a/Build/source/texk/web2c/Makefile.in
+++ b/Build/source/texk/web2c/Makefile.in
@@ -1,4 +1,4 @@
-# $Id: //depot/Build/source.development/TeX/texk/web2c/Makefile.in#66 $
+# $Id$
 # @configure_input@
 # Makefile for web2c --kb@mail.tug.org. Public domain.
 version = @WEB2CVERSION@
@@ -555,6 +555,7 @@ trip-clean:
 # 
 # Helper makefile fragment for pdf*tex.
 kpse_include pdftexdir/pdftexlib.mk
+#LUATEXkpse_include pdftexdir/luatexlib.mk
 # 
 # Makefile fragments:
 kpse_include etexdir/etex.mk
@@ -562,6 +563,7 @@ kpse_include omegadir/omega.mk
 kpse_include alephdir/aleph.mk
 kpse_include pdftexdir/pdftex.mk
 kpse_include xetexdir/xetex.mk
+#LUATEXkpse_include luatexdir/luatex.mk
 
 # 
 # non-engine programs.
@@ -575,7 +577,8 @@ programs = bibtex ctangle ctie cweave dvicopy dvitomp dvitype gftodvi gftopk \
 engines = $(tex) $(etex) $(mf) $(mfn) $(metapost) \
           $(omega) $(aleph) \
           $(pdftex) $(pdfetex) \
-          $(xetex)
+          $(xetex) #LUATEX\
+#LUATEX          $(luatex)
 
 programs: $(programs) $(engines) $(mpware_programs) \
           $(omegafonts_programs) $(otps_programs) $(pdftosrc)
@@ -1125,7 +1128,7 @@ installcheck:
 
 # 
 # Cleaning.
-all_subdirs = doc lib man $(mpware) web2c window $(omegafonts) $(otps) $(pdftexdir) $(mpostdir)
+all_subdirs = doc lib man $(mpware) web2c window $(omegafonts) $(otps) $(pdftexdir) $(mpostdir) #LUATEX $(luatexdir)
 
 # Having a multiple-target rule with the subdir loop fails because of
 # the dependencies introduced by clean.mk.  Yet, we want the
diff --git a/Build/source/texk/web2c/luatexdir/.indent.pro b/Build/source/texk/web2c/luatexdir/.indent.pro
new file mode 100644
index 00000000000..e9e690f1ba8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/.indent.pro
@@ -0,0 +1,12 @@
+/* $Id$ */
+--k-and-r-style
+--blank-lines-after-procedures
+--line-length 80
+--procnames-start-lines
+--no-space-after-function-call-names
+--dont-break-procedure-type
+--space-after-cast
+/* this does not work in indent 2.2.6 :-( */
+--no-tabs
+/* this is new in indent 2.2.9 */
+--preprocessor-indentation 2
diff --git a/Build/source/texk/web2c/luatexdir/ChangeLog b/Build/source/texk/web2c/luatexdir/ChangeLog
new file mode 100644
index 00000000000..d6004e43700
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ChangeLog
@@ -0,0 +1,69 @@
+2004-08-21  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch2: Adapted to e-TeX version 2.2.
+
+2004-08-26  Olaf Weber  <olaf@infovore.xs4all.nl>
+
+	* pdfetexextra.in: File was renamed from pdftexextra.h; the
+	current pdfTeX and e-TeX versions are substituted from
+	../pdftexdir/pdftex.version and ../etexdir/etex.version.  Variant
+	of code supplied by Peter Breitenlohner <peb@mppmu.mpg.de>.
+
+	* pdfetex.mk: Added rule to insert pdfTeX and e-TeX versions into
+	pdfetexextra.h.  Variant of code supplied by Peter Breitenlohner
+	<peb@mppmu.mpg.de>.
+
+2004-08-25  Olaf Weber  <olaf@infovore.xs4all.nl>
+
+	* pdfetex.mk: vadjust.ch moved from pdfxtexdir to pdftexdir.
+
+2004-08-17  Olaf Weber  <olaf@infovore.xs4all.nl>
+
+	* pdfetex.mk: Resurrected etex.fix, there is again a need to
+	include late-breaking changes.
+
+2004-07-29  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch[12]: Somewhat rearrange handling of kern and math
+	nodes in order to reduce interference between eTeX and pdfTeX
+	change files.
+
+	* pdfetex.ch1 (hlist_out): Keep full mixed direction typesetting
+	code.
+
+2004-07-25  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch[12]: Reorganize additional command codes for convert
+	and last_item in order to reduce interference between eTeX and
+	pdfTeX change files.
+
+2004-07-23  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch[12], tex.ch[01]: Reorganize handling of banner
+	string in order to reduce interference between eTeX, pdfTeX,
+	and web2c change files.
+
+2004-07-22  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch[12]: Removed unused token types for pdfTeX's
+	additional token list parameters.
+
+2004-07-19  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.ch[12], tex.ch0: Reorganize handling of additional
+	token list and integer parameters and e-TeX's additional
+	penalties in order to reduce interference between eTeX, pdfTeX,
+	and web2c change files.
+
+	* pdfetex.mk (pdfetex.ch): Remove tex.ch2 from build rules.
+
+	* tex.ch2: Removed.
+
+2004-07-17  Peter Breitenlohner <peb@mppmu.mpg.de>
+
+	* pdfetex.mk: Rewrite build rules for pdfetex.{web,ch},
+	remove etex.{ch0,ch1,fix}, tex.ch2, and several non-dependencies.
+
+	* pdfetex.ch2: Adapt to eTeX changes.
+
+	* ChangeLog: New file.
diff --git a/Build/source/texk/web2c/luatexdir/Makefile.in b/Build/source/texk/web2c/luatexdir/Makefile.in
new file mode 100644
index 00000000000..a959a42d56b
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/Makefile.in
@@ -0,0 +1,141 @@
+# Makefile for libpdf - te@dbs.uni-hannover.de
+# $Id$
+
+kpse_include ../make/common.mk
+kpse_include ../make/programs.mk
+kpse_include ../make/library.mk
+
+kpathsea_srcdir_parent = $(srcdir)/../..
+kpathsea_dir_parent = ../..
+
+ALL_CXXFLAGS = @CXXFLAGS@ @DEFS@ $(XXCFLAGS) -I. -I$(srcdir) -I$(kpathsea_dir_parent) -I$(kpathsea_srcdir_parent) @LIBXPDFCPPFLAGS@ -I$(LIBOBSDCOMPATDIR) -I$(LIBOBSDCOMPATDIR)/.. -I$(LIBOBSDCOMPATFSRCDIR) -I$(LIBOBSDCOMPATFSRCDIR)/.. -I$(LIBPNGSRCDIR) -I$(ZLIBSRCDIR)
+CXX = @CXX@
+
+CTANGLE = ../ctangle
+
+.SUFFIXES: .cc .o
+.cc.o:
+	$(CXX) $(ALL_CXXFLAGS) -c $< -o $@
+
+# XCFLAGS=-Wstrict-prototypes -Wmissing-prototypes 
+
+LIBPNGDIR=../../../libs/libpng
+LIBPNGSRCDIR=$(srcdir)/$(LIBPNGDIR)
+
+ZLIBDIR=../../../libs/zlib
+ZLIBSRCDIR=$(srcdir)/$(ZLIBDIR)
+
+LIBXPDFDIR=../../../libs/xpdf
+LIBXPDFSRCDIR=$(srcdir)/$(LIBXPDFDIR)
+
+LIBMD5DIR=../../../libs/md5
+LIBMD5SRCDIR=$(srcdir)/$(LIBMD5DIR)
+
+LIBOBSDCOMPATDIR=../../../libs/obsdcompat
+LIBOBSDCOMPATFSRCDIR=$(srcdir)/$(LIBOBSDCOMPATDIR)
+
+XCPPFLAGS=-I.. -I$(srcdir)/.. -I../.. -I$(srcdir)/../.. -I$(LIBMD5DIR) \
+  -I$(LIBMD5SRCDIR) @LIBPNGCPPFLAGS@ @ZLIBCPPFLAGS@ \
+  -I$(LIBXPDFDIR) -I$(LIBXPDFDIR)/.. -I$(LIBXPDFSRCDIR) -I$(LIBXPDFSRCDIR)/.. \
+  -I$(LIBOBSDCOMPATDIR) -I$(LIBOBSDCOMPATDIR)/.. -I$(LIBOBSDCOMPATFSRCDIR) \
+  -I$(LIBOBSDCOMPATFSRCDIR)/.. -DpdfTeX
+
+
+OBJS = \
+avl.o \
+avlstuff.o \
+font/mapfile.o \
+font/pkin.o \
+font/subfont.o \
+font/tounicode.o \
+font/vfpacket.o \
+font/writeenc.o \
+font/writefont.o \
+font/writet1.o \
+font/writet3.o \
+font/writettf.o \
+font/writetype0.o \
+font/writetype2.o \
+font/writecff.o \
+font/tt_glyf.o \
+font/tt_table.o \
+font/sfnt.o \
+font/texfont.o \
+font/tfmofm.o \
+font/vfovf.o \
+font/luafont.o \
+font/dofont.o \
+image/epdf.o \
+image/pdftoepdf.o \
+image/writeimg.o \
+image/writejbig2.o \
+image/writejpg.o \
+image/writepng.o \
+lua/loslibext.o \
+lua/lcallbacklib.o \
+lua/lkpselib.o \
+lua/llualib.o \
+lua/lnodelib.o \
+lua/lpdflib.o \
+lua/lstatslib.o \
+lua/ltexiolib.o \
+lua/ltexlib.o \
+lua/ltokenlib.o \
+lua/lfontlib.o \
+lua/texluac.o \
+lua/luainit.o \
+lua/luastuff.o \
+lua/luatex.o \
+lua/luatoken.o \
+lua/luanode.o \
+lua/llanglib.o \
+lua/limglib.o \
+lua/mp.o \
+lua/psout.o \
+lua/lmplib.o \
+lang/hnjalloc.o \
+lang/hyphen.o \
+lang/texlang.o \
+tex/linebreak.o \
+tex/postlinebreak.o \
+tex/texnodes.o \
+tex/textoken.o \
+tex/texpdf.o \
+managed-sa.o \
+mathcodes.o \
+textcodes.o \
+utils.o \
+writezip.o
+
+all: libpdf.a makecpool
+
+libpdf.a: lua/mp.c lua/psout.c $(OBJS)
+	rm -f $@
+	$(AR) $(ARFLAGS) $@  $(OBJS)
+	$(RANLIB) $@
+
+lua/mp.c: lua/mp.w
+	$(CTANGLE) $(srcdir)/lua/mp.w - lua/mp.c
+
+lua/psout.c: lua/psout.w
+	$(CTANGLE) $(srcdir)/lua/psout.w - lua/psout.c
+
+makecpool: makecpool.o
+	$(link_command) makecpool.o
+
+kpse_include ../make/clean.mk
+
+clean::
+	rm -f libpdf.a ttf2afm pdftosrc
+
+depend:
+	rm -f $(OBJS) $(srcdir)/depend.mk
+	for a in $(OBJS);  do 	                                       \
+		env XXCFLAGS="-MM -MT \$$@" XCFLAGS="-MM -MT \$$@" $(MAKE) -k $$a;                 \
+		touch $$a;                                                 \
+		grep -a -v "^$(CC)\|$(CXX)\|$(AR)\|make\|klibtool" $$a |   \
+		sed 's: [^ ]*/\.\./libs/[^ ]*::g' >> $(srcdir)/depend.mk;  \
+	done;                                                          \
+	rm -f $(OBJS)
+
+kpse_include luatexdir/depend.mk
diff --git a/Build/source/texk/web2c/luatexdir/NEWS b/Build/source/texk/web2c/luatexdir/NEWS
new file mode 100644
index 00000000000..626b5c95a0b
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/NEWS
@@ -0,0 +1,537 @@
+---------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-beta-20060811 was released on 2006-08-11
+---------------------------------------------------------------
+- renamed primitives: 
+    \primitive -> \pdfprimitive
+    \ifprimitive -> \ifpdfprimitive
+    \ifabsdim -> \ifpdfabsdim
+    \ifabsnum -> \ifpdfabsnum
+- new version of \primitive/\ifprimitive (but see above)
+- new dimen: \pdfpxdimen
+- support for jbig2 files
+- new library: obsdcompat, which has improved string functions and allows the
+  use of __attribute__
+- update libpng to 1.2.12
+- added JFIF detection patch to writejpg.c (was bug 548)
+- bugfix: truetype OS/2 v3 fonts (594)
+- bugfix: file with only \immediate\pdfobj stream results in garbage (505)
+- bugfix: invalid pdf created if font name contains space (509)
+
+---------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-beta-20060725 was released on 2006-07-25
+---------------------------------------------------------------
+- added patches by Christian Schenk forwarded by Hartmut
+- added patch 421 (popen) from Taco
+- added lots of (void) to writettf* and ttf2afm to silence the compiler
+- removed some unused variables from tounicode.c
+- add new code by Thanh (patch 580)
+- added security patch for xpdf :-(
+- added JFIF detection patch to writejpg.c (bug 548)
+
+---------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-beta-20060213 was released on 2006-02-13
+---------------------------------------------------------------
+- pdftex.web has been improved a bit
+- new patch:
+  - 473 \ifabsnum and \ifabsdim
+- the manual has been updated a bit and is again included
+
+---------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-beta-20060125 was released on 2006-01-25
+---------------------------------------------------------------
+- pdfTeX now includes pdfeTeX, i.e. there is no way to make a binary without
+  eTeX support. Also the sources of TeX, eTeX and pdfTeX have been merged into
+  one file pdftex.web
+- most pdfTeX change files are gone; only one file (pdftex.ch) remains.
+- improved patches:
+  - 393 Ensure newline before endstream
+
+---------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-beta-20060117 was released on 2006-01-17
+---------------------------------------------------------------
+- pdfTeX is now pdfeTeX, i.e. there is no way to make a binary without eTeX
+  support. Also the sources of TeX, eTeX and pdfTeX have been merged into one
+  file pdfetex.web
+- strip trailing zeros in fractions of reals written
+- removed patch 467 \ifindef
+- improved logging of objstreams
+
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20060111 was released on 2006-01-11
+----------------------------------------------------------------
+- new patches:
+  - 466 \primitive and \ifprimitive
+  - 467 \ifinedef
+- improved patches:
+  - 393 Ensure newline before endstream
+- pdfTeX now sets /ModDate and /Trapped by default (the values can be
+  overridden with /pdfinfo)
+- more fixes to remove warnings from -Wall
+
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20060106 was released on 2006-01-06
+----------------------------------------------------------------
+- many small fixes to remove warnings from -Wall
+- removed some unused variables
+- really fix bug 444
+- add some GCC extensions and use *nprintf instead of *printf where possible
+- fixed a unicode bug in ttf2afm
+  
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20051226 was released on 2005-12-26
+----------------------------------------------------------------
+- improved patches:
+  - 453	Object Streams for PDF-1.5
+  - take PK resolution from "pk_dpi" parameter in  texmf.cnf, if it has not
+    been set by the format file or by the user
+  - 432	Rules in a PDF qQ group
+- some fixes for Thanhs patch
+- some improvements from -Wall
+- .indent.pro for indent
+
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20051221 was released on 2005-12-21
+----------------------------------------------------------------
+- has a large patch from Thanh
+- pdflastlink has been fixed
+- remove generated pdf in case of fatal error
+
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20051208 was released on 2005-12-08
+----------------------------------------------------------------
+- improved patches:
+  - 386	grow obj_tab and dest_names arrays dynamically
+  - 453	Object Streams for PDF-1.5
+  - take PK resolution from "pk_dpi" parameter in  texmf.cnf, if it has not
+    been set by the format file or by the user
+- write out PDF statistics later to make them correct
+- makefile target pdfetex-all.pdf for a huge file
+
+----------------------------------------------------------------
+pdfTeX 3.141592-1.40.0-alpha-20051205 was released on 2005-12-05
+----------------------------------------------------------------
+- has these patches:
+  - 386	grow obj_tab and dest_names arrays dynamically
+  - 416	new primitive pdflastlink
+  - 427	Character positioning patch
+  - 432	Rules in a PDF qQ group
+  - 434	Remove queued map item handling
+  - 438	\pdfsavepos in DVI mode
+  - 443	512 zeros in Type1 fonts not copied anymore
+  - 447	Don't write /Encoding for non-reencoded fonts
+  - 453	Object Streams for PDF-1.5
+  - take PK resolution from "pk_dpi" parameter in  texmf.cnf, if it has not
+    been set by the format file or by the user
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.6 was released on 2006-02-16
+-------------------------------------------------
+- bugfix: updated xpdf to 3.01pl2
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.5 was released on 2005-12-04
+-------------------------------------------------
+- bugfix: \pdfximage prints the file name twice (bug 441)
+- bugfix: buffer overflow with \pdfmatch (bug 444)
+- bugfix: updated xpdf to 3.01pl1
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.4 was released on 2005-10-17
+-------------------------------------------------
+- bugfix: whitespaces in filenames didn't work on Unix anymore (bug 377)
+- bugfix: two \immediates cancel themselves (bug 437)
+- bugfix: wrong file name in error messages of image inclusion (bug 435)
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.3 was released on 2005-09-04
+-------------------------------------------------
+- bugfix: \write18
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.2 was released on 2005-08-25
+-------------------------------------------------
+- fixed some build problems and minor bugs introduced in 1.30.1
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.1 was released on 2005-08-21
+-------------------------------------------------
+- the eTeX extensions can now be enabled with the cmdline switch -etex
+- pdfTeX uses xpdf 3.01
+
+-------------------------------------------------
+pdfTeX 3.141592-1.30.0 was released on 2005-08-01
+-------------------------------------------------
+- pdfxtex (introduced with 1.20a) is gone; all extensions are now in pdf(e)tex.
+- Some primitives have been renamed; the old names will still work, but are
+  deprecated and some give a warning that they are obsolete:
+    \pdfoptionpdfminorversion         -> \pdfminorversion
+    \pdfoptionalwaysusepdfpagebox     -> \pdfforcepagebox
+    \pdfoptionpdfinclusionerrorlevel  -> \pdfinclusionerrorlevel
+- pdftex knows two new units:
+  - new Didot (1nd=0.375mm)
+  - new Cicero (1nc=12nd)
+- New primitives: 
+  - Inclusion of pngs has been greatly improved: It now does
+    - alpha channel and transparency (only if %!PDF >=1.4)
+    - 16-bit colour (only if %!PDF >=1.5); this must be enabled by setting
+      \pdfimagehicolor to 1.
+    - gamma correction; this must be enabled by setting \pdfimageapplygamma to
+      1. The device gamma is taken from \pdfgamma. If no embedded value can be
+      found in the png image, then the value of \pdfimagegamma is used instead.
+    - fast direct embedding of png streams, if their structure allows this; the
+      automatic fall-back is to decompress and re-compress as before.
+  - pdfTeX now has an interface to the precise system time (if available) as an
+    aid in benchmarking TeX macro code. 
+    - \pdfelapsedtime is a read-only integer that (initially) returns the
+      amount of time passed since the start of this run. This amount is given
+      in `scaled seconds': the value 65536 counts as one second. If more time
+      has passed than 32767 seconds, (2^31)-1 will be returned.
+    - \pdfresettimer updates the internal timer, such that subsequent calls to
+      \pdfelapsedtime will restart from 0.
+  - pdfTeX can now generate random numbers:
+    - \pdfuniformdeviate <count> generates a uniformly distributed random
+      integer value between 0 (inclusive) and <count> (exclusive).
+    - \pdfnormaldeviate expands to a random integer value with a mean of 0 and
+      a unit of 65536. 
+    - \pdfrandomseed allows access to the current seed value.
+    - \pdfsetrandomseed <count> sets the random seed to a specific value.
+  - \pdfnoligatures\f disables ligatures for the loaded font \f.
+  - Escaping strings:
+    - \pdfescapestring{<a>} escapes the string <a> so that it can be used as
+      PDF string.
+    - \pdfescapename{<a>} escapes the string <a> so that it can be used as PDF
+      name.
+    - \pdfescapehex{<a>} converts the string <a> to uppercase hexadecimal
+      representation.
+    - \pdfunescapehex{<b>} reverses the effect of \pdfescapehex
+  - \pdfcreationdate expands to the date string that pdfTeX uses in the info
+    dict as default.
+  - \pdffilemoddate{<file>} expands to the modification date of <file> in the
+    same format as \pdfcreationdate (PDF date format).
+  - \pdffilesize{<file>} expands to the size of <file> as string.
+  - \pdfmdfivesum{<abc>} or \pdfmdfivesum file {<file>} calculates the md5
+    sum (of a string or a file) and converts it to uppercase hexadecimal format
+    (same as \pdfescapehex).
+  - \pdffiledump [offset <int>] [length <int>] <general text>
+    Expands to a hex dump of the file given in <general text>, starting at
+    given offset or 0 with given length.
+  - \pdfshellescape is a read-only integer that is 1 if \write18 is enabled, 0
+    otherwise.
+  - \pdfxformname <object number>, which expands to the number in the
+    corresponding form XObject name.
+  - \leftmarginkern <box number> and \rightmarginkern <box number> tell the
+    margin kern at the left and right side of the horizontal list stored in box
+    <box number>.
+  - \pdfpkmode is a token register that sets the MF mode for pixel font
+    generation. The contents of this register is dumped into the format, so one
+    can (optionally) preset it e.g. in part of pdftexconfig.tex.
+  - \pdftracingfonts: An integer variable controlling the tracing of font
+    expansion. It is zero by default; then we get a log (with fontexpansion)
+    like this
+    ...\tenrm t
+    ...\tenrm (+20) e
+    Without font expansion, this default should be compatible with TeX's
+    original log output.
+    If \pdftracingfonts is set to 1 (or greater), we get a more verbose log:
+    ...\xivtt (cmtt10@14.0pt) t
+    ...\xivtt (cmtt10+20@14.0pt) e
+    See also bug 304.
+- New experimental primitives:
+  - \pdfmatch [icase] [subcount <number>}] {<pattern>}{<string>}
+    Implements pattern matching using the POSIX regex.
+    It returns the same values as \pdfstrcmp, but with the following semantics: 
+      -1: error case (invalid pattern, ...)
+       0: no match
+       1: match found
+    Options:
+    * icase: case insensitive matching
+    * subcount: it sets the table size for found subpatterns.
+      A number "-1" resets the table size to the start default.
+  - \pdflastmatch <number>
+    The result of \pdfmatch is stored in an array. The entry "0" contains the
+    match, the following entries submatches. The positions of the matches are
+    also available. They are encoded:
+      <position> "->" <match string>
+    The position "-1" with an empty string indicates that this entry is not
+    set.
+  - \pdfstrcmp{<a>}{<b>} compares two strings and returns the strings "0" if
+    <a> equals <b>, "-1" if <a> is less than <b>, "1" if <a> is greater than
+    <b>
+- The primitive \pdfmovechars has been removed (bug 294)
+- Bugfixes:
+  - empty strings are not supressed anymore (bug 335)
+  - \unhboxing and character protusion didn't work well together (bug 292)
+  - --jobname didn't work if there was no filename at all (bug 302)
+  - Some problem with fonts on solaris (bug 315)
+  - Dangling font objects with non-replacable fonts (bug 311).
+  - \pdfxform didn't work with box>255 (bug 310)
+  - cmap: unicode ???? is mapped to multiple glyphs (bug 306).
+- pdfTeX uses zlib 1.2.3
+
+------------------------------------------------
+pdfTeX 3.141592-1.21a was released on 2005-02-04
+------------------------------------------------
+- ttf2afm 1.0:
+    - added support for refering to glyphs via unicode in encoding files (ie 'uniXXX')
+    - added some more info to the AFM output
+    - some minor bug fixes
+    - a short documentation available
+- pdftex now understand forms 'uniXXXX' in encoding files (only makes sense
+  with TrueType fonts)
+- added subset tag for TrueType fonts
+- PDF strings are now printed as following:
+    (This is a string) -> (This is a string)
+    This is a string -> (This is a string)
+    <a1b245c1a2...> -> <a1b245c1a2...>
+- check for double newline char to get rid of empty lines in PDF output
+- Fixed a bug in the scanning of map lines introduced in the fix of bug #242 in
+  1.20b.
+- Fixed three problems in xpdf; xpdf is now 3.00pl3
+- \ifeof18 is a simple method to test if \write18 is enabled.
+- a few extensions in pdfxtex:
+    - \pdflastximagecolordepth returns the last color depth
+    - \pdfximage supports a keyword "colorspace" following an object number
+      representing a ColorSpace object
+    - \pdfstrcmp compares two strings
+    - \pdfescapestring/\pdflastescapedstring provide a way to escape string
+    - \pdffirstlineheight/\pdflastlinedepth/\pdfeachlineheight/\pdfeachlinedepth
+      allow fixing line dimen
+    - patches from Taco
+        - px dimen unit
+        - tagcode patch
+        - quitvmode patch
+
+------------------------------------------------
+pdfTeX 3.141592-1.20b was released on 2004-12-22
+------------------------------------------------
+- Fixed some minor bugs, mostly with hz
+- The info line "output format initialized to PDF/DVI" isn't shown anymore, as
+  this info wasn't reliable (bug 112).
+- Now the PDF-related statistics (PDF objects...) in the .log file is only
+  shown in PDF output mode. It start with a line "PDF statistics:".
+- \pdfimageresolution is not limited to 2400 [dpi] anymore, can now be between
+  0 and 65535 [dpi].
+- pdfTeX uses xpdf 3.00pl2
+- pdfTeX uses libpng 1.2.8, which fixes some png-related bugs.
+
+------------------------------------------------
+pdfTeX 3.141592-1.20a was released on 2004-09-06
+------------------------------------------------
+- There is a new program pdfxtex, which contains experimental features which
+  might end up in pdftex in the future.
+- Most distributions now use eTeX as the default engine, so when you call
+  pdftex you will get pdfeTeX. Most distributions now also use pdfTeX as the
+  default engine, so when you call latex you will get pdfeTeX running LaTeX.:-)
+- We are setting up pdfTeX as a project at sarovar
+  (http://sarovar.org/projects/pdftex/). Please report bugs etc. through the
+  site.
+- Support for the file pdftex.cfg is gone completely. All parameters that had
+  previously been set by it can be set through primitives; their values are
+  dumped to the format file.
+- The searchpath for encoding and mapfiles has been changed.
+  See http://tug.org/pipermail/tex-live/2004-January/004734.html and
+  http://tug.org/pipermail/tex-live/2004-January/004791.html
+- eTeX is now version 2.2, incorporating the last changes to TeX (3.141592).
+- New options for \pdfmapfile:
+  General functionality: Map items (map files, new: also single map lines; see
+  \pdfmapline) are put in list of pending map items. During the next shipout,
+  pending map items are sequentially scanned for their map entries, and an
+  internal map entry database is updated, using the modes below. Then the list
+  of pending map items is cleared. Map entries of fonts already in use are left
+  untouched. New: All \pdfmapfile and \pdfmapline commands can also be given
+  after shipout of the first page.
+  - \pdfmapfile {foo.map} clears the list of pending map items and starts a new
+    list with the only pending file foo.map. When the map entry lines of
+    foo.map are scanned, duplicate map entries are ignored and a warning is
+    issued. This is the old behaviour.
+  - \pdfmapfile {+foo.map} puts foo.map in the list of pending map items. When
+    the map entry lines of foo.map are scanned, duplicate map entries are
+    ignored and a warning is issued.
+  - \pdfmapfile {=foo.map} puts foo.map in the list of pending map items. When
+    foo.map is scanned, matching map entries in database are replaced by new
+    entries from foo.map.
+  - \pdfmapfile {-foo.map} puts foo.map in the list of pending map items. When
+    foo.map is scanned, matching map entries are deleted from database.
+  - \pdfmapfile {} clears the list of pending map items. It does not affect map
+    entries already registered into the database. This is the old behaviour.
+- New command \pdfmapline {line}. It's like \pdfmapfile but here you can set
+  single map lines like in the map files directly. The modifiers (+-=) have the
+  same effect as with \pdfmapfile.
+- Simplified the handling of the 14 Type 1 "standard fonts" (Times,
+  Helvetica...): They are now more or less handled like any other Type 1 font.
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000648.html
+- hz: So far the font expansion feature required that the user must be able to
+  create expanded tfms (eg cmr10+10.tfm). Now font expansion can be used
+  without creating these tfms.
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2004-May/000504.html
+- hz: Changed \pdffontexpand primitive --> the expand factor is now fixed to
+  1000 and the argument is ignored. This will lead to spurious texts of "1000"
+  in your output if you compile old documents.
+- New command \pdftexbanner which returns a string with the full banner of the
+  current binary (e.g. "This is pdfTeX, Version 3.141592-1.20a (Web2C 7.5.3)
+  kpathsea version 3.5.3")
+- The PTEX.FullBanner key is now inserted in the document info dict instead of
+  the catalog. Newer versions of Acrobat display it.
+- Now includes support for encTeX.
+- Extended \pdfannot to use reserveobjnum/useobjnum 
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2004-March/000424.html
+- Bugfix: pdfTeX would read an .xpdfrc when including pdfs.
+  See http://tug.org/pipermail/pdftex/2004-March/004835.html
+- Bugfix: The strings in /ID would sometimes be empty.
+- Bugfix: Even when mapfiles or encodings or PostScript font files were
+  missing, pdfTeX still produced a (most often corrupt) pdf. Now it aborts with
+  an error in these cases.
+- numerous small bugfixes.
+- pdfTeX now uses the GNU libavl from Ben Pfaff for managing of fontmap
+  entries.
+- pdfTeX uses zlib 1.2.1
+- pdfTeX uses xpdf 3.00
+- pdfTeX uses libpng 1.2.7
+  
+------------------------------------------------
+pdfTeX 3.141592-1.11b was released on 2003-10-06
+------------------------------------------------
+- Bugfix: The handling of /Rotate produced displaced images when /Rotate was 90
+  or 270.
+
+------------------------------------------------
+pdfTeX 3.141592-1.11a was released on 2003-08-02
+------------------------------------------------
+- New command \pdftrailer analogue to \pdfcatalog whose argument ends up in the
+  trailer dictionary.
+- The behaviour when an included pdf has a newer version than the one specified
+  with \pdfoptionpdfminorversion can be controlled by the new internal integer
+  \pdfoptionpdfinclusionerrorlevel: If it's 0, pdfTeX gives only a warning; if
+  it's 1, it raises an error. 
+    This can also be set in pdftex.cfg with pdf_inclusion_errorlevel
+- The syntax for outlines has been extended to allow attributes:
+  <outline spec> --> <attr spec> <action spec> [count <number>] <general text>
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000165.html
+- The syntax of \pdfobj has been extended:
+  \pdfobj <object type spec>                              (h, v, m)
+  <object type spec> --> reserveobjnum
+                       | [useobjnum <number>] [<attr spec>] [stream [<attr spec>]] <object contents>
+  <object contents> --> <file spec>
+                      | <general text>
+  When the optional keyword `reserveobjnum' and `useobjnum' is not given, the
+  behaviour is unchanged. 
+  See also http://tug.org/mailman/htdig/pdftex/2003-March/003814.html
+- Bugfix: /CreationDate didn't care for the timezone and could be fooled.
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000223.html
+- Bugfix: The translation of 8-bit characters in included pdfs that had their
+  eighth bit set sometimes got wrong because of a missing typecast.
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2003-July/000216.html
+- Bugfix: pdfTeX -ini would crash with a minimal file because it didn't read
+  it's config and so didn't know anything about fonts.
+  See http://tug.org/pipermail/pdftex/2003-July/004262.html
+- Bugfix: \pdfstartlink would produce spurious /NewWindow entries. Also the
+  syntax of <action spec> and <goto-action spec> has been cleaned up.
+  See http://www.ntg.nl/pipermail/ntg-pdftex/2003-June/000167.html 
+- Bugfix: \pdffontattr was not used for T3 fonts.
+  See http://tug.org/pipermail/pdftex/2003-June/004127.html
+- Bugfix: The cropbox of an included pdf would sometimes not be used.
+  See http://tug.org/pipermail/pdftex/2003-May/004037.html
+- pdfTeX uses xpdf 2.02
+
+------------------------------------------------
+pdfTeX 3.141592-1.10b was released on 2003-02-26
+------------------------------------------------
+- The numbers in transformation matrices are allways written with maximum
+  precision (see http://tug.org/pipermail/pdftex/2003-February/003596.html).
+- Incorporated the new version of TeX: 3.141592
+- Bugfix: Numbers in pdfs would sometimes be just a wee bit of (changed
+  implementation of pdftoepdf.convertNumToPDF).
+- Bugfix: When setting the /Producer, /Creator or /CreationDate keys with
+  /pdfinfo pdfTeX would also insert default values which caused duplicate keys
+  in the info dict (see
+  http://tug.org/pipermail/pdftex/2003-February/003524.html).
+- The reading of mapfiles is much faster (see
+  http://tug.org/pipermail/pdftex/2002-July/002843.html).
+- Bugfix: AR5 had problems with the CTM when displaying in "fit visible" mode
+  (see http://tug.org/pipermail/pdftex/2002-May/002688.html).
+- Bugfix: str_in_str had wrong indices (see
+  http://tug.org/pipermail/pdftex/2002-March/002367.html).
+- Bugfix: decimal_digits defaulted to 0, which caused problems with included
+  images when including pdfs (see
+  http://tug.org/pipermail/pdftex/2003-February/003518.html). 
+  It now defaults to 4.
+- Bugfix: the type of included images was decided based only on the extensions;
+  now pdfTeX looks for magic bytes at the start of files (see
+  http://tug.org/pipermail/pdftex/2003-February/003519.html)
+
+-----------------------------------------------
+pdfTeX 3.14159-1.10a was released on 2003-01-16
+-----------------------------------------------
+- pdfTeX is now able to produce pdf1.4 (which is also the default) and has
+  almost complete support for including pdf1.4 files:
+  - Additional attributes like MetaData are copied from included pdfs.
+  - Currently the Page Group attribute (see sections 7.3.6 and 7.5.5 of the pdf
+    1.4 reference) of included pdfs is NOT copied (as we don't know how to
+    handle this when imposing pdfs). 
+      This means including pdfs with transparency features will work as long as
+    the included pdf doesn't use Page Groups; if it does, the result might not
+    be what is expected (One application known to use Page Groups is Adobe
+    Illustrator v9++). The distributed pdfTeX binaries will give a warning
+    about any occurance of a Page Group in an included pdf and ignore the Page
+    Group (thus producing syntactically correct pdfs but probably not the
+    intended output).  
+      Acrobat 5++ and newer versions of Jaws display files without Page Groups
+    correctly, so this might not really be a problem.  
+      See pdftoepdf.cc for preprocessor flags which allow this behaviour to be
+    changed (copying the Page Group (most likely producing incorrect pdf) or
+    treating Page Groups as errors).
+- The new primitive \pdfoptionpdfminorversion sets the pdf version of the
+  generated file and the latest allowed pdf version of included pdfs:
+        \pdfoptionpdfminorversion=3
+  tells pdfTeX to set the pdf version to 1.3 and allows only included pdfs with
+  versions <= 1.3 . 
+    The default for \pdfoptionpdfminorversion is 4 for pdf 1.4
+    This must appear before any data is written to the generated pdf file, so
+  you should put it at the very start of your files.
+    This can also be set in pdftex.cfg with pdf_minorversion
+- It is now possible to specify the pdf page box to use when including pdfs.
+  The syntax has been extended:
+    \pdfximage [<image attr spec>] <general text>           (h, v, m)
+    <image attr spec> --> [<rule spec>] [<attr spec>] [<page spec>] [<pdf box spec>]
+    <pdf box spec> --> mediabox|cropbox|bleedbox|trimbox|artbox
+  The default is cropbox (which defaults to mediabox), to be compatible with
+  previous versions of pdfTeX.
+    The page box specified at \pdfximage can be globally overridden with the
+  config parameter always_use_pdfpagebox and the command
+  \pdfoptionalwaysusepdfpagebox <integer>, where 0 is the default (use whatever
+  is specified with \pdfximage), 1 is media, 2 is crop, 3 is bleed, 4 is trim
+  and 5 is artbox. This can only be set once per object, i.e. the value used at
+  \pdfximage is remembered.
+    See the pdf reference for an explanation of the boxes.
+- The support for the inclusion of jpeg images has been extended to allow the
+  inclusion of JPEG/Exif files which are produced by digital photo cameras
+  (thanks to Hartmut Henkel).
+- The support for the inclusion of tif images has been removed as it was of
+  limited use (it worked only for gray-scale and rgb images) and produced wrong
+  results (all other images types where treated as rgb images). 
+  Tif images can be converted on *nix on-the-fly to pngs with the help of
+  ImageMagick, epstopdf.sty or pdftex.def v0.4 or newer, and this rule:
+    \DeclareGraphicsRule{.tif}{png}{.png}{`convert #1 `basename #1 .tif`.png}
+- The extensions for pdf encryption have been removed, since they make the
+  pdfTeX code overly complex. Those needing pdf encryption are encouraged to
+  produce a standalone program for encrypting pdfs.
+- pdfTeX now writes a usage statistic about the pdfTeX specific memory to the
+  log.
+- numerous bugfixes, most of them in the inclusion of pdfs.
+- pdfTeX uses xpdf 2.01
+- pdfTeX uses libpng 1.2.5
+
+---------------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20011127-ojmw was released on 2002-01-29
+---------------------------------------------------------------------
+
+----------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20010806 was released on 2001-08-06
+----------------------------------------------------------------
+
+----------------------------------------------------------------
+pdfTeX 3.14159-1.00a-pretest-20010804 was released on 2001-08-04
+----------------------------------------------------------------
+
+$Id$
+// vim: tw=79:ts=2:expandtab:autoindent
diff --git a/Build/source/texk/web2c/luatexdir/README b/Build/source/texk/web2c/luatexdir/README
new file mode 100644
index 00000000000..f1e142f1b25
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/README
@@ -0,0 +1,87 @@
+pdfTeX
+======
+
+README for version 3.14159-1.40.0-beta-20060811
+===============================================
+
+This directory contains the version 1.40.0-alpha-20060811 of pdfTeX, an
+extended version of eTeX that can create PDF directly from TeX source files
+and enhance the result of TeX typesetting with the help of PDF. When PDF
+output is not selected, pdfTeX produces normal DVI output, otherwise it
+produces PDF output that looks identical to the DVI output. An important
+aspect of this project is to investigate alternative justification
+algorithms, optionally making use of multiple master fonts. 
+
+pdfTeX is based on the original eTeX sources and Web2c, and has been
+successfully compiled on Unix, Win32 and DOS systems. It is still under
+development and features may change; it produces reasonable PDF code.
+
+See the file NEWS for changes to the program.
+
+Documentation about pdfTeX can be found at http://www.pdftex.org 
+
+There is also a mailing list on pdfTeX; go to
+http://tug.org/mailman/listinfo/pdftex for more information about it. Its
+searchable archive can be found at http://tug.org/pipermail/pdftex/ 
+Please read http://www.catb.org/~esr/faqs/smart-questions.html before
+asking any questions on the pdfTeX mailing list.
+
+A mailing list for the developement of pdfTeX can be found at
+http://www.ntg.nl/mailman/listinfo/ntg-pdftex
+
+
+LEGAL ISSUES
+============
+
+pdfTeX is copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software Foundation, Inc., 59 Temple
+Place, Suite 330, Boston, MA  02111-1307  USA
+
+pdfTeX uses code from TeX; for these parts the original copyright by Don
+Knuth applies. See the source files for details.
+
+pdfeTeX uses code from eTeX; for these parts the original copyright by
+Peter Breitenlohner applies. See the source files for details.
+
+
+WHAT TO DO IF YOU BELIEVE YOU HAVE FOUND A BUG IN pdfTeX
+========================================================
+
+Please read http://www.chiark.greenend.org.uk/~sgtatham/bugs.html and
+follow the guidelines there. Then go to the sarovar site of pdfTeX
+(http://sarovar.org/projects/pdftex/) and submit your bug report there.
+Here you can also report feature requests or patches.
+
+
+CONTRIBUTORS
+============
+
+Peter Breitenlohner, Ricardo Sanchez Carmenes, Otfried Cheong, Thomas
+Esser, Hans Hagen, Hartmut Henkel, Taco Hoekwater, Pawel Jackowski, Tom
+Kacvinsky, Akira Kakuto, Reinhard Kotucha, Derek B. Noonburg, Heiko
+Oberdiek, Jiri Osoba, Fabrice Popineau, Sebastian Rahtz, Tomas Rokicki,
+Martin Schröder, Petr Sojka, Ralf Utermann, Olaf Weber, Jiri Zlatuska.
+
+pdfTeX is built on top of TeX, written by Donald Knuth cum suis (Liang and
+so), and eTeX, written by Peter Breitenlohner cum suis; part of the
+paragraph optimization is inspired by the work of Hermann Zapf.
+
+
+------------------------------------------------------------------------------
+
+Please send bug reports, offers of help, etc. to martin@pdftex.org
+
+$Id$
+// vim: tw=75
diff --git a/Build/source/texk/web2c/luatexdir/avl.c b/Build/source/texk/web2c/luatexdir/avl.c
new file mode 100644
index 00000000000..a25239e8d93
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/avl.c
@@ -0,0 +1,893 @@
+/* Produced by texiweb from libavl.w. */
+
+/* libavl - library for manipulation of binary trees.
+   Copyright (C) 1998-2002, 2004 Free Software Foundation, Inc.
+
+   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., 59 Temple Place - Suite 330, Boston, MA
+   02111-1307, USA.
+
+   The author may be contacted at <blp@gnu.org> on the Internet, or
+   write to Ben Pfaff, Stanford University, Computer Science Dept., 353
+   Serra Mall, Stanford CA 94305, USA.
+*/
+
+#include <assert.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "avl.h"
+
+/* Creates and returns a new table
+   with comparison function |compare| using parameter |param|
+   and memory allocator |allocator|.
+   Returns |NULL| if memory allocation failed. */
+struct avl_table *
+avl_create (avl_comparison_func *compare, void *param,
+            struct libavl_allocator *allocator)
+{
+  struct avl_table *tree;
+
+  assert (compare != NULL);
+
+  if (allocator == NULL)
+    allocator = &avl_allocator_default;
+
+  tree = allocator->libavl_malloc (allocator, sizeof *tree);
+  if (tree == NULL)
+    return NULL;
+
+  tree->avl_root = NULL;
+  tree->avl_compare = compare;
+  tree->avl_param = param;
+  tree->avl_alloc = allocator;
+  tree->avl_count = 0;
+  tree->avl_generation = 0;
+
+  return tree;
+}
+
+/* Search |tree| for an item matching |item|, and return it if found.
+   Otherwise return |NULL|. */
+void *
+avl_find (const struct avl_table *tree, const void *item)
+{
+  const struct avl_node *p;
+
+  assert (tree != NULL && item != NULL);
+  for (p = tree->avl_root; p != NULL; )
+    {
+      int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+
+      if (cmp < 0)
+        p = p->avl_link[0];
+      else if (cmp > 0)
+        p = p->avl_link[1];
+      else /* |cmp == 0| */
+        return p->avl_data;
+    }
+
+  return NULL;
+}
+
+/* Inserts |item| into |tree| and returns a pointer to |item|'s address.
+   If a duplicate item is found in the tree,
+   returns a pointer to the duplicate without inserting |item|.
+   Returns |NULL| in case of memory allocation failure. */
+void **
+avl_probe (struct avl_table *tree, void *item)
+{
+  struct avl_node *y, *z; /* Top node to update balance factor, and parent. */
+  struct avl_node *p, *q; /* Iterator, and parent. */
+  struct avl_node *n;     /* Newly inserted node. */
+  struct avl_node *w;     /* New root of rebalanced subtree. */
+  int dir;                /* Direction to descend. */
+
+  unsigned char da[AVL_MAX_HEIGHT]; /* Cached comparison results. */
+  int k = 0;              /* Number of cached results. */
+
+  assert (tree != NULL && item != NULL);
+
+  z = (struct avl_node *) &tree->avl_root;
+  y = tree->avl_root;
+  dir = 0;
+  for (q = z, p = y; p != NULL; q = p, p = p->avl_link[dir])
+    {
+      int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+      if (cmp == 0)
+        return &p->avl_data;
+
+      if (p->avl_balance != 0)
+        z = q, y = p, k = 0;
+      da[k++] = dir = cmp > 0;
+    }
+
+  n = q->avl_link[dir] =
+    tree->avl_alloc->libavl_malloc (tree->avl_alloc, sizeof *n);
+  if (n == NULL)
+    return NULL;
+
+  tree->avl_count++;
+  n->avl_data = item;
+  n->avl_link[0] = n->avl_link[1] = NULL;
+  n->avl_balance = 0;
+  if (y == NULL)
+    return &n->avl_data;
+
+  for (p = y, k = 0; p != n; p = p->avl_link[da[k]], k++)
+    if (da[k] == 0)
+      p->avl_balance--;
+    else
+      p->avl_balance++;
+
+  if (y->avl_balance == -2)
+    {
+      struct avl_node *x = y->avl_link[0];
+      if (x->avl_balance == -1)
+        {
+          w = x;
+          y->avl_link[0] = x->avl_link[1];
+          x->avl_link[1] = y;
+          x->avl_balance = y->avl_balance = 0;
+        }
+      else
+        {
+          assert (x->avl_balance == +1);
+          w = x->avl_link[1];
+          x->avl_link[1] = w->avl_link[0];
+          w->avl_link[0] = x;
+          y->avl_link[0] = w->avl_link[1];
+          w->avl_link[1] = y;
+          if (w->avl_balance == -1)
+            x->avl_balance = 0, y->avl_balance = +1;
+          else if (w->avl_balance == 0)
+            x->avl_balance = y->avl_balance = 0;
+          else /* |w->avl_balance == +1| */
+            x->avl_balance = -1, y->avl_balance = 0;
+          w->avl_balance = 0;
+        }
+    }
+  else if (y->avl_balance == +2)
+    {
+      struct avl_node *x = y->avl_link[1];
+      if (x->avl_balance == +1)
+        {
+          w = x;
+          y->avl_link[1] = x->avl_link[0];
+          x->avl_link[0] = y;
+          x->avl_balance = y->avl_balance = 0;
+        }
+      else
+        {
+          assert (x->avl_balance == -1);
+          w = x->avl_link[0];
+          x->avl_link[0] = w->avl_link[1];
+          w->avl_link[1] = x;
+          y->avl_link[1] = w->avl_link[0];
+          w->avl_link[0] = y;
+          if (w->avl_balance == +1)
+            x->avl_balance = 0, y->avl_balance = -1;
+          else if (w->avl_balance == 0)
+            x->avl_balance = y->avl_balance = 0;
+          else /* |w->avl_balance == -1| */
+            x->avl_balance = +1, y->avl_balance = 0;
+          w->avl_balance = 0;
+        }
+    }
+  else
+    return &n->avl_data;
+  z->avl_link[y != z->avl_link[0]] = w;
+
+  tree->avl_generation++;
+  return &n->avl_data;
+}
+
+/* Inserts |item| into |table|.
+   Returns |NULL| if |item| was successfully inserted
+   or if a memory allocation error occurred.
+   Otherwise, returns the duplicate item. */
+void *
+avl_insert (struct avl_table *table, void *item)
+{
+  void **p = avl_probe (table, item);
+  return p == NULL || *p == item ? NULL : *p;
+}
+
+/* Inserts |item| into |table|, replacing any duplicate item.
+   Returns |NULL| if |item| was inserted without replacing a duplicate,
+   or if a memory allocation error occurred.
+   Otherwise, returns the item that was replaced. */
+void *
+avl_replace (struct avl_table *table, void *item)
+{
+  void **p = avl_probe (table, item);
+  if (p == NULL || *p == item)
+    return NULL;
+  else
+    {
+      void *r = *p;
+      *p = item;
+      return r;
+    }
+}
+
+/* Deletes from |tree| and returns an item matching |item|.
+   Returns a null pointer if no matching item found. */
+void *
+avl_delete (struct avl_table *tree, const void *item)
+{
+  /* Stack of nodes. */
+  struct avl_node *pa[AVL_MAX_HEIGHT]; /* Nodes. */
+  unsigned char da[AVL_MAX_HEIGHT];    /* |avl_link[]| indexes. */
+  int k;                               /* Stack pointer. */
+
+  struct avl_node *p;   /* Traverses tree to find node to delete. */
+  int cmp;              /* Result of comparison between |item| and |p|. */
+
+  assert (tree != NULL && item != NULL);
+
+  k = 0;
+  p = (struct avl_node *) &tree->avl_root;
+  for (cmp = -1; cmp != 0;
+       cmp = tree->avl_compare (item, p->avl_data, tree->avl_param))
+    {
+      int dir = cmp > 0;
+
+      pa[k] = p;
+      da[k++] = dir;
+
+      p = p->avl_link[dir];
+      if (p == NULL)
+        return NULL;
+    }
+  item = p->avl_data;
+
+  if (p->avl_link[1] == NULL)
+    pa[k - 1]->avl_link[da[k - 1]] = p->avl_link[0];
+  else
+    {
+      struct avl_node *r = p->avl_link[1];
+      if (r->avl_link[0] == NULL)
+        {
+          r->avl_link[0] = p->avl_link[0];
+          r->avl_balance = p->avl_balance;
+          pa[k - 1]->avl_link[da[k - 1]] = r;
+          da[k] = 1;
+          pa[k++] = r;
+        }
+      else
+        {
+          struct avl_node *s;
+          int j = k++;
+
+          for (;;)
+            {
+              da[k] = 0;
+              pa[k++] = r;
+              s = r->avl_link[0];
+              if (s->avl_link[0] == NULL)
+                break;
+
+              r = s;
+            }
+
+          s->avl_link[0] = p->avl_link[0];
+          r->avl_link[0] = s->avl_link[1];
+          s->avl_link[1] = p->avl_link[1];
+          s->avl_balance = p->avl_balance;
+
+          pa[j - 1]->avl_link[da[j - 1]] = s;
+          da[j] = 1;
+          pa[j] = s;
+        }
+    }
+
+  tree->avl_alloc->libavl_free (tree->avl_alloc, p);
+
+  assert (k > 0);
+  while (--k > 0)
+    {
+      struct avl_node *y = pa[k];
+
+      if (da[k] == 0)
+        {
+          y->avl_balance++;
+          if (y->avl_balance == +1)
+            break;
+          else if (y->avl_balance == +2)
+            {
+              struct avl_node *x = y->avl_link[1];
+              if (x->avl_balance == -1)
+                {
+                  struct avl_node *w;
+                  assert (x->avl_balance == -1);
+                  w = x->avl_link[0];
+                  x->avl_link[0] = w->avl_link[1];
+                  w->avl_link[1] = x;
+                  y->avl_link[1] = w->avl_link[0];
+                  w->avl_link[0] = y;
+                  if (w->avl_balance == +1)
+                    x->avl_balance = 0, y->avl_balance = -1;
+                  else if (w->avl_balance == 0)
+                    x->avl_balance = y->avl_balance = 0;
+                  else /* |w->avl_balance == -1| */
+                    x->avl_balance = +1, y->avl_balance = 0;
+                  w->avl_balance = 0;
+                  pa[k - 1]->avl_link[da[k - 1]] = w;
+                }
+              else
+                {
+                  y->avl_link[1] = x->avl_link[0];
+                  x->avl_link[0] = y;
+                  pa[k - 1]->avl_link[da[k - 1]] = x;
+                  if (x->avl_balance == 0)
+                    {
+                      x->avl_balance = -1;
+                      y->avl_balance = +1;
+                      break;
+                    }
+                  else
+                    x->avl_balance = y->avl_balance = 0;
+                }
+            }
+        }
+      else
+        {
+          y->avl_balance--;
+          if (y->avl_balance == -1)
+            break;
+          else if (y->avl_balance == -2)
+            {
+              struct avl_node *x = y->avl_link[0];
+              if (x->avl_balance == +1)
+                {
+                  struct avl_node *w;
+                  assert (x->avl_balance == +1);
+                  w = x->avl_link[1];
+                  x->avl_link[1] = w->avl_link[0];
+                  w->avl_link[0] = x;
+                  y->avl_link[0] = w->avl_link[1];
+                  w->avl_link[1] = y;
+                  if (w->avl_balance == -1)
+                    x->avl_balance = 0, y->avl_balance = +1;
+                  else if (w->avl_balance == 0)
+                    x->avl_balance = y->avl_balance = 0;
+                  else /* |w->avl_balance == +1| */
+                    x->avl_balance = -1, y->avl_balance = 0;
+                  w->avl_balance = 0;
+                  pa[k - 1]->avl_link[da[k - 1]] = w;
+                }
+              else
+                {
+                  y->avl_link[0] = x->avl_link[1];
+                  x->avl_link[1] = y;
+                  pa[k - 1]->avl_link[da[k - 1]] = x;
+                  if (x->avl_balance == 0)
+                    {
+                      x->avl_balance = +1;
+                      y->avl_balance = -1;
+                      break;
+                    }
+                  else
+                    x->avl_balance = y->avl_balance = 0;
+                }
+            }
+        }
+    }
+
+  tree->avl_count--;
+  tree->avl_generation++;
+  return (void *) item;
+}
+
+/* Refreshes the stack of parent pointers in |trav|
+   and updates its generation number. */
+static void
+trav_refresh (struct avl_traverser *trav)
+{
+  assert (trav != NULL);
+
+  trav->avl_generation = trav->avl_table->avl_generation;
+
+  if (trav->avl_node != NULL)
+    {
+      avl_comparison_func *cmp = trav->avl_table->avl_compare;
+      void *param = trav->avl_table->avl_param;
+      struct avl_node *node = trav->avl_node;
+      struct avl_node *i;
+
+      trav->avl_height = 0;
+      for (i = trav->avl_table->avl_root; i != node; )
+        {
+          assert (trav->avl_height < AVL_MAX_HEIGHT);
+          assert (i != NULL);
+
+          trav->avl_stack[trav->avl_height++] = i;
+          i = i->avl_link[cmp (node->avl_data, i->avl_data, param) > 0];
+        }
+    }
+}
+
+/* Initializes |trav| for use with |tree|
+   and selects the null node. */
+void
+avl_t_init (struct avl_traverser *trav, struct avl_table *tree)
+{
+  trav->avl_table = tree;
+  trav->avl_node = NULL;
+  trav->avl_height = 0;
+  trav->avl_generation = tree->avl_generation;
+}
+
+/* Initializes |trav| for |tree|
+   and selects and returns a pointer to its least-valued item.
+   Returns |NULL| if |tree| contains no nodes. */
+void *
+avl_t_first (struct avl_traverser *trav, struct avl_table *tree)
+{
+  struct avl_node *x;
+
+  assert (tree != NULL && trav != NULL);
+
+  trav->avl_table = tree;
+  trav->avl_height = 0;
+  trav->avl_generation = tree->avl_generation;
+
+  x = tree->avl_root;
+  if (x != NULL)
+    while (x->avl_link[0] != NULL)
+      {
+        assert (trav->avl_height < AVL_MAX_HEIGHT);
+        trav->avl_stack[trav->avl_height++] = x;
+        x = x->avl_link[0];
+      }
+  trav->avl_node = x;
+
+  return x != NULL ? x->avl_data : NULL;
+}
+
+/* Initializes |trav| for |tree|
+   and selects and returns a pointer to its greatest-valued item.
+   Returns |NULL| if |tree| contains no nodes. */
+void *
+avl_t_last (struct avl_traverser *trav, struct avl_table *tree)
+{
+  struct avl_node *x;
+
+  assert (tree != NULL && trav != NULL);
+
+  trav->avl_table = tree;
+  trav->avl_height = 0;
+  trav->avl_generation = tree->avl_generation;
+
+  x = tree->avl_root;
+  if (x != NULL)
+    while (x->avl_link[1] != NULL)
+      {
+        assert (trav->avl_height < AVL_MAX_HEIGHT);
+        trav->avl_stack[trav->avl_height++] = x;
+        x = x->avl_link[1];
+      }
+  trav->avl_node = x;
+
+  return x != NULL ? x->avl_data : NULL;
+}
+
+/* Searches for |item| in |tree|.
+   If found, initializes |trav| to the item found and returns the item
+   as well.
+   If there is no matching item, initializes |trav| to the null item
+   and returns |NULL|. */
+void *
+avl_t_find (struct avl_traverser *trav, struct avl_table *tree, void *item)
+{
+  struct avl_node *p, *q;
+
+  assert (trav != NULL && tree != NULL && item != NULL);
+  trav->avl_table = tree;
+  trav->avl_height = 0;
+  trav->avl_generation = tree->avl_generation;
+  for (p = tree->avl_root; p != NULL; p = q)
+    {
+      int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param);
+
+      if (cmp < 0)
+        q = p->avl_link[0];
+      else if (cmp > 0)
+        q = p->avl_link[1];
+      else /* |cmp == 0| */
+        {
+          trav->avl_node = p;
+          return p->avl_data;
+        }
+
+      assert (trav->avl_height < AVL_MAX_HEIGHT);
+      trav->avl_stack[trav->avl_height++] = p;
+    }
+
+  trav->avl_height = 0;
+  trav->avl_node = NULL;
+  return NULL;
+}
+
+/* Attempts to insert |item| into |tree|.
+   If |item| is inserted successfully, it is returned and |trav| is
+   initialized to its location.
+   If a duplicate is found, it is returned and |trav| is initialized to
+   its location.  No replacement of the item occurs.
+   If a memory allocation failure occurs, |NULL| is returned and |trav|
+   is initialized to the null item. */
+void *
+avl_t_insert (struct avl_traverser *trav, struct avl_table *tree, void *item)
+{
+  void **p;
+
+  assert (trav != NULL && tree != NULL && item != NULL);
+
+  p = avl_probe (tree, item);
+  if (p != NULL)
+    {
+      trav->avl_table = tree;
+      trav->avl_node =
+        ((struct avl_node *)
+         ((char *) p - offsetof (struct avl_node, avl_data)));
+      trav->avl_generation = tree->avl_generation - 1;
+      return *p;
+    }
+  else
+    {
+      avl_t_init (trav, tree);
+      return NULL;
+    }
+}
+
+/* Initializes |trav| to have the same current node as |src|. */
+void *
+avl_t_copy (struct avl_traverser *trav, const struct avl_traverser *src)
+{
+  assert (trav != NULL && src != NULL);
+
+  if (trav != src)
+    {
+      trav->avl_table = src->avl_table;
+      trav->avl_node = src->avl_node;
+      trav->avl_generation = src->avl_generation;
+      if (trav->avl_generation == trav->avl_table->avl_generation)
+        {
+          trav->avl_height = src->avl_height;
+          memcpy (trav->avl_stack, (const void *) src->avl_stack,
+                  sizeof *trav->avl_stack * trav->avl_height);
+        }
+    }
+
+  return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
+}
+
+/* Returns the next data item in inorder
+   within the tree being traversed with |trav|,
+   or if there are no more data items returns |NULL|. */
+void *
+avl_t_next (struct avl_traverser *trav)
+{
+  struct avl_node *x;
+
+  assert (trav != NULL);
+
+  if (trav->avl_generation != trav->avl_table->avl_generation)
+    trav_refresh (trav);
+
+  x = trav->avl_node;
+  if (x == NULL)
+    {
+      return avl_t_first (trav, trav->avl_table);
+    }
+  else if (x->avl_link[1] != NULL)
+    {
+      assert (trav->avl_height < AVL_MAX_HEIGHT);
+      trav->avl_stack[trav->avl_height++] = x;
+      x = x->avl_link[1];
+
+      while (x->avl_link[0] != NULL)
+        {
+          assert (trav->avl_height < AVL_MAX_HEIGHT);
+          trav->avl_stack[trav->avl_height++] = x;
+          x = x->avl_link[0];
+        }
+    }
+  else
+    {
+      struct avl_node *y;
+
+      do
+        {
+          if (trav->avl_height == 0)
+            {
+              trav->avl_node = NULL;
+              return NULL;
+            }
+
+          y = x;
+          x = trav->avl_stack[--trav->avl_height];
+        }
+      while (y == x->avl_link[1]);
+    }
+  trav->avl_node = x;
+
+  return x->avl_data;
+}
+
+/* Returns the previous data item in inorder
+   within the tree being traversed with |trav|,
+   or if there are no more data items returns |NULL|. */
+void *
+avl_t_prev (struct avl_traverser *trav)
+{
+  struct avl_node *x;
+
+  assert (trav != NULL);
+
+  if (trav->avl_generation != trav->avl_table->avl_generation)
+    trav_refresh (trav);
+
+  x = trav->avl_node;
+  if (x == NULL)
+    {
+      return avl_t_last (trav, trav->avl_table);
+    }
+  else if (x->avl_link[0] != NULL)
+    {
+      assert (trav->avl_height < AVL_MAX_HEIGHT);
+      trav->avl_stack[trav->avl_height++] = x;
+      x = x->avl_link[0];
+
+      while (x->avl_link[1] != NULL)
+        {
+          assert (trav->avl_height < AVL_MAX_HEIGHT);
+          trav->avl_stack[trav->avl_height++] = x;
+          x = x->avl_link[1];
+        }
+    }
+  else
+    {
+      struct avl_node *y;
+
+      do
+        {
+          if (trav->avl_height == 0)
+            {
+              trav->avl_node = NULL;
+              return NULL;
+            }
+
+          y = x;
+          x = trav->avl_stack[--trav->avl_height];
+        }
+      while (y == x->avl_link[0]);
+    }
+  trav->avl_node = x;
+
+  return x->avl_data;
+}
+
+/* Returns |trav|'s current item. */
+void *
+avl_t_cur (struct avl_traverser *trav)
+{
+  assert (trav != NULL);
+
+  return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL;
+}
+
+/* Replaces the current item in |trav| by |new| and returns the item replaced.
+   |trav| must not have the null item selected.
+   The new item must not upset the ordering of the tree. */
+void *
+avl_t_replace (struct avl_traverser *trav, void *new)
+{
+  void *old;
+
+  assert (trav != NULL && trav->avl_node != NULL && new != NULL);
+  old = trav->avl_node->avl_data;
+  trav->avl_node->avl_data = new;
+  return old;
+}
+
+/* Destroys |new| with |avl_destroy (new, destroy)|,
+   first setting right links of nodes in |stack| within |new|
+   to null pointers to avoid touching uninitialized data. */
+static void
+copy_error_recovery (struct avl_node **stack, int height,
+                     struct avl_table *new, avl_item_func *destroy)
+{
+  assert (stack != NULL && height >= 0 && new != NULL);
+
+  for (; height > 2; height -= 2)
+    stack[height - 1]->avl_link[1] = NULL;
+  avl_destroy (new, destroy);
+}
+
+/* Copies |org| to a newly created tree, which is returned.
+   If |copy != NULL|, each data item in |org| is first passed to |copy|,
+   and the return values are inserted into the tree,
+   with |NULL| return values taken as indications of failure.
+   On failure, destroys the partially created new tree,
+   applying |destroy|, if non-null, to each item in the new tree so far,
+   and returns |NULL|.
+   If |allocator != NULL|, it is used for allocation in the new tree.
+   Otherwise, the same allocator used for |org| is used. */
+struct avl_table *
+avl_copy (const struct avl_table *org, avl_copy_func *copy,
+          avl_item_func *destroy, struct libavl_allocator *allocator)
+{
+  struct avl_node *stack[2 * (AVL_MAX_HEIGHT + 1)];
+  int height = 0;
+
+  struct avl_table *new;
+  const struct avl_node *x;
+  struct avl_node *y;
+
+  assert (org != NULL);
+  new = avl_create (org->avl_compare, org->avl_param,
+                    allocator != NULL ? allocator : org->avl_alloc);
+  if (new == NULL)
+    return NULL;
+  new->avl_count = org->avl_count;
+  if (new->avl_count == 0)
+    return new;
+
+  x = (const struct avl_node *) &org->avl_root;
+  y = (struct avl_node *) &new->avl_root;
+  for (;;)
+    {
+      while (x->avl_link[0] != NULL)
+        {
+          assert (height < 2 * (AVL_MAX_HEIGHT + 1));
+
+          y->avl_link[0] =
+            new->avl_alloc->libavl_malloc (new->avl_alloc,
+                                           sizeof *y->avl_link[0]);
+          if (y->avl_link[0] == NULL)
+            {
+              if (y != (struct avl_node *) &new->avl_root)
+                {
+                  y->avl_data = NULL;
+                  y->avl_link[1] = NULL;
+                }
+
+              copy_error_recovery (stack, height, new, destroy);
+              return NULL;
+            }
+
+          stack[height++] = (struct avl_node *) x;
+          stack[height++] = y;
+          x = x->avl_link[0];
+          y = y->avl_link[0];
+        }
+      y->avl_link[0] = NULL;
+
+      for (;;)
+        {
+          y->avl_balance = x->avl_balance;
+          if (copy == NULL)
+            y->avl_data = x->avl_data;
+          else
+            {
+              y->avl_data = copy (x->avl_data, org->avl_param);
+              if (y->avl_data == NULL)
+                {
+                  y->avl_link[1] = NULL;
+                  copy_error_recovery (stack, height, new, destroy);
+                  return NULL;
+                }
+            }
+
+          if (x->avl_link[1] != NULL)
+            {
+              y->avl_link[1] =
+                new->avl_alloc->libavl_malloc (new->avl_alloc,
+                                               sizeof *y->avl_link[1]);
+              if (y->avl_link[1] == NULL)
+                {
+                  copy_error_recovery (stack, height, new, destroy);
+                  return NULL;
+                }
+
+              x = x->avl_link[1];
+              y = y->avl_link[1];
+              break;
+            }
+          else
+            y->avl_link[1] = NULL;
+
+          if (height <= 2)
+            return new;
+
+          y = stack[--height];
+          x = stack[--height];
+        }
+    }
+}
+
+/* Frees storage allocated for |tree|.
+   If |destroy != NULL|, applies it to each data item in inorder. */
+void
+avl_destroy (struct avl_table *tree, avl_item_func *destroy)
+{
+  struct avl_node *p, *q;
+
+  assert (tree != NULL);
+
+  for (p = tree->avl_root; p != NULL; p = q)
+    if (p->avl_link[0] == NULL)
+      {
+        q = p->avl_link[1];
+        if (destroy != NULL && p->avl_data != NULL)
+          destroy (p->avl_data, tree->avl_param);
+        tree->avl_alloc->libavl_free (tree->avl_alloc, p);
+      }
+    else
+      {
+        q = p->avl_link[0];
+        p->avl_link[0] = q->avl_link[1];
+        q->avl_link[1] = p;
+      }
+
+  tree->avl_alloc->libavl_free (tree->avl_alloc, tree);
+}
+
+/* Allocates |size| bytes of space using |malloc()|.
+   Returns a null pointer if allocation fails. */
+void *
+avl_malloc (struct libavl_allocator *allocator, size_t size)
+{
+  assert (allocator != NULL && size > 0);
+  return malloc (size);
+}
+
+/* Frees |block|. */
+void
+avl_free (struct libavl_allocator *allocator, void *block)
+{
+  assert (allocator != NULL && block != NULL);
+  free (block);
+}
+
+/* Default memory allocator that uses |malloc()| and |free()|. */
+struct libavl_allocator avl_allocator_default =
+  {
+    avl_malloc,
+    avl_free
+  };
+
+#undef NDEBUG
+#include <assert.h>
+
+/* Asserts that |avl_insert()| succeeds at inserting |item| into |table|. */
+void
+(avl_assert_insert) (struct avl_table *table, void *item)
+{
+  void **p = avl_probe (table, item);
+  assert (p != NULL && *p == item);
+}
+
+/* Asserts that |avl_delete()| really removes |item| from |table|,
+   and returns the removed item. */
+void *
+(avl_assert_delete) (struct avl_table *table, void *item)
+{
+  void *p = avl_delete (table, item);
+  assert (p != NULL);
+  return p;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/avl.h b/Build/source/texk/web2c/luatexdir/avl.h
new file mode 100644
index 00000000000..b9f9e3c01a9
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/avl.h
@@ -0,0 +1,115 @@
+/* Produced by texiweb from libavl.w. */
+
+/* libavl - library for manipulation of binary trees.
+   Copyright (C) 1998-2002, 2004 Free Software Foundation, Inc.
+
+   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., 59 Temple Place - Suite 330, Boston, MA
+   02111-1307, USA.
+
+   The author may be contacted at <blp@gnu.org> on the Internet, or
+   write to Ben Pfaff, Stanford University, Computer Science Dept., 353
+   Serra Mall, Stanford CA 94305, USA.
+*/
+
+#ifndef AVL_H
+#define AVL_H 1
+
+#include <stddef.h>
+
+/* Function types. */
+typedef int avl_comparison_func (const void *avl_a, const void *avl_b,
+                                 void *avl_param);
+typedef void avl_item_func (void *avl_item, void *avl_param);
+typedef void *avl_copy_func (void *avl_item, void *avl_param);
+
+#ifndef LIBAVL_ALLOCATOR
+#define LIBAVL_ALLOCATOR
+/* Memory allocator. */
+struct libavl_allocator
+  {
+    void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size);
+    void (*libavl_free) (struct libavl_allocator *, void *libavl_block);
+  };
+#endif
+
+/* Default memory allocator. */
+extern struct libavl_allocator avl_allocator_default;
+void *avl_malloc (struct libavl_allocator *, size_t);
+void avl_free (struct libavl_allocator *, void *);
+
+/* Maximum AVL height. */
+#ifndef AVL_MAX_HEIGHT
+#define AVL_MAX_HEIGHT 32
+#endif
+
+/* Tree data structure. */
+struct avl_table
+  {
+    struct avl_node *avl_root;          /* Tree's root. */
+    avl_comparison_func *avl_compare;   /* Comparison function. */
+    void *avl_param;                    /* Extra argument to |avl_compare|. */
+    struct libavl_allocator *avl_alloc; /* Memory allocator. */
+    size_t avl_count;                   /* Number of items in tree. */
+    unsigned long avl_generation;       /* Generation number. */
+  };
+
+/* An AVL tree node. */
+struct avl_node
+  {
+    struct avl_node *avl_link[2];  /* Subtrees. */
+    void *avl_data;                /* Pointer to data. */
+    signed char avl_balance;       /* Balance factor. */
+  };
+
+/* AVL traverser structure. */
+struct avl_traverser
+  {
+    struct avl_table *avl_table;        /* Tree being traversed. */
+    struct avl_node *avl_node;          /* Current node in tree. */
+    struct avl_node *avl_stack[AVL_MAX_HEIGHT];
+                                        /* All the nodes above |avl_node|. */
+    size_t avl_height;                  /* Number of nodes in |avl_parent|. */
+    unsigned long avl_generation;       /* Generation number. */
+  };
+
+/* Table functions. */
+struct avl_table *avl_create (avl_comparison_func *, void *,
+                              struct libavl_allocator *);
+struct avl_table *avl_copy (const struct avl_table *, avl_copy_func *,
+                            avl_item_func *, struct libavl_allocator *);
+void avl_destroy (struct avl_table *, avl_item_func *);
+void **avl_probe (struct avl_table *, void *);
+void *avl_insert (struct avl_table *, void *);
+void *avl_replace (struct avl_table *, void *);
+void *avl_delete (struct avl_table *, const void *);
+void *avl_find (const struct avl_table *, const void *);
+void avl_assert_insert (struct avl_table *, void *);
+void *avl_assert_delete (struct avl_table *, void *);
+
+#define avl_count(table) ((size_t) (table)->avl_count)
+
+/* Table traverser functions. */
+void avl_t_init (struct avl_traverser *, struct avl_table *);
+void *avl_t_first (struct avl_traverser *, struct avl_table *);
+void *avl_t_last (struct avl_traverser *, struct avl_table *);
+void *avl_t_find (struct avl_traverser *, struct avl_table *, void *);
+void *avl_t_insert (struct avl_traverser *, struct avl_table *, void *);
+void *avl_t_copy (struct avl_traverser *, const struct avl_traverser *);
+void *avl_t_next (struct avl_traverser *);
+void *avl_t_prev (struct avl_traverser *);
+void *avl_t_cur (struct avl_traverser *);
+void *avl_t_replace (struct avl_traverser *, void *);
+
+#endif /* avl.h */
diff --git a/Build/source/texk/web2c/luatexdir/avlstuff.c b/Build/source/texk/web2c/luatexdir/avlstuff.c
new file mode 100644
index 00000000000..74fcf6b8eda
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/avlstuff.c
@@ -0,0 +1,180 @@
+/*
+Copyright (c) 2004-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by Free
+Software Foundation; either version 2 of the License, or (at your option)
+any later version.
+
+This file 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 file; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id$
+
+*/
+
+#include "ptexlib.h"
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+#include "avl.h"
+
+static struct avl_table *PdfObjTree[pdf_objtype_max + 1] =
+    { NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL };
+
+/**********************************************************************/
+/* memory management functions for AVL */
+
+void *avl_xmalloc(struct libavl_allocator *allocator, size_t size)
+{
+    assert(allocator != NULL && size > 0);
+    return xmalloc(size);
+}
+
+void avl_xfree(struct libavl_allocator *allocator, void *block)
+{
+    assert(allocator != NULL && block != NULL);
+    xfree(block);
+}
+
+struct libavl_allocator avl_xallocator = {
+    avl_xmalloc,
+    avl_xfree
+};
+
+/**********************************************************************/
+/* general AVL comparison functions */
+
+int comp_int_entry(const void *pa, const void *pb, void *p)
+{
+    cmp_return(*(const int *) pa, *(const int *) pb);
+    return 0;
+}
+
+int comp_string_entry(const void *pa, const void *pb, void *p)
+{
+    return strcmp((const char *) pa, (const char *) pb);
+}
+
+/**********************************************************************/
+/* One AVL tree for each obj_type 0...pdfobjtypemax */
+
+
+typedef struct oentry_ {
+    integer int0;
+    integer objptr;
+} oentry;
+
+/* AVL sort oentry into avl_table[] */
+
+int compare_info(const void *pa, const void *pb, void *param)
+{
+    integer a, b;
+    int as, ae, bs, be, al, bl;
+
+    a = ((const oentry *) pa)->int0;
+    b = ((const oentry *) pb)->int0;
+    if (a < 0 && b < 0) {       /* string comparison */
+      if (a <= 2097152 && b <= 2097152) {
+	    a+=2097152;
+	    b+=2097152;
+        as = str_start[-a];
+        ae = str_start[-a + 1];  /* start of next string in pool */
+        bs = str_start[-b];
+        be = str_start[-b + 1];
+        al = ae - as;
+        bl = be - bs;
+        if (al < bl)            /* compare first by string length */
+            return -1;
+        if (al > bl)
+            return 1;
+        for (; as < ae; as++, bs++) {
+            if (str_pool[as] < str_pool[bs])
+                return -1;
+            if (str_pool[as] > str_pool[bs])
+                return 1;
+        }
+      } else {
+        pdftex_fail("avlstuff.c: compare_items() for single characters: NI");
+      }
+    } else {                    /* integer comparison */
+        if (a < b)
+            return -1;
+        if (a > b)
+            return 1;
+    }
+    return 0;
+}
+
+void avl_put_obj(integer objptr, integer t)
+{
+    static void **pp;
+    static oentry *oe;
+
+    if (PdfObjTree[t] == NULL) {
+        PdfObjTree[t] = avl_create(compare_info, NULL, &avl_xallocator);
+        if (PdfObjTree[t] == NULL)
+            pdftex_fail("avlstuff.c: avl_create() PdfObjTree failed");
+    }
+    oe = xtalloc(1, oentry);
+    oe->int0 = obj_tab[objptr].int0;
+    oe->objptr = objptr;        /* allows to relocate objtab */
+    pp = avl_probe(PdfObjTree[t], oe);
+    if (pp == NULL)
+        pdftex_fail("avlstuff.c: avl_probe() out of memory in insertion");
+}
+
+
+/* replacement for linear search pascal function "find_obj()" */
+
+integer avl_find_obj(integer t, integer i, integer byname)
+{
+    static oentry *p;
+    static oentry tmp;
+
+    if (byname > 0)
+        tmp.int0 = -i;
+    else
+        tmp.int0 = i;
+    if (PdfObjTree[t] == NULL)
+        return 0;
+    p = (oentry *) avl_find(PdfObjTree[t], &tmp);
+    if (p == NULL)
+        return 0;
+    return p->objptr;
+}
+
+/**********************************************************************/
+
+struct avl_table *mf_tree = NULL;
+
+typedef struct {
+    char *tfm_name;
+    internalfontnumber fontnum;
+} mf_entry;
+
+/**********************************************************************/
+/* cleaning up... */
+
+static void destroy_oentry(void *pa, void *pb)
+{
+    oentry *p = (oentry *) pa;
+    xfree(p);
+}
+
+void PdfObjTree_free()
+{
+    int i;
+
+    for (i = 0; i <= pdf_objtype_max; i++) {
+        if (PdfObjTree[i] != NULL)
+            avl_destroy(PdfObjTree[i], destroy_oentry);
+    }
+}
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/luatexdir/avlstuff.h b/Build/source/texk/web2c/luatexdir/avlstuff.h
new file mode 100644
index 00000000000..e5a4de894d2
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/avlstuff.h
@@ -0,0 +1,29 @@
+/*
+Copyright (c) 2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by Free
+Software Foundation; either version 2 of the License, or (at your option)
+any later version.
+
+This file 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 file; if not, write to the Free Software Foundation, Inc.,
+59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+$Id$
+
+formatted by indent -kr
+*/
+
+#include "avl.h"
+
+/* memory management functions for avl */
+
+extern struct libavl_allocator avl_xallocator;
+
+/* end of file avlstuff.h */
diff --git a/Build/source/texk/web2c/luatexdir/change-files.txt b/Build/source/texk/web2c/luatexdir/change-files.txt
new file mode 100644
index 00000000000..c6a3387f41d
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/change-files.txt
@@ -0,0 +1,35 @@
+How change files are applied for pdftex/pdfetex?
+
+============================= pdftex =============================
+
+2) pdftex.ch is generated from
+    ./tie -c pdftex.ch pdftex.web \
+    $(srcdir)/pdftexdir/tex.ch0 \
+    $(srcdir)/tex.ch \
+    $(srcdir)/pdftexdir/tex.ch1 \
+    $(srcdir)/pdftexdir/tex.pch
+
+Input:
+    pdftex.web:
+        pdftex without system-dependent changes
+
+    pdftexdir/tex.ch0:
+        % Change file to assist in creating the web2c-specific change file.
+        % This one comes first, resolves inconsistencies between the
+        % generated pdftex.web and tex.ch
+
+        change the pdftex banner to tex banner, so tex.ch can be applied
+
+    tex.ch:
+        the main web2c-specific (or other system-dependent) change file
+
+    pdftexdir/pdftex.ch:
+
+        % Change file to assist in creating the web2c-specific change file.
+        % This one resolves inconsistencies between tex.ch and tex.pch.
+
+        change the tex banner to pdftex banner (reverse tex.ch0)
+
+Output:
+    pdftex.ch (not pdftexdir/pdftex.ch):
+        additional & system-dependent changes
diff --git a/Build/source/texk/web2c/luatexdir/depend.mk b/Build/source/texk/web2c/luatexdir/depend.mk
new file mode 100644
index 00000000000..8d1bf394648
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/depend.mk
@@ -0,0 +1,2874 @@
+avl.o: ../../../../src/texk/web2c/luatexdir/avl.c \
+  ../../../../src/texk/web2c/luatexdir/avl.h
+avlstuff.o: ../../../../src/texk/web2c/luatexdir/avlstuff.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/mapfile.o: ../../../../src/texk/web2c/luatexdir/font/mapfile.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+font/pkin.o: ../../../../src/texk/web2c/luatexdir/font/pkin.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/subfont.o: ../../../../src/texk/web2c/luatexdir/font/subfont.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/tounicode.o: ../../../../src/texk/web2c/luatexdir/font/tounicode.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/vfpacket.o: ../../../../src/texk/web2c/luatexdir/font/vfpacket.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/writeenc.o: ../../../../src/texk/web2c/luatexdir/font/writeenc.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/writefont.o: ../../../../src/texk/web2c/luatexdir/font/writefont.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/writet1.o: ../../../../src/texk/web2c/luatexdir/font/writet1.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+font/writet3.o: ../../../../src/texk/web2c/luatexdir/font/writet3.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-glyph.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/magstep.h
+font/writettf.o: ../../../../src/texk/web2c/luatexdir/font/writettf.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/font/writettf.h \
+  ../../../../src/texk/web2c/luatexdir/font/macnames.c
+font/writetype0.o:  \
+ ../../../../src/texk/web2c/luatexdir/font/writetype0.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/font/writettf.h \
+  ../../../../src/texk/web2c/luatexdir/font/writecff.h
+font/writetype2.o:  \
+ ../../../../src/texk/web2c/luatexdir/font/writetype2.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/font/writettf.h \
+  ../../../../src/texk/web2c/luatexdir/font/writecff.h \
+  ../../../../src/texk/web2c/luatexdir/font/sfnt.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/font/tt_glyf.h
+font/writecff.o: ../../../../src/texk/web2c/luatexdir/font/writecff.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/font/writecff.h
+font/tt_glyf.o: ../../../../src/texk/web2c/luatexdir/font/tt_glyf.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/font/sfnt.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/font/tt_table.h \
+  ../../../../src/texk/web2c/luatexdir/font/tt_glyf.h
+font/tt_table.o: ../../../../src/texk/web2c/luatexdir/font/tt_table.c \
+  ../../../../src/texk/web2c/luatexdir/font/sfnt.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/font/tt_table.h
+font/sfnt.o: ../../../../src/texk/web2c/luatexdir/font/sfnt.c \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/font/sfnt.h
+font/texfont.o: ../../../../src/texk/web2c/luatexdir/font/texfont.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+font/tfmofm.o: ../../../../src/texk/web2c/luatexdir/font/tfmofm.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+font/vfovf.o: ../../../../src/texk/web2c/luatexdir/font/vfovf.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+font/luafont.o: ../../../../src/texk/web2c/luatexdir/font/luafont.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+font/dofont.o: ../../../../src/texk/web2c/luatexdir/font/dofont.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+ 
+image/epdf.o: ../../../../src/texk/web2c/luatexdir/image/epdf.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+image/pdftoepdf.o:  \
+ ../../../../src/texk/web2c/luatexdir/image/pdftoepdf.cc \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/image/epdf.h \
+  ../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../web2c/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../web2c/luatexdir/ptexmac.h \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+ 
+image/writeimg.o: ../../../../src/texk/web2c/luatexdir/image/writeimg.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+ 
+image/writejbig2.o:  \
+ ../../../../src/texk/web2c/luatexdir/image/writejbig2.c \
+  ../../../../src/texk/web2c/luatexdir/image/writejbig2.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h
+image/writejpg.o: ../../../../src/texk/web2c/luatexdir/image/writejpg.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h
+image/writepng.o: ../../../../src/texk/web2c/luatexdir/image/writepng.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h
+lua/loslibext.o: ../../../../src/texk/web2c/luatexdir/lua/loslibext.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lcallbacklib.o:  \
+ ../../../../src/texk/web2c/luatexdir/lua/lcallbacklib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lkpselib.o: ../../../../src/texk/web2c/luatexdir/lua/lkpselib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/expand.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-glyph.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/readable.h
+lua/llualib.o: ../../../../src/texk/web2c/luatexdir/lua/llualib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lnodelib.o: ../../../../src/texk/web2c/luatexdir/lua/lnodelib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lpdflib.o: ../../../../src/texk/web2c/luatexdir/lua/lpdflib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lstatslib.o: ../../../../src/texk/web2c/luatexdir/lua/lstatslib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/ltexiolib.o: ../../../../src/texk/web2c/luatexdir/lua/ltexiolib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/ltexlib.o: ../../../../src/texk/web2c/luatexdir/lua/ltexlib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/ltokenlib.o: ../../../../src/texk/web2c/luatexdir/lua/ltokenlib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/lfontlib.o: ../../../../src/texk/web2c/luatexdir/lua/lfontlib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/texluac.o: ../../../../src/texk/web2c/luatexdir/lua/texluac.c \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+ 
+lua/luainit.o: ../../../../src/texk/web2c/luatexdir/lua/luainit.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h ../luatexdir/luatexextra.h
+lua/luastuff.o: ../../../../src/texk/web2c/luatexdir/lua/luastuff.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/luatex.o: ../../../../src/texk/web2c/luatexdir/lua/luatex.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+ 
+lua/luatoken.o: ../../../../src/texk/web2c/luatexdir/lua/luatoken.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/tokens.h
+lua/luanode.o: ../../../../src/texk/web2c/luatexdir/lua/luanode.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/llanglib.o: ../../../../src/texk/web2c/luatexdir/lua/llanglib.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lua/limglib.o: ../../../../src/texk/web2c/luatexdir/lua/limglib.c \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/lua/../image/image.h
+lang/hnjalloc.o: ../../../../src/texk/web2c/luatexdir/lang/hnjalloc.c
+lang/hyphen.o: ../../../../src/texk/web2c/luatexdir/lang/hyphen.c \
+  ../../../../src/texk/web2c/luatexdir/lang/hnjalloc.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+lang/texlang.o: ../../../../src/texk/web2c/luatexdir/lang/texlang.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h
+tex/linebreak.o: ../../../../src/texk/web2c/luatexdir/tex/linebreak.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+tex/postlinebreak.o:  \
+ ../../../../src/texk/web2c/luatexdir/tex/postlinebreak.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+tex/texnodes.o: ../../../../src/texk/web2c/luatexdir/tex/texnodes.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+tex/textoken.o: ../../../../src/texk/web2c/luatexdir/tex/textoken.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/tokens.h
+tex/texpdf.o: ../../../../src/texk/web2c/luatexdir/tex/texpdf.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h
+managed-sa.o: ../../../../src/texk/web2c/luatexdir/managed-sa.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/managed-sa.h
+mathcodes.o: ../../../../src/texk/web2c/luatexdir/mathcodes.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/managed-sa.h
+textcodes.o: ../../../../src/texk/web2c/luatexdir/textcodes.c \
+  ../../../../src/texk/web2c/luatexdir/luatex-api.h \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/managed-sa.h
+utils.o: ../../../../src/texk/web2c/luatexdir/utils.c \
+  \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-stat.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+  ../../../../src/texk/web2c/luatexdir/svnversion.h \
+  \
+ 
+writezip.o: ../../../../src/texk/web2c/luatexdir/writezip.c \
+  ../../../../src/texk/web2c/luatexdir/ptexlib.h ../luatexd.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmp.h \
+  ../../../../src/texk/web2c/luatexdir/../cpascal.h \
+  ../../../../src/texk/web2c/luatexdir/../config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/config.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-std.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-unistd.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/systypes.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-memstr.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-errno.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-minmax.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-limits.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-proto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/debug.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/types.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/lib.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/progname.h \
+  ../../web2c/c-auto.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-fopen.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/getopt.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/proginit.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/tex-file.h \
+  ../../../../src/texk/web2c/luatexdir/../help.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-pathch.h \
+  ../../../../src/texk/web2c/luatexdir/../../kpathsea/c-ctype.h \
+  ../../../../src/texk/web2c/luatexdir/../texmfmem.h ../luatexcoerce.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/luatex.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/ptexlib.h \
+  ../../../../src/texk/web2c/luatexdir/ptexmac.h \
+  ../../../../src/texk/web2c/luatexdir/avlstuff.h \
+  ../../../../src/texk/web2c/luatexdir/avl.h \
+  ../../../../src/texk/web2c/luatexdir/image/image.h \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  \
+  ../../../../src/texk/web2c/luatexdir/font/texfont.h \
+  ../../../../src/texk/web2c/luatexdir/../luatexdir/managed-sa.h \
+  ../../../../src/texk/web2c/luatexdir/hyphen.h \
+  ../../../../src/texk/web2c/luatexdir/nodes.h \
+ 
diff --git a/Build/source/texk/web2c/luatexdir/font/.indent.pro b/Build/source/texk/web2c/luatexdir/font/.indent.pro
new file mode 100644
index 00000000000..e9e690f1ba8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/.indent.pro
@@ -0,0 +1,12 @@
+/* $Id$ */
+--k-and-r-style
+--blank-lines-after-procedures
+--line-length 80
+--procnames-start-lines
+--no-space-after-function-call-names
+--dont-break-procedure-type
+--space-after-cast
+/* this does not work in indent 2.2.6 :-( */
+--no-tabs
+/* this is new in indent 2.2.9 */
+--preprocessor-indentation 2
diff --git a/Build/source/texk/web2c/luatexdir/font/dofont.c b/Build/source/texk/web2c/luatexdir/font/dofont.c
new file mode 100644
index 00000000000..fbe44c29ba9
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/dofont.c
@@ -0,0 +1,183 @@
+/*
+Copyright (c) 1996-2006 Taco Hoekwater <taco@luatex.org>
+
+This file is part of LuaTeX.
+
+LuaTeX 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.
+
+LuaTeX 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 LuaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: dofont.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+#include "luatex-api.h"
+
+#define TIMERS 0
+
+#if TIMERS
+#include <sys/time.h>
+#endif
+
+
+/* a bit more interfacing is needed for proper error reporting */
+
+static char *
+font_error_message (pointer u, char *nom, scaled s) {
+  char *str = xmalloc(256);
+  char *c = makecstring(zget_cs_text(u));
+  char *extra =  "metric data not found or bad";
+  if (s>=0 ) {
+    snprintf(str,255,"Font \\%s=%s at %gpt not loadable: %s", c, nom, (double)s/65536, extra);
+  } else if (s!=-1000) {
+    snprintf(str,255,"Font \\%s=%s scaled %d not loadable: %s", c, nom, (int)(-s), extra);
+  } else {
+    snprintf(str,255,"Font \\%s=%s not loadable: %s", c, nom, extra);
+  }
+  return str;
+}
+
+static int
+do_define_font (integer f, char *cnom, char *caire, scaled s, integer natural_dir) {
+
+  boolean res; /* was the callback successful? */
+  integer callback_id;
+  char *cnam;
+#if TIMERS
+    struct timeval tva;
+    struct timeval tvb;
+    double tvdiff;
+#endif
+  int r;
+  res = 0;
+
+  callback_id=callback_defined(define_font_callback);
+  if (callback_id>0) {
+    if (caire == NULL || strlen(caire)==0) {
+      cnam = xstrdup(cnom);
+    } else {
+      cnam = xmalloc(strlen(cnom)+strlen(caire)+2);
+      sprintf(cnam,"%s/%s",caire,cnom);
+    }
+#if TIMERS
+	gettimeofday(&tva,NULL);
+#endif
+    callback_id = run_and_save_callback(callback_id,"Sdd->",cnam,s,f);
+#if TIMERS
+	gettimeofday(&tvb,NULL);
+	tvdiff = tvb.tv_sec*1000000.0;
+	tvdiff += (double)tvb.tv_usec;
+	tvdiff -= (tva.tv_sec*1000000.0);
+	tvdiff -= (double)tva.tv_usec;
+	tvdiff /= 1000000;
+	fprintf(stdout,"\ncallback('define_font',%s,%i): %f seconds\n", cnam,f,tvdiff);
+#endif
+    free(cnam);
+    if (callback_id>0) { /* success */
+      luaL_checkstack(Luas[0],1,"out of stack space");
+      lua_rawgeti(Luas[0],LUA_REGISTRYINDEX, callback_id);
+      if (lua_istable(Luas[0],-1)) {
+#if TIMERS
+	gettimeofday(&tva,NULL);
+#endif
+	res = font_from_lua(Luas[0],f);	
+	destroy_saved_callback (callback_id);
+#if TIMERS
+	gettimeofday(&tvb,NULL);
+	tvdiff = tvb.tv_sec*1000000.0;
+	tvdiff += (double)tvb.tv_usec;
+	tvdiff -= (tva.tv_sec*1000000.0);
+	tvdiff -= (double)tva.tv_usec;
+	tvdiff /= 1000000;
+	fprintf(stdout,"font_from_lua(%s,%i): %f seconds\n", font_name(f),f,tvdiff);
+#endif
+	lua_pop(Luas[0],1);
+      } else if (lua_isnumber(Luas[0],-1)) {
+	r = lua_tonumber(Luas[0],-1);	
+	destroy_saved_callback (callback_id);
+	delete_font(f);
+	lua_pop(Luas[0],1);
+	return r;
+      } else {
+	lua_pop(Luas[0],1);
+	delete_font(f);
+	return 0;
+      }
+    }
+  } else {
+    res = read_tfm_info(f,cnom,caire,s);
+    if (res) {
+      set_hyphen_char(f,get_default_hyphen_char());
+      set_skew_char(f,get_default_skew_char());
+    }
+  }
+  if (res) {
+    do_vf(f);
+    set_font_natural_dir(f,natural_dir);
+    return f;
+  } else {
+    delete_font(f);
+    return 0;
+  }
+
+}
+
+int 
+read_font_info(pointer u,  strnumber nom, strnumber aire, scaled s,
+               integer natural_dir) {
+  integer f;
+  char *cnom, *caire = NULL;
+  char *msg;
+  cnom  = xstrdup(makecstring(nom));
+  if (aire != 0) 
+    caire = xstrdup(makecstring(aire));
+
+  f = new_font();
+  if ((f = do_define_font(f, cnom,caire,s,natural_dir))) {
+	if (caire != NULL) free(caire);
+	free(cnom);
+    return f;
+  } else {
+    char *help[] = {"I wasn't able to read the size data for this font,",
+		    "so I will ignore the font specification.",
+		    "[Wizards can fix TFM files using TFtoPL/PLtoTF.]",
+		    "You might try inserting a different font spec;",
+		    "e.g., type `I\font<same font id>=<substitute font name>'.",
+		    NULL } ;
+	if(!get_suppress_fontnotfound_error()) {
+	  msg = font_error_message(u, cnom, s);
+	  tex_error(msg,help);
+	  free(msg);
+	}
+	if (caire != NULL) free(caire);
+	free(cnom);
+    return 0;
+  }
+}
+
+/* TODO This function is a placeholder. There can easily appears holes in 
+   the |font_tables| array, and we could attempt to reuse those
+*/
+
+int 
+find_font_id (char *nom, char *aire, scaled s) {
+  integer f;
+  f = new_font();
+  if ((f = do_define_font(f, nom, aire,s,-1))) {
+    return f;
+  } else {
+    return 0;
+  }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/luafont.c b/Build/source/texk/web2c/luatexdir/font/luafont.c
new file mode 100644
index 00000000000..be32e39de9f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/luafont.c
@@ -0,0 +1,1733 @@
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "nodes.h"
+
+#define noVERBOSE
+
+#define SAVE_REF 1
+
+char *font_type_strings[]      = {"unknown","virtual","real", NULL};
+char *font_format_strings[]    = {"unknown","type1","type3","truetype", "opentype", NULL};
+char *font_embedding_strings[] = {"unknown","no","subset", "full", NULL};
+char *ligature_type_strings[]  = {"=:", "=:|", "|=:", "|=:|", "", "=:|>", "|=:>", "|=:|>", "", "", "", "|=:|>>", NULL };
+
+void
+font_char_to_lua (lua_State *L, internalfontnumber f, charinfo *co) {
+  int i;
+  liginfo *l;
+  kerninfo *ki;
+
+  lua_createtable(L,0,10);
+
+  lua_pushstring(L,"width");
+  lua_pushnumber(L,get_charinfo_width(co));
+  lua_rawset(L,-3);
+
+  lua_pushstring(L,"height");
+  lua_pushnumber(L,get_charinfo_height(co));
+  lua_rawset(L,-3);
+
+  lua_pushstring(L,"depth");
+  lua_pushnumber(L,get_charinfo_depth(co));
+  lua_rawset(L,-3);
+
+  lua_pushstring(L,"italic");
+  lua_pushnumber(L,get_charinfo_italic(co));
+  lua_rawset(L,-3);
+
+  if (get_charinfo_ef(co)!=0) {
+	lua_pushstring(L,"expansion_factor");
+	lua_pushnumber(L,get_charinfo_ef(co));
+	lua_rawset(L,-3);
+  }
+
+  if (get_charinfo_lp(co)!=0) {
+	lua_pushstring(L,"left_protruding");
+	lua_pushnumber(L,get_charinfo_lp(co));
+	lua_rawset(L,-3);
+  }
+
+  if (get_charinfo_lp(co)!=0) {
+	lua_pushstring(L,"right_protruding");
+	lua_pushnumber(L,get_charinfo_rp(co));
+	lua_rawset(L,-3);
+  }
+
+
+  if (font_encodingbytes(f) == 2 ) {
+        lua_pushstring(L,"index");
+    lua_pushnumber(L,get_charinfo_index(co));
+    lua_rawset(L,-3);
+  }
+
+  if (get_charinfo_name(co)!=NULL) {
+        lua_pushstring(L,"name");
+    lua_pushstring(L,get_charinfo_name(co));
+    lua_rawset(L,-3);
+  }
+
+  if (get_charinfo_tounicode(co)!=NULL) {
+        lua_pushstring(L,"tounicode");
+    lua_pushstring(L,get_charinfo_tounicode(co));
+    lua_rawset(L,-3);
+  }
+
+  if (get_charinfo_tag(co) == list_tag) {
+        lua_pushstring(L,"next");
+    lua_pushnumber(L,get_charinfo_remainder(co));
+    lua_rawset(L,-3);
+  }
+
+  lua_pushstring(L,"used");
+  lua_pushboolean(L,(get_charinfo_used(co) ? true : false));
+  lua_rawset(L,-3);
+
+  if (get_charinfo_tag(co) == ext_tag) {
+        lua_pushstring(L,"extensible");
+    lua_createtable(L,0,4);    
+    lua_pushnumber(L,get_charinfo_extensible(co,EXT_TOP));
+    lua_setfield(L,-2,"top");
+    lua_pushnumber(L,get_charinfo_extensible(co,EXT_BOT));
+    lua_setfield(L,-2,"bot");
+    lua_pushnumber(L,get_charinfo_extensible(co,EXT_MID));
+    lua_setfield(L,-2,"mid");
+    lua_pushnumber(L,get_charinfo_extensible(co,EXT_REP));
+    lua_setfield(L,-2,"rep");
+    lua_rawset(L,-3);
+  }
+  ki = get_charinfo_kerns(co);
+  if (ki != NULL) {
+    lua_pushstring(L,"kerns");
+    lua_createtable(L,10,1);
+    for (i=0;!kern_end(ki[i]);i++) {
+      if (kern_char(ki[i]) == right_boundarychar) {
+                lua_pushstring(L,"right_boundary");
+      } else {
+                lua_pushnumber(L,kern_char(ki[i]));
+      }
+      lua_pushnumber(L,kern_kern(ki[i]));
+      lua_rawset(L,-3);
+    }
+    lua_rawset(L,-3);
+  }
+  l = get_charinfo_ligatures(co);
+  if (l!=NULL) {
+        lua_pushstring(L,"ligatures");
+    lua_createtable(L,10,1);
+    for (i=0;!lig_end(l[i]);i++) {
+      if (lig_char(l[i]) == right_boundarychar) {
+                lua_pushstring(L,"right_boundary");
+      } else {
+                lua_pushnumber(L,lig_char(l[i]));
+      }
+      lua_createtable(L,0,2);
+          lua_pushstring(L,"type");
+      lua_pushnumber(L,lig_type(l[i]));
+      lua_rawset(L,-3);
+          lua_pushstring(L,"char");
+      lua_pushnumber(L,lig_replacement(l[i]));
+      lua_rawset(L,-3);
+      lua_rawset(L,-3);
+    }
+    lua_rawset(L,-3);
+  }
+}
+
+static void
+write_lua_parameters (lua_State *L, int f) {
+  int k;
+  lua_newtable(L);
+  for (k=1;k<=font_params(f);k++) {
+    lua_pushnumber(L,font_param(f,k));
+    switch (k) {
+    case slant_code:         lua_setfield(L,-2,"slant");         break;
+    case space_code:         lua_setfield(L,-2,"space");         break;
+    case space_stretch_code: lua_setfield(L,-2,"space_stretch"); break;
+    case space_shrink_code:  lua_setfield(L,-2,"space_shrink");  break;
+    case x_height_code:      lua_setfield(L,-2,"x_height");      break;
+    case quad_code:          lua_setfield(L,-2,"quad");          break;
+    case extra_space_code:   lua_setfield(L,-2,"extra_space");   break;
+    default:
+      lua_rawseti(L,-2,k);
+    }
+  }
+  lua_setfield(L,-2,"parameters");
+}
+
+
+int
+font_to_lua (lua_State *L, int f) {
+  int k;
+  charinfo *co;
+  if (font_cache_id(f)) {
+    /* fetch the table from the registry if  it was 
+       saved there by font_from_lua() */ 
+    lua_rawgeti(L,LUA_REGISTRYINDEX,font_cache_id(f));
+    /* fontdimens can be changed from tex code */
+    write_lua_parameters(L,f);
+    return 1;
+  }
+
+  lua_newtable(L);
+  lua_pushstring(L,font_name(f));
+  lua_setfield(L,-2,"name");
+  if(font_area(f)!=NULL) {
+        lua_pushstring(L,font_area(f));
+        lua_setfield(L,-2,"area");
+  }
+  if(font_filename(f)!=NULL) {
+        lua_pushstring(L,font_filename(f));
+        lua_setfield(L,-2,"filename");
+  }
+  if(font_fullname(f)!=NULL) {
+        lua_pushstring(L,font_fullname(f));
+        lua_setfield(L,-2,"fullname");
+  }
+  if(font_encodingname(f)!=NULL) {
+        lua_pushstring(L,font_encodingname(f));
+        lua_setfield(L,-2,"encodingname");
+  }
+
+  lua_pushboolean(L,(font_used(f) ? true : false));
+  lua_setfield(L,-2,"used");
+
+  
+  lua_pushstring(L,font_type_strings[font_type(f)]);
+  lua_setfield(L,-2,"type");
+  lua_pushstring(L,font_format_strings[font_format(f)]);
+  lua_setfield(L,-2,"format");
+  lua_pushstring(L,font_embedding_strings[font_embedding(f)]);
+  lua_setfield(L,-2,"embedding");
+  
+  lua_pushnumber(L,font_size(f));
+  lua_setfield(L,-2,"size");
+  lua_pushnumber(L,font_dsize(f));
+  lua_setfield(L,-2,"designsize");
+  lua_pushnumber(L,font_checksum(f));
+  lua_setfield(L,-2,"checksum");
+  lua_pushnumber(L,font_slant(f));
+  lua_setfield(L,-2,"slant");
+  lua_pushnumber(L,font_extend(f));
+  lua_setfield(L,-2,"extend");
+  lua_pushnumber(L,font_natural_dir(f));
+  lua_setfield(L,-2,"direction");
+  lua_pushnumber(L,font_encodingbytes(f));
+  lua_setfield(L,-2,"encodingbytes");
+  lua_pushnumber(L,font_tounicode(f));
+  lua_setfield(L,-2,"tounicode");
+
+  /* pdf parameters */
+  /* skip the first four for now, that are very much interal */
+  /*
+  if (pdf_font_size(f) != 0) {
+	lua_pushnumber(L,pdf_font_size(f));
+	lua_setfield(L,-2,"pdf_size");
+  }
+  if (pdf_font_num(f) != 0) {
+	lua_pushnumber(L,pdf_font_num(f));
+	lua_setfield(L,-2,"pdf_num");
+  }
+  if (pdf_font_blink(f) != 0) {
+	lua_pushnumber(L,pdf_font_blink(f));
+	lua_setfield(L,-2,"pdf_blink");
+  }
+  if (pdf_font_elink(f) != 0) {
+	lua_pushnumber(L,pdf_font_elink(f));
+	lua_setfield(L,-2,"pdf_elink");
+  }
+  */
+  /* the next one is read only */
+  if (pdf_font_expand_ratio(f) != 0) {
+	lua_pushnumber(L,pdf_font_expand_ratio(f));
+	lua_setfield(L,-2,"expand_ratio");
+  }
+  if (pdf_font_shrink(f) != 0) {
+	lua_pushnumber(L,pdf_font_shrink(f));
+	lua_setfield(L,-2,"shrink");
+  }
+  if (pdf_font_stretch(f) != 0) {
+	lua_pushnumber(L,pdf_font_stretch(f));
+	lua_setfield(L,-2,"stretch");
+  }
+  if (pdf_font_step(f) != 0) {
+	lua_pushnumber(L,pdf_font_step(f));
+	lua_setfield(L,-2,"step");
+  }
+  if (pdf_font_auto_expand(f) != 0) {
+	lua_pushboolean(L,pdf_font_auto_expand(f));
+	lua_setfield(L,-2,"auto_expand");
+  }
+  if (pdf_font_attr(f) != 0) {
+	lua_pushstring(L,makecstring(pdf_font_attr(f)));
+	lua_setfield(L,-2,"attributes");
+  }
+
+  /* params */
+  write_lua_parameters(L,f);
+  
+  /* chars */
+  lua_createtable(L,font_tables[f]->charinfo_size,0); /* all characters */
+
+  if (has_left_boundary(f)) {
+    co = get_charinfo(f,left_boundarychar);
+    font_char_to_lua(L,f,co);
+    lua_setfield(L,-2,"left_boundary");
+  }
+  if (has_right_boundary(f)) {
+    co = get_charinfo(f,right_boundarychar);
+    font_char_to_lua(L,f,co);
+    lua_setfield(L,-2,"right_boundary");
+  }
+
+  for (k=font_bc(f);k<=font_ec(f);k++) {
+    if (char_exists(f,k)) {
+      lua_pushnumber(L,k);
+      co = get_charinfo(f,k);
+      font_char_to_lua(L,f,co);
+      lua_rawset(L,-3);
+    }
+  }
+  lua_setfield(L,-2,"characters");
+  return 1;
+}
+
+static int 
+count_hash_items (lua_State *L, int name_index){
+  int n = -1;
+  lua_rawgeti(L,LUA_REGISTRYINDEX,name_index);
+  lua_rawget(L,-2);
+  if (!lua_isnil(L,-1)) {
+    if (lua_istable(L,-1)) {
+      n = 0;
+      /* now find the number */
+      lua_pushnil(L);  /* first key */
+      while (lua_next(L, -2) != 0) {
+	n++;
+	lua_pop(L,1);
+      }
+    }
+  }
+  lua_pop(L,1);
+  return n;
+}
+
+#define streq(a,b) (strcmp(a,b)==0)
+
+#define append_packet(k) { cpackets[np++] = k; }
+
+#define do_store_four(l) {                                                        \
+    append_packet((l&0xFF000000)>>24);                                \
+    append_packet((l&0x00FF0000)>>16);                                \
+    append_packet((l&0x0000FF00)>>8);                                \
+    append_packet((l&0x000000FF));  } 
+
+/*
+*/
+
+#define lua_roundnumber(a,b) (int)floor((double)lua_tonumber(L,-1)+0.5)
+
+static int
+numeric_field (lua_State *L, char *name, int dflt) {
+  int i = dflt;
+  lua_pushstring(L,name);
+  lua_rawget(L,-2);
+  if (lua_isnumber(L,-1)) {        
+    i = lua_roundnumber(L,-1);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+static int
+n_numeric_field (lua_State *L, int name_index, int dflt) {
+  register int i = dflt;
+  lua_rawgeti(L,LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+  lua_rawget(L,-2);
+  if (lua_type(L,-1)==LUA_TNUMBER) {        
+    i = lua_roundnumber(L,-1);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+
+static int
+enum_field (lua_State *L, char *name, int dflt, char **values) {
+  int k;
+  char *s;
+  int i = dflt;
+  lua_pushstring(L,name);
+  lua_rawget(L,-2);
+  if (lua_isnumber(L,-1)) {        
+    i = lua_tonumber(L,-1);
+  } else if (lua_isstring(L,-1)) {
+    s = (char *)lua_tostring(L,-1);
+    k = 0;
+    while (values[k] != NULL) {
+      if (strcmp(values[k],s) == 0) {
+        i = k;
+        break;
+      }
+      k++;
+    }
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+static int
+boolean_field (lua_State *L, char *name, int dflt) {
+  int i = dflt;
+  lua_pushstring(L,name);
+  lua_rawget(L,-2);
+  if (lua_isboolean(L,-1)) {        
+    i = lua_toboolean(L,-1);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+static int
+n_boolean_field (lua_State *L, int name_index, int dflt) {
+  int i = dflt;
+  lua_rawgeti(L,LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+  lua_rawget(L,-2);
+  if (lua_isboolean(L,-1)) {        
+    i = lua_toboolean(L,-1);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+
+static char *
+string_field (lua_State *L, char *name, char *dflt) {
+  char *i;
+  lua_pushstring(L,name);
+  lua_rawget(L,-2);
+  if (lua_isstring(L,-1)) {        
+    i = xstrdup(lua_tostring(L,-1));
+  } else if (dflt==NULL) {
+    i = NULL;
+  } else {
+    i = xstrdup(dflt);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+static char *
+n_string_field (lua_State *L, int name_index, char *dflt) {
+  char *i;
+  lua_rawgeti(L,LUA_REGISTRYINDEX, name_index); /* fetch the stringptr */
+  lua_rawget(L,-2);
+  if (lua_isstring(L,-1)) {        
+    i = xstrdup(lua_tostring(L,-1));
+  } else if (dflt==NULL) {
+    i = NULL;
+  } else {
+    i = xstrdup(dflt);
+  }
+  lua_pop(L,1);
+  return i;
+}
+
+#define init_luaS_index(a) do {					\
+    lua_pushliteral(L,#a);					\
+    luaS_##a##_ptr = (char *)lua_tostring(L,-1);		\
+    luaS_##a##_index = luaL_ref (L,LUA_REGISTRYINDEX);		\
+  } while (0)
+
+#define make_luaS_index(a)			\
+  static int luaS_##a##_index = 0;		\
+  static char * luaS_##a##_ptr = NULL
+
+#define luaS_index(a)	luaS_##a##_index
+
+#define luaS_ptr_eq(a,b) (a==luaS_##b##_ptr)
+
+make_luaS_index(width);
+make_luaS_index(height);
+make_luaS_index(depth);
+make_luaS_index(italic);
+make_luaS_index(index);
+make_luaS_index(left_protruding);
+make_luaS_index(right_protruding);
+make_luaS_index(expansion_factor);
+make_luaS_index(top); 
+make_luaS_index(bot); 
+make_luaS_index(rep); 
+make_luaS_index(mid);
+make_luaS_index(next);
+make_luaS_index(used);
+make_luaS_index(name);
+make_luaS_index(tounicode);
+make_luaS_index(font);
+make_luaS_index(char);
+make_luaS_index(slot);
+make_luaS_index(comment);
+make_luaS_index(push);
+make_luaS_index(pop);
+make_luaS_index(rule);
+make_luaS_index(right);
+make_luaS_index(node);
+make_luaS_index(down);
+make_luaS_index(special);
+make_luaS_index(slant);
+make_luaS_index(space);
+make_luaS_index(space_stretch);
+make_luaS_index(space_shrink);
+make_luaS_index(x_height);
+make_luaS_index(quad);
+make_luaS_index(extra_space);
+make_luaS_index(left_boundary);
+make_luaS_index(right_boundary);
+make_luaS_index(kerns);
+make_luaS_index(ligatures);
+make_luaS_index(fonts);
+
+void init_font_string_pointers (lua_State *L) {
+  init_luaS_index(width);
+  init_luaS_index(height);
+  init_luaS_index(depth);
+  init_luaS_index(italic);
+  init_luaS_index(index);
+  init_luaS_index(left_protruding);
+  init_luaS_index(right_protruding);
+  init_luaS_index(expansion_factor);
+  init_luaS_index(top); 
+  init_luaS_index(bot); 
+  init_luaS_index(rep); 
+  init_luaS_index(mid);
+  init_luaS_index(next);
+  init_luaS_index(used);
+  init_luaS_index(name);
+  init_luaS_index(tounicode);
+  init_luaS_index(font);
+  init_luaS_index(char);
+  init_luaS_index(slot);
+  init_luaS_index(comment);
+  init_luaS_index(push);
+  init_luaS_index(pop);
+  init_luaS_index(rule);
+  init_luaS_index(right);
+  init_luaS_index(node);
+  init_luaS_index(down);
+  init_luaS_index(special);
+
+  init_luaS_index(slant);
+  init_luaS_index(space);
+  init_luaS_index(space_stretch);
+  init_luaS_index(space_shrink);
+  init_luaS_index(x_height);
+  init_luaS_index(quad);
+  init_luaS_index(extra_space);
+
+  init_luaS_index(left_boundary);
+  init_luaS_index(right_boundary);
+  init_luaS_index(kerns);
+  init_luaS_index(ligatures);
+  init_luaS_index(fonts);
+}
+
+static int
+count_char_packet_bytes  (lua_State *L) {
+  register int i; 
+  register int l = 0;
+  int ff = 0;
+  for (i=1;i<=lua_objlen(L,-1);i++) {
+    lua_rawgeti(L,-1,i);
+    if (lua_istable(L,-1)) {
+      lua_rawgeti(L,-1,1);
+      if (lua_isstring(L,-1)) {
+	char *s = (char *)lua_tostring(L,-1);
+        if      (luaS_ptr_eq(s,font))    { l+= 5; ff =1; }
+        else if (luaS_ptr_eq(s,char))    { if (ff==0) { l+=5;  } l += 5; ff = 1;        } 
+        else if (luaS_ptr_eq(s,slot))    { l += 10; ff = 1;}
+        else if (luaS_ptr_eq(s,comment)) { ;    } 
+        else if (luaS_ptr_eq(s,push) || 
+		 luaS_ptr_eq(s,pop))     { l++;  } 
+        else if (luaS_ptr_eq(s,rule))    { l+=9; }
+        else if (luaS_ptr_eq(s,right) ||
+		 luaS_ptr_eq(s,node) ||
+		 luaS_ptr_eq(s,down))    { l+=5; }
+        else if (luaS_ptr_eq(s,special)) { 
+	  size_t len;
+          lua_rawgeti(L,-2,2);
+          (void)lua_tolstring(L,-1,&len); 
+          lua_pop(L,1);
+          if (len>0) { l = l + 5 + len;  } 
+        }
+        else { fprintf(stdout,"unknown packet command %s!\n",s); }
+      } else {
+        fprintf(stdout,"no packet command!\n");
+      }
+      lua_pop(L,1); /* command name */
+    }
+    lua_pop(L,1); /* item */
+  }
+  return l;
+}
+
+
+
+scaled
+sp_to_dvi (halfword sp, halfword atsize) {
+  double result, mult;
+  mult = (double)(atsize>>16);
+  result = (sp << 4);
+  return floor (result/mult );
+}
+
+
+static void
+read_char_packets  (lua_State *L, integer *l_fonts, charinfo *co, int atsize) {
+  int i, n, m;
+  size_t l;
+  int cmd;
+  char *s;
+  real_eight_bits *cpackets;
+  int ff = 0;
+  int np = 0;
+  int max_f = 0;
+  int pc = count_char_packet_bytes  (L);
+  if (pc<=0)
+    return;
+  assert(l_fonts != NULL);
+  assert(l_fonts[1] != 0);
+  while (l_fonts[(max_f+1)]!=0) 
+    max_f++;
+
+  cpackets = xmalloc(pc+1);
+  for (i=1;i<=lua_objlen(L,-1);i++) {
+    lua_rawgeti(L,-1,i);
+    if (lua_istable(L,-1)) {
+      /* fetch the command code */
+      lua_rawgeti(L,-1,1);
+      if (lua_isstring(L,-1)) {
+	s = (char *)lua_tostring(L,-1);
+	cmd = 0;
+	if (luaS_ptr_eq(s,font)) {  
+	  cmd = packet_font_code;     
+	} else if (luaS_ptr_eq(s,char)) { 
+	  cmd = packet_char_code;     
+	  if (ff==0) {
+	    append_packet(packet_font_code);
+	    ff = l_fonts[1];
+	    do_store_four(ff);
+	  }
+	} else if (luaS_ptr_eq(s,slot)) { 
+	  cmd = packet_nop_code;
+	  lua_rawgeti(L,-2,2);  n = lua_tointeger(L,-1);
+	  ff = (n>max_f ? l_fonts[1] : l_fonts[n]);
+	  lua_rawgeti(L,-3,3);  n = lua_tointeger(L,-1);
+	  lua_pop(L,2);
+	  append_packet(packet_font_code);
+	  do_store_four(ff);
+	  append_packet(packet_char_code);
+	  do_store_four(n);
+	} 
+	else if (luaS_ptr_eq(s,comment)) {  cmd = packet_nop_code;     } 
+	else if (luaS_ptr_eq(s,node))    {  cmd = packet_node_code;    }
+	else if (luaS_ptr_eq(s,push))    {  cmd = packet_push_code;    } 
+	else if (luaS_ptr_eq(s,pop))     {  cmd = packet_pop_code;     } 
+	else if (luaS_ptr_eq(s,rule))    {  cmd = packet_rule_code;    }
+	else if (luaS_ptr_eq(s,right))   {  cmd = packet_right_code;   }
+	else if (luaS_ptr_eq(s,down))    {  cmd = packet_down_code;    }
+	else if (luaS_ptr_eq(s,special)) {  cmd = packet_special_code; } 
+	
+        switch(cmd) {
+        case packet_push_code:
+        case packet_pop_code:
+          append_packet(cmd);
+          break;
+        case packet_font_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          n = lua_tointeger(L,-1);
+          ff = (n>max_f ? l_fonts[1] : l_fonts[n]);
+          do_store_four(ff);
+          lua_pop(L,1);
+          break;
+        case packet_node_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          n = copy_node_list(nodelist_from_lua(L));
+          do_store_four(n);
+          lua_pop(L,1);
+          break;
+        case packet_char_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          n = lua_tointeger(L,-1);
+          do_store_four(n);
+          lua_pop(L,1);
+          break;
+        case packet_right_code:
+        case packet_down_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          n = lua_tointeger(L,-1);
+          do_store_four(sp_to_dvi(n,atsize));
+          lua_pop(L,1);
+          break;
+        case packet_rule_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          n = lua_tointeger(L,-1);
+          do_store_four(sp_to_dvi(n,atsize));
+          lua_rawgeti(L,-3,3);
+          n = lua_tointeger(L,-1);
+          do_store_four(sp_to_dvi(n,atsize));
+          lua_pop(L,2);
+          break;
+        case packet_special_code:
+          append_packet(cmd);
+          lua_rawgeti(L,-2,2);
+          s = (char *)lua_tolstring(L,-1,&l);
+          if (l>0) {
+            do_store_four(l);
+            m = (int)l;
+            while(m>0) {
+              n = *s++;
+	      m--;
+              append_packet(n);
+            }
+          }
+          lua_pop(L,1);
+          break;
+        case packet_nop_code:
+          break;
+        default:
+          fprintf(stdout,"Unknown char packet code %s (char %d in font %s)\n",s,(int)c,font_name(f));
+        }
+      }
+      lua_pop(L,1); /* command code */
+    } else {
+      fprintf(stdout,"Found a `commands' item that is not a table (char %d in font %s)\n",(int)c,font_name(f));
+    }
+    lua_pop(L,1); /* command table */
+  }
+  append_packet(packet_end_code);
+  set_charinfo_packets(co,cpackets);
+  return;
+}
+
+
+static void
+read_lua_cidinfo (lua_State *L, int f) {
+  int i;
+  char *s;
+  lua_getfield(L,-1,"cidinfo");
+  if (lua_istable(L,-1)) {        
+    i = numeric_field(L,"version",0);
+    set_font_cidversion(f,i);    
+    i = numeric_field(L,"supplement",0);
+    set_font_cidsupplement(f,i);
+    s = string_field(L,"registry","Adobe"); /* Adobe-Identity-0 */
+    set_font_cidregistry(f,s);
+    s = string_field(L,"ordering","Identity");
+    set_font_cidordering(f,s);
+  }
+  lua_pop(L,1);
+}
+
+
+static void
+read_lua_parameters (lua_State *L, int f) {
+  int i, n;
+  char *s;
+  lua_getfield(L,-1,"parameters");
+  if (lua_istable(L,-1)) {        
+    /* the number of parameters is the max(IntegerKeys(L)),7) */
+    n = 7;
+    lua_pushnil(L);  /* first key */
+    while (lua_next(L, -2) != 0) {
+      if (lua_isnumber(L,-2)) {
+        i = lua_tonumber(L,-2);
+        if (i > n)  n = i;
+      }
+      lua_pop(L,1); /* pop value */
+    }
+    if (n>7) set_font_params(f,n);
+    /* sometimes it is handy to have all integer keys */
+    for (i=1;i<=7;i++) {
+      lua_rawgeti(L,-1,i);
+      if (lua_isnumber(L,-1)) {
+        n = lua_roundnumber(L,-1);
+        set_font_param(f,i, n);
+      }
+      lua_pop(L,1); 
+    }
+    lua_pushnil(L);  /* first key */
+    while (lua_next(L, -2) != 0) {
+      if (lua_isnumber(L,-2)) {
+        i = lua_tointeger(L,-2);
+        if (i>=8) {
+          n = (lua_isnumber(L,-1) ? lua_roundnumber(L,-1) : 0);
+          set_font_param(f,i, n);
+        }
+      } else if (lua_isstring(L,-2)) {
+        s = (char *)lua_tostring(L,-2);
+        n = (lua_isnumber(L,-1) ? lua_roundnumber(L,-1) : 0);
+        if       (luaS_ptr_eq(s,slant))         {  set_font_param(f,slant_code,n); }
+        else if  (luaS_ptr_eq(s,space))         {  set_font_param(f,space_code,n); }
+        else if  (luaS_ptr_eq(s,space_stretch)) {  set_font_param(f,space_stretch_code,n); }
+        else if  (luaS_ptr_eq(s,space_shrink))  {  set_font_param(f,space_shrink_code,n); }
+        else if  (luaS_ptr_eq(s,x_height))      {  set_font_param(f,x_height_code,n); }
+        else if  (luaS_ptr_eq(s,quad))          {  set_font_param(f,quad_code,n); }
+        else if  (luaS_ptr_eq(s,extra_space))   {  set_font_param(f,extra_space_code,n); }
+      }
+      lua_pop(L,1); 
+    }
+  }
+  lua_pop(L,1);
+
+}
+ 
+void
+font_char_from_lua (lua_State *L, internal_font_number f, integer i, integer *l_fonts) {
+  int k,r,t;
+  charinfo *co;
+  kerninfo *ckerns;
+  liginfo *cligs;
+  scaled j;
+  char *s;
+  int nl = 0; /* number of ligature table items */
+  int nk = 0; /* number of kern table items */
+  int ctr = 0;
+  int atsize = font_size(f);
+  if (lua_istable(L,-1)) {
+    co = get_charinfo(f,i); 
+    set_charinfo_tag       (co,0);
+    j = n_numeric_field(L,luaS_width_index,0);        set_charinfo_width (co,j);
+    j = n_numeric_field(L,luaS_height_index,0);       set_charinfo_height (co,j);
+    j = n_numeric_field(L,luaS_depth_index,0);        set_charinfo_depth (co,j);
+    j = n_numeric_field(L,luaS_italic_index,0);       set_charinfo_italic (co,j);              
+    j = n_numeric_field(L,luaS_index_index,0);        set_charinfo_index(co,j);
+    j = n_numeric_field(L,luaS_expansion_factor_index,0);  set_charinfo_ef(co,j);
+    j = n_numeric_field(L,luaS_left_protruding_index,0);   set_charinfo_lp(co,j);
+    j = n_numeric_field(L,luaS_right_protruding_index,0);  set_charinfo_rp(co,j);
+    k = n_boolean_field(L,luaS_used_index,0);         set_charinfo_used(co,k);
+    s = n_string_field (L,luaS_name_index,NULL);      set_charinfo_name(co,s);
+    s = n_string_field (L,luaS_tounicode_index,NULL); set_charinfo_tounicode(co,s);
+    k = n_numeric_field(L,luaS_next_index,-1); 
+    if (k>=0) {
+      set_charinfo_tag       (co,list_tag);
+      set_charinfo_remainder (co,k);
+    }
+    lua_getfield(L,-1,"extensible");
+    if (lua_istable(L,-1)){ 
+      int top, bot,mid, rep;
+      top = n_numeric_field(L,luaS_top_index,0);
+      bot = n_numeric_field(L,luaS_bot_index,0);
+      mid = n_numeric_field(L,luaS_mid_index,0);
+      rep = n_numeric_field(L,luaS_rep_index,0);
+      if (top != 0 || bot != 0 || mid != 0 || rep != 0) {
+        set_charinfo_tag       (co,ext_tag);
+        set_charinfo_extensible (co,top,bot,mid,rep);
+      } else {
+        pdftex_warn("lua-loaded font %s char [%d] has an invalid extensible field!",font_name(f),(int)i);
+      }
+    }
+    lua_pop(L,1);
+      
+    nk = count_hash_items(L,luaS_index(kerns));
+    if (nk>0) {
+      ckerns = xcalloc((nk+1),sizeof(kerninfo));
+      lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(kerns));
+      lua_rawget(L,-2);
+      if (lua_istable(L,-1)) {  /* there are kerns */
+        ctr = 0;
+        lua_pushnil(L);
+        while (lua_next(L, -2) != 0) {
+          k = non_boundarychar;
+          if (lua_isnumber(L,-2)) {
+            k = lua_tonumber(L,-2); /* adjacent char */
+            if (k<0)
+              k = non_boundarychar;
+          } else if (lua_isstring(L,-2)) {
+            s = (char *)lua_tostring(L,-2);
+            if (luaS_ptr_eq(s,right_boundary)) {
+              k = right_boundarychar;
+              if (!has_right_boundary(f))
+                set_right_boundary(f,get_charinfo(f,right_boundarychar));
+            }
+          }
+          j = lua_roundnumber(L,-1); /* movement */
+          if (k!=non_boundarychar) {
+            set_kern_item(ckerns[ctr],k,j);
+            ctr++;
+          } else {
+            pdftex_warn("lua-loaded font %s char [%d] has an invalid kern field!",font_name(f),(int)i);
+          }
+          lua_pop(L,1);
+        }
+        /* guard against empty tables */
+        if (ctr>0) {
+          set_kern_item(ckerns[ctr],end_kern,0);
+          set_charinfo_kerns(co,ckerns);
+        } else {
+          pdftex_warn("lua-loaded font %s char [%d] has an invalid kerns field!",font_name(f),(int)i);
+        }
+      }
+      lua_pop(L,1);
+    }
+      
+    /* packet commands */
+    lua_getfield(L,-1,"commands");
+    if (lua_istable(L,-1)){ 
+      lua_pushnil(L);  /* first key */
+      if (lua_next(L, -2) != 0) {
+	lua_pop(L,2);
+	read_char_packets(L,(integer *)l_fonts,co,atsize);
+      }
+    }
+    lua_pop(L,1);
+
+    /* ligatures */
+    nl = count_hash_items(L,luaS_index(ligatures));
+      
+    if (nl>0) {
+      cligs = xcalloc((nl+1),sizeof(liginfo));
+      lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(ligatures));
+      lua_rawget(L,-2);
+      if (lua_istable(L,-1)){/* do ligs */
+        ctr = 0;
+        lua_pushnil(L);
+        while (lua_next(L, -2) != 0) {
+          k = non_boundarychar;
+          if (lua_isnumber(L,-2)) {
+            k = lua_tonumber(L,-2); /* adjacent char */
+            if (k<0) {
+              k = non_boundarychar;
+            }
+          } else if (lua_isstring(L,-2)) {
+            s = (char *)lua_tostring(L,-2);
+            if (luaS_ptr_eq(s,right_boundary)) {
+              k = right_boundarychar;
+              if (!has_right_boundary(f))
+                set_right_boundary(f,get_charinfo(f,right_boundarychar));
+            }
+          }
+          r = -1;
+          if (lua_istable(L,-1)) { 
+            r = n_numeric_field(L,luaS_char_index,-1); /* ligature */
+          }
+          if (r != -1 && k != non_boundarychar) {                
+            t = enum_field(L,"type",0,ligature_type_strings);
+            set_ligature_item(cligs[ctr],(t*2)+1,k,r);
+            ctr++;
+          } else {
+            pdftex_warn("lua-loaded font %s char [%d] has an invalid ligature field!",font_name(f),(int)i);
+          }
+          lua_pop(L,1); /* iterator value */
+        }                  
+        /* guard against empty tables */
+        if (ctr>0) {
+          set_ligature_item(cligs[ctr],0,end_ligature,0);
+          set_charinfo_ligatures(co,cligs);
+        } else {
+          pdftex_warn("lua-loaded font %s char [%d] has an invalid ligatures field!",font_name(f),(int)i);
+        }
+      }
+      lua_pop(L,1); /* ligatures table */
+    }
+  }
+}
+
+
+
+/* The caller has to fix the state of the lua stack when there is an error! */
+
+
+int
+font_from_lua (lua_State *L, int f) {
+  int i,n,r,t;
+  int s_top; /* lua stack top */
+  int bc; /* first char index */
+  int ec; /* last char index */
+  char *s;
+  integer *l_fonts = NULL;
+  /* the table is at stack index -1 */
+
+  if (luaS_width_index==0)
+    init_font_string_pointers(L);
+
+  s = string_field(L,"area","");                 set_font_area(f,s);
+  s = string_field(L,"filename",NULL);           set_font_filename(f,s);
+  s = string_field(L,"encodingname",NULL);       set_font_encodingname(f,s);
+
+  s = string_field(L,"name",NULL);               set_font_name(f,s);
+  s = string_field(L,"fullname",font_name(f));   set_font_fullname(f,s);
+
+  if (s==NULL) {
+    pdftex_fail("lua-loaded font [%d] has no name!",f);
+    return false;
+  }
+
+  i = numeric_field(L,"designsize",655360);      set_font_dsize(f,i);
+  i = numeric_field(L,"size",font_dsize(f));     set_font_size(f,i);
+  i = numeric_field(L,"checksum",0);             set_font_checksum(f,i);
+  i = numeric_field(L,"direction",0);            set_font_natural_dir(f,i);
+  i = numeric_field(L,"encodingbytes",0);        set_font_encodingbytes(f,i);
+  i = numeric_field(L,"tounicode",0);            set_font_tounicode(f,i);
+
+  i = numeric_field(L,"extend",0);
+  if (i<-2000) i = -2000; if (i>2000) i = 2000; if (i==1000) i = 0;
+  set_font_extend(f,i);
+  i = numeric_field(L,"slant",0);
+  if (i<-1000) i = -1000; if (i>1000) i = 1000;
+  set_font_slant(f,i);
+
+  i = numeric_field(L,"hyphenchar",get_default_hyphen_char()); set_hyphen_char(f,i);
+  i = numeric_field(L,"skewchar",get_default_skew_char());     set_skew_char(f,i);
+  i = boolean_field(L,"used",0);                 set_font_used(f,i);
+
+  s = string_field (L,"attributes",NULL);          
+  if (s!=NULL && strlen(s)>0) {
+	i = maketexstring(s);
+    set_pdf_font_attr(f,i);
+  }
+
+  i = enum_field(L,"type",     unknown_font_type,font_type_strings);      set_font_type(f,i);
+  i = enum_field(L,"format",   unknown_format,   font_format_strings);    set_font_format(f,i);
+  i = enum_field(L,"embedding",unknown_embedding,font_embedding_strings); set_font_embedding(f,i);
+  if (font_encodingbytes(f)==0 && 
+      (font_format(f)==opentype_format || font_format(f)==truetype_format)) {
+    set_font_encodingbytes(f,2);
+  }
+
+  /* now fetch the base fonts, if needed */
+  n = count_hash_items(L,luaS_index(fonts));
+  if (n>0) {
+    l_fonts = xmalloc((n+2)*sizeof(integer));
+    memset (l_fonts,0,(n+2)*sizeof(integer));
+    lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(fonts));
+    lua_rawget(L,-2);
+    for (i=1;i<=n;i++) {
+      lua_rawgeti(L,-1,i);
+      if (lua_istable(L,-1)) {
+	lua_getfield(L,-1,"id");
+	if (lua_isnumber(L,-1)) {
+	  l_fonts[i] = lua_tonumber(L,-1);
+	  lua_pop(L,2); /* pop id  and entry */
+	  continue; 
+	}
+	lua_pop(L,1); /* pop id */
+      };
+      s = NULL;
+      if (lua_istable(L,-1)) {
+	lua_getfield(L,-1,"name");
+	if (lua_isstring(L,-1)) {
+	  s = (char *)lua_tostring(L,-1);
+	}
+	lua_pop(L,1); /* pop name */
+      }
+      if (s!= NULL) {
+	lua_getfield(L,-1,"size");
+	t = (lua_isnumber(L,-1) ? lua_roundnumber(L,-1) : -1000);
+	lua_pop(L,1);
+        
+	/* TODO: the stack is messed up, otherwise this 
+	 * explicit resizing would not be needed 
+	 */
+	s_top = lua_gettop(L);
+	l_fonts[i] = find_font_id(s,"",t);
+	lua_settop(L,s_top);
+      } else {
+	pdftex_fail("Invalid local font in font %s!\n", font_name(f));
+      }
+      lua_pop(L,1); /* pop list entry */
+    }
+    lua_pop(L,1); /* pop list entry */
+  } else {
+    if(font_type(f) == virtual_font_type) {
+      pdftex_fail("Invalid local fonts in font %s!\n", font_name(f));
+    } else {
+      l_fonts = xmalloc(3*sizeof(integer));
+      l_fonts[0] = 0;
+      l_fonts[1] = f;
+      l_fonts[2] = 0;
+    }
+  }
+
+  /* parameters */
+  read_lua_parameters(L,f);
+  read_lua_cidinfo(L,f);
+
+  /* characters */
+  lua_getfield(L,-1,"characters");
+  if (lua_istable(L,-1)) {        
+    /* find the array size values */
+    ec = 0; bc = -1; 
+    lua_pushnil(L);  /* first key */
+    while (lua_next(L, -2) != 0) {
+      if (lua_isnumber(L,-2)) {
+        i = lua_tointeger(L,-2);
+        if (i>=0) {
+          if (lua_istable(L,-1)) {
+            if (i>ec) ec = i;
+            if (bc<0) bc = i;
+            if (bc>=0 && i<bc) bc = i;
+          }
+        }
+      }
+      lua_pop(L, 1);
+    }
+
+    if (bc != -1) {
+	  /* fprintf(stdout,"defined a font at %d with %d-%d\n",f,bc,ec); */
+      set_font_bc(f,bc);
+      set_font_ec(f,ec);
+      lua_pushnil(L);  /* first key */
+      while (lua_next(L, -2) != 0) {
+        if (lua_isnumber(L,-2)) {
+          i = lua_tonumber(L,-2);
+          if (i>=0) {
+            font_char_from_lua(L,f, i, l_fonts);
+          }
+        } else if (lua_isstring(L,-2)) {
+          s = (char *)lua_tostring(L,-2);
+          if (luaS_ptr_eq(s,left_boundary)) {
+            font_char_from_lua(L,f, left_boundarychar, l_fonts);
+          } else if (luaS_ptr_eq(s,right_boundary)) {
+            font_char_from_lua(L,f, right_boundarychar, l_fonts);
+          }
+        }
+        lua_pop(L, 1);
+      }
+      lua_pop(L, 1);
+      
+	  /* handle font expansion last: the |copy_font| routine is called eventually, 
+		 and that needs to know |bc| and |ec|. */
+	  if (font_type(f)!=virtual_font_type) {
+		int fstep = numeric_field(L,"step",0);
+		if (fstep<0) fstep = 0; 
+		if (fstep>100) fstep = 100;
+		if (fstep!=0) {
+		  int fshrink = numeric_field(L,"shrink",0);
+		  int fstretch = numeric_field(L,"stretch",0);
+		  int fexpand = boolean_field(L,"auto_expand",0);
+		  if (fshrink<0)     fshrink = 0; 
+		  if (fshrink>500)   fshrink = 500;
+		  fshrink -=         (fshrink % fstep);
+		  if (fshrink<0)     fshrink = 0; 
+		  if (fstretch<0)    fstretch = 0; 
+		  if (fstretch>1000) fstretch = 1000;
+		  fstretch -=        (fstretch % fstep);
+		  if (fstretch<0)    fstretch = 0; 
+		  set_expand_params(f, fexpand, fstretch, fshrink, fstep, 0);
+		}
+	  }
+
+    } else { /* jikes, no characters */
+      pdftex_warn("lua-loaded font [%d] (%s) has no characters!",f, font_name(f));
+    }
+
+#if SAVE_REF
+    r = luaL_ref(Luas[0],LUA_REGISTRYINDEX);    /* pops the table */
+    set_font_cache_id(f,r);
+#else
+    lua_pop(Luas[0],1);
+#endif
+  } else { /* jikes, no characters */
+    pdftex_warn("lua-loaded font [%d] (%s) has no character table!",f, font_name(f));
+  }
+
+  if (l_fonts!=NULL) 
+    free(l_fonts);
+  return true;
+}
+
+/* ====================================================================
+ *
+ * L I G A T U R I N G
+ *
+ * ==================================================================== */
+
+
+#define assert_disc(a) \
+  assert(pre_break(a)!=null); /* expect head_node */ \
+  assert(type(pre_break(a))==nesting_node);				\
+  assert((vlink_pre_break(a)==null && tlink_pre_break(a)==null) || tail_of_list(vlink_pre_break(a))==tlink_pre_break(a)); \
+  assert(post_break(a)!=null); /* expect head_node */ \
+  assert(type(post_break(a))==nesting_node);					  \
+  assert((vlink_post_break(a)==null && tlink_post_break(a)==null) || tail_of_list(vlink_post_break(a))==tlink_post_break(a)); \
+  assert(no_break(a)!=null); /* expect head_node */	  \
+  assert(type(no_break(a))==nesting_node);					  \
+  assert((vlink_no_break(a)==null && tlink_no_break(a)==null) || tail_of_list(vlink_no_break(a))==tlink_no_break(a)); 
+
+static void 
+nesting_append (halfword nest, halfword newn) {
+  halfword tail = tlink(nest);
+  assert(alink(nest)==null);
+  assert(vlink(newn)==null);
+  assert(alink(newn)==null);
+  if (tail==null) {
+    assert(vlink(nest)==null);
+    couple_nodes(nest,newn);
+  } else {
+    assert(vlink(tail)==null);
+    assert(tail_of_list(vlink(nest))==tail);
+    couple_nodes(tail,newn);
+  }
+  tlink(nest) = newn;
+}
+
+
+static void 
+nesting_prepend (halfword nest, halfword newn) {
+  halfword head = vlink(nest);
+  assert(alink(nest)==null);
+  assert(vlink(newn)==null);
+  assert(alink(newn)==null);
+  couple_nodes(nest,newn);
+  if (head==null) {
+    assert(tlink(nest)==null);
+    tlink(nest) = newn;
+  } else {
+    assert(alink(head)==nest);
+    assert(tail_of_list(head)==tlink(nest));
+    couple_nodes(newn,head);
+  }
+}
+
+
+static int
+test_ligature( liginfo *lig, halfword left, halfword right ) {
+  if (type(left)!=glyph_node)
+	return 0;
+  assert(type(right)==glyph_node);
+  if (font(left)!=font(right)) return 0;
+  if (is_ghost(left) || is_ghost(right)) return 0;
+  *lig = get_ligature(font(left),character(left),character(right));
+  if (is_valid_ligature(*lig)) {
+	return 1;
+  }
+  return 0;
+}
+
+
+static int
+try_ligature(halfword *frst, halfword fwd) {
+  halfword cur = *frst;
+  liginfo lig;
+  if (test_ligature(&lig,cur,fwd)) {
+    int move_after = (lig_type(lig) & 0x0C)>>2;
+    int keep_right = ((lig_type(lig) & 0x01) != 0);
+    int keep_left  = ((lig_type(lig) & 0x02) != 0);
+    halfword newgl = raw_glyph_node();
+	font(newgl)      = font(cur);
+	character(newgl) = lig_replacement(lig);
+    set_is_ligature(newgl);
+
+    /* below might not be correct in contrived border case.
+     * but we use it only for debugging, so ... */ 
+    if (character(cur)<0) {
+      set_is_leftboundary(newgl);
+	} 
+	if (character(fwd)<0) {
+      set_is_rightboundary(newgl);
+	} 
+	if (character(cur)<0) {
+	  if (character(fwd)<0) {
+		build_attribute_list(newgl);
+	  } else {
+		add_node_attr_ref(node_attr(fwd));
+		node_attr(newgl) = node_attr(fwd);
+	  }
+	} else {
+		add_node_attr_ref(node_attr(cur));
+      node_attr(newgl) = node_attr(cur);
+	}
+
+    /* TODO/FIXME if this ligature is consists of another ligature
+     * we should add it's lig_ptr to the new glyphs lig_ptr (and
+     * cleanup the no longer needed node) LOW PRIORITY */
+    /* left side */
+    if (keep_left) {
+      halfword new_first = copy_node(cur);
+      lig_ptr(newgl) = new_first;
+      couple_nodes(cur,newgl);
+      if (move_after) {
+        move_after--;
+        cur = newgl;
+      }
+    } else {
+      halfword prev = alink(cur);
+      uncouple_node(cur);
+      lig_ptr(newgl) = cur;
+      assert(prev!=null);
+      couple_nodes(prev,newgl);
+      cur = newgl; /* as cur has disappeared */
+    }
+    /* right side */
+    if (keep_right) {
+      halfword new_second = copy_node(fwd);
+      /* correct, because we _know_ lig_ptr points to _one_ node */
+      couple_nodes(lig_ptr(newgl),new_second);
+      couple_nodes(newgl,fwd);
+      if (move_after) {
+        move_after--;
+        cur = fwd;
+      }
+    } else {
+      halfword next = vlink(fwd);
+      uncouple_node(fwd);
+      /* correct, because we _know_ lig_ptr points to _one_ node */
+      couple_nodes(lig_ptr(newgl),fwd);
+      if (next!=null) {couple_nodes(newgl,next);}
+    }
+
+    /* check and return */
+    /* assert(move_after==0);*/
+    *frst = cur;
+    return 1;
+  }
+  return 0;
+}
+
+
+/* there shouldn't be any ligatures here - we only add them at the end of
+ * xxx_break in a DISC-1 - DISC-2 situation and we stop processing DISC-1
+ * (we continue with DISC-1's post_ and no_break */
+static halfword
+handle_lig_nest(halfword root, halfword cur) {
+  if (cur==null) return root;
+  while (vlink(cur)!=null) {
+    halfword fwd = vlink(cur);
+    if (type(cur)==glyph_node && type(fwd)==glyph_node &&
+        font(cur)==font(fwd)  && try_ligature(&cur,fwd)) continue;
+    cur  = vlink(cur);
+    assert(vlink(alink(cur))==cur);
+  }
+  tlink(root) = cur;
+  return root;
+}
+
+
+static halfword 
+handle_lig_word(halfword cur) {
+  halfword right=null;
+      
+  if (type(cur)==whatsit_node && subtype(cur)==cancel_boundary_node) {
+    halfword prev= alink(cur);
+    halfword fwd = vlink(cur);
+/*  uncouple_node(cur); */ /* not needed, it is freed */
+    flush_node(cur);
+    if (fwd==null) {
+      vlink(prev) = fwd;
+      return prev;
+    }
+    couple_nodes(prev,fwd);
+    if (type(fwd)!=glyph_node) return prev;
+    cur = fwd;
+  } else if (has_left_boundary(font(cur))) {
+    halfword prev= alink(cur);
+    halfword p  = new_glyph(font(cur),left_boundarychar);
+    couple_nodes(prev,p);
+    couple_nodes(p,cur);
+    cur         = p;
+  }
+  if (has_right_boundary(font(cur))) {
+    right = new_glyph(font(cur),right_boundarychar);
+  }
+
+  while (1) {
+    /* A glyph followed by ... */
+    if (type(cur)==glyph_node) {
+      halfword fwd = vlink(cur);
+      if (fwd==null) { /* last character of paragraph */
+        if (right==null) break;
+        couple_nodes(cur,right);
+        right = null;
+        continue;
+      }
+      assert(alink(fwd)==cur);
+      if (type(fwd)==glyph_node) { /* GLYPH - GLYPH */
+        if (font(cur)!=font(fwd)) break;
+        if (try_ligature(&cur,fwd)) continue;
+      } else if (type(fwd)==disc_node) { /* GLYPH - DISC */
+
+        /* if  a{bx}{}{y} and a+b=>B convert to {Bx}{}{ay} */
+        halfword pre = vlink_pre_break(fwd);
+        halfword nob = vlink_no_break(fwd);
+        liginfo lig;
+        assert_disc(fwd);
+        /* Check on: a{b?}{?}{?} and a+b=>B : {B?}{?}{a?}*/
+        /* Check on: a{?}{?}{b?} and a+b=>B : {a?}{?}{B?} */
+        if ( (pre!=null && type(pre)==glyph_node && test_ligature(&lig,cur,pre))
+          || (nob!=null && type(nob)==glyph_node && test_ligature(&lig,cur,nob))) {
+          /* move cur from before disc, to skipped part */
+          halfword prev = alink(cur);
+          assert(vlink(prev)==cur);
+          uncouple_node(cur);
+          couple_nodes(prev,fwd);
+          nesting_prepend(no_break(fwd),cur);
+          /* now ligature the pre_break */
+          nesting_prepend(pre_break(fwd),copy_node(cur));
+          /* As we have removed cur, we need to start again ... */
+          cur = prev;
+        } 
+        /* Check on: a{?}{?}{}b and a+b=>B : {a?}{?b}{B}*/
+        halfword next = vlink(fwd);
+        if (nob==null && next != null && type(next)==glyph_node
+          && test_ligature(&lig,cur,next)) {
+          /* move cur from before disc to no_break part */
+          halfword prev = alink(cur);
+          assert(alink(next)==fwd);
+          assert(vlink(prev)==cur);
+          uncouple_node(cur);
+          couple_nodes(prev,fwd);
+          couple_nodes(no_break(fwd),cur); /* we _know_ it's empty */
+          /* now copy cur the pre_break */
+          nesting_prepend(pre_break(fwd),copy_node(cur));
+          /* move next from after disc to no_break part */
+          halfword tail = vlink(next);
+          uncouple_node(next);
+          try_couple_nodes(fwd,tail);
+          couple_nodes(cur,next); /* we _know_ this works */
+          tlink(no_break(fwd)) = next; /* and make sure the list is correct */
+          /* now copy next to the post_break */
+          nesting_append(post_break(fwd),copy_node(next));
+          /* As we have removed cur, we need to start again ... */
+          cur = prev;
+        }
+        /* we are finished with the pre_break */
+        handle_lig_nest(pre_break(fwd),vlink_pre_break(fwd));
+      } else if (type(fwd)==whatsit_node && subtype(fwd)==cancel_boundary_node) {
+        halfword next = vlink(fwd);
+        try_couple_nodes(cur,next);
+        flush_node(fwd);
+        if (right!=null) {
+          flush_node(right); /* Shame, didn't need it */
+	  /*        right = null; */ /* no need, we're going to leave the loop anyway */
+        }
+        break;
+      } else { /* fwd is something unknown */
+        if (right==null) break;
+        couple_nodes(cur,right);
+        couple_nodes(right,fwd);
+        right = null;
+        continue;
+      }
+    /* A discretionary followed by ... */
+    } else if (type(cur)==disc_node) {
+      assert_disc(cur);
+      /* If {?}{x}{?} or {?}{?}{y} then ... */
+      if (vlink_no_break(cur)!=null || vlink_post_break(cur)!=null) {
+        halfword fwd;
+        halfword lists[511]; /* max 8 levels */
+
+        int i, max_depth=0;
+        lists[max_depth++] = handle_lig_nest(post_break(cur),vlink_post_break(cur));
+        lists[max_depth++] = handle_lig_nest(no_break(cur),vlink_no_break(cur));
+        while (1) {
+          if ((fwd = vlink(cur))==null) return cur;
+          if ( type(fwd)==glyph_node) {
+            for (i=0; i<max_depth; i++) {
+              liginfo lig;
+              halfword tail = tlink(lists[i]);
+              if ( tail!=null && test_ligature(&lig,tail,fwd))
+                goto add_glyph_to_all;
+            }
+            /* if we get here, nothing had a ligature, so we stop */
+            break;
+add_glyph_to_all:
+            for (i=0; i<max_depth; i++) {
+              halfword copy = copy_node(fwd);
+              halfword tail = tlink(lists[i]);
+              nesting_append(lists[i],copy);
+              if (tail==null) continue; /* first character - never a ligature */
+              handle_lig_nest(lists[i],tail);
+            }
+            halfword next = vlink(fwd);
+            uncouple_node(fwd);
+            try_couple_nodes(cur,next);
+            flush_node(fwd);
+          } else if ( type(fwd)==disc_node) {
+            /* MAGIC WARNING
+             * A disc followed by a disc can have different kernings
+             * depending on which path is choosen, and it is impossible to
+             * store the possible kernings: fe {}{A}{W} {V}{}{A}
+             * So we _always_ add discs so only a simple path remains. */
+            int m=max_depth; /* as max_depth changes in this loop */
+            for (i=0; i<m; i++) {
+              halfword copy = copy_node(fwd);
+              halfword tail = tlink(lists[i]);
+              if (tail!=null) {
+                halfword prev = alink(tail);
+				assert(alink(tail)!=null);
+                uncouple_node(tail);
+                vlink(prev) = null;
+                if (prev==lists[i]) {
+                  tlink(prev) = null;
+                } else {
+                  tlink(lists[i]) = prev;
+                }
+                nesting_prepend(pre_break(copy),tail);
+                nesting_prepend(no_break(copy),copy_node(tail));
+              }
+              nesting_append(lists[i],copy);
+              handle_lig_nest(pre_break(copy),vlink_pre_break(copy));
+              assert(max_depth<256);
+              lists[max_depth++] = handle_lig_nest(no_break(copy),vlink_no_break(copy));
+              lists[i]           = handle_lig_nest(post_break(copy),vlink_post_break(copy));
+            }
+            halfword next = vlink(fwd);
+            uncouple_node(fwd);
+            try_couple_nodes(cur,next);
+            flush_node(fwd);
+          } else {
+            return cur;
+          }
+        }
+      }
+    } else { /* NO GLYPH NOR DISC */
+      /* fprintf(stdout,"This is a %d node\n",type(cur));*/
+      /* assert(0);*/ /* TODO howcome there can be a glue here? */
+      return cur;
+    }
+    /* step-to-next-node */
+    {
+      halfword prev = cur;
+      cur  = vlink(cur);
+      assert(cur!=null);
+      assert(alink(cur)==prev);
+      /*  alink(cur) = prev;*/
+    }
+  }
+
+  return cur;
+}
+
+/* return = new tail, head should be a dummy */
+
+halfword 
+handle_ligaturing(halfword head, halfword tail) {
+  halfword save_tail ; /* trick to allow explicit node==null tests */
+  halfword cur, prev;
+
+  if (vlink(head)==null)
+    return tail;
+  save_tail = vlink(tail);
+  vlink(tail) = null;
+
+  /* if (fix_node_lists) */
+  fix_node_list(head);
+
+  prev = head;
+  cur = vlink(prev);
+
+  while (cur!=null) {
+    if ( type(cur)==glyph_node ||
+        (type(cur)==whatsit_node && subtype(cur)==cancel_boundary_node)) {
+      cur = handle_lig_word(cur);
+    }
+    prev = cur;
+    cur = vlink(cur);
+    assert(cur==null||alink(cur) == prev);
+  }
+  if (valid_node(save_tail)) {
+    try_couple_nodes(prev,save_tail);
+  }
+  return prev;
+}
+
+
+/* ====================================================================
+ *
+ * K E R N I N G
+ *
+ * ==================================================================== */
+
+static void
+add_kern_before(halfword left, halfword right) {
+  if ((!is_rightghost(right)) && 
+      font(left)==font(right) && 
+      has_kern(font(left),character(left))) {
+    int k = get_kern(font(left),character(left),character(right));
+    if (k!=0) {
+      halfword kern = new_kern(k);
+      halfword prev = alink(right);
+      assert(vlink(prev)==right);
+      couple_nodes(prev,kern);
+      couple_nodes(kern,right);
+    }
+  }
+}
+
+
+static void
+add_kern_after(halfword left, halfword right, halfword aft) {
+  if ((!is_rightghost(right)) && 
+      font(left)==font(right) && 
+      has_kern(font(left),character(left))) {
+    int k = get_kern(font(left),character(left),character(right));
+    if (k!=0) {
+      halfword kern = new_kern(k);
+      halfword next = vlink(aft);
+      assert(next==null||alink(next)==aft);
+      couple_nodes(aft,kern);
+      try_couple_nodes(kern,next);
+    }
+  }
+}
+
+
+static void
+do_handle_kerning (halfword root, halfword init_left, halfword init_right) {
+  halfword cur = vlink(root);
+  halfword left = null;
+  assert(init_left==null || type(init_left)==glyph_node);
+  assert(init_right==null || type(init_right)==glyph_node);
+  if (cur==null) {
+    if (init_left!=null && init_right!=null) {
+      add_kern_after(init_left,init_right,root);
+      tlink(root)=vlink(root);
+    }
+    return;
+  }
+  if (type(cur)==glyph_node) {
+    set_is_glyph(cur);
+    if (init_left!=null) 
+      add_kern_before(init_left,cur);
+    left = cur;
+  }
+  while ((cur=vlink(cur))!=null) {
+    if (type(cur)==glyph_node) {
+      set_is_glyph(cur);
+      if (left != null) { 
+        add_kern_before(left,cur);
+        if (character(left)<0 || is_ghost(left)) {
+          halfword prev = alink(left);
+          couple_nodes(prev,cur);
+          flush_node(left);
+        }
+      }
+      left = cur;
+    } else {
+      if (type(cur)==disc_node) {
+        halfword right= type(vlink(cur))==glyph_node ? vlink(cur) : null;
+        do_handle_kerning(pre_break(cur),left,null);
+        do_handle_kerning(post_break(cur),null,right);
+        do_handle_kerning(no_break(cur),left,right);
+      }
+      if (left != null) {
+        if (character(left)<0 || is_ghost(left)) {
+          halfword prev = alink(left);
+          couple_nodes(prev,cur);
+          flush_node(left);
+        }
+        left = null;
+      }
+    }
+  }
+  if (left!=null) {
+    if (init_right!=null)
+      add_kern_after(left,init_right,left);
+    if (character(left)<0 || is_ghost(left)) {
+      halfword prev = alink(left);
+      halfword next = vlink(left);
+      if (next!=null) {
+        couple_nodes(prev,next);
+        tlink(root) = next;
+        assert(vlink(next)==null);
+        assert(type(next)==kern_node);
+      } else if (prev!=root) {
+        vlink(prev) = null;
+        tlink(root) = prev;
+      } else {
+        vlink(root) = null;
+        tlink(root) = null;
+      }
+      flush_node(left);
+    }
+  }
+}
+
+
+halfword
+handle_kerning (halfword head, halfword tail) {
+  halfword save_link;
+  save_link = vlink(tail);
+  vlink(tail) = null;
+  tlink(head) = tail;
+  do_handle_kerning(head,null,null);
+  tail = tlink(head);
+  if (valid_node(save_link)) {
+    try_couple_nodes(tail,save_link);  
+  }
+  return tail;
+}
+
+/* ====================================================================
+ *
+ * L I G A T U R I N G and K E R N I N G   :   L U A - I N T E R F A C E
+ *
+ * ==================================================================== */
+
+static halfword
+run_lua_ligkern_callback (halfword head, halfword tail, int callback_id){
+  lua_State *L = Luas[0];
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1, callback_id);
+  if (!lua_isfunction(L,-1)) {
+    lua_pop(L,2);
+    return tail;
+  }
+  nodelist_to_lua(L,head);
+  nodelist_to_lua(L,tail);
+  if (lua_pcall(L,2,1,0) != 0) {
+    fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+    lua_pop(L,2);
+    lua_error(L);
+    return tail;
+  } 
+  tail = nodelist_from_lua(L);
+  if (fix_node_lists) 
+    fix_node_list(head);
+  lua_pop(L,2);
+  return tail;
+}
+
+
+halfword 
+new_ligkern(halfword head, halfword tail) {
+  int callback_id = 0;
+
+  assert(head!=null);
+  if (vlink(head)==null)
+    return tail;
+
+  callback_id = callback_defined(ligaturing_callback);
+  if (callback_id>0) {
+    tail = run_lua_ligkern_callback(head,tail,callback_id);
+    if (tail==null) tail = tail_of_list(head);
+  } else {
+    tail = handle_ligaturing(head,tail);
+  }	
+  
+  callback_id = callback_defined(kerning_callback);
+  if (callback_id>0) {
+    tail = run_lua_ligkern_callback(head,tail,callback_id);
+    if (tail==null) tail  = tail_of_list(head);
+  } else {
+    halfword nest = new_node(nesting_node,1);
+    halfword cur  = vlink(head);
+    halfword aft = vlink(tail);
+    couple_nodes(nest,cur);
+    tlink(nest)=tail;
+    vlink(tail)=null;
+    do_handle_kerning(nest,null,null);
+    couple_nodes(head,vlink(nest));
+    tail = tlink(nest);
+    try_couple_nodes(tail,aft);
+    flush_node(nest);
+  }
+  return tail;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/macnames.c b/Build/source/texk/web2c/luatexdir/font/macnames.c
new file mode 100644
index 00000000000..941f087ef56
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/macnames.c
@@ -0,0 +1,312 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: macnames.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+const char notdef[] = ".notdef";
+
+const char *mac_glyph_names[] = {
+/* 0x00 */
+    notdef,
+    ".null",
+    "CR",
+    "space",
+    "exclam",
+    "quotedbl",
+    "numbersign",
+    "dollar",
+    "percent",
+    "ampersand",
+    "quotesingle",
+    "parenleft",
+    "parenright",
+    "asterisk",
+    "plus",
+    "comma",
+/* 0x10 */
+    "hyphen",
+    "period",
+    "slash",
+    "zero",
+    "one",
+    "two",
+    "three",
+    "four",
+    "five",
+    "six",
+    "seven",
+    "eight",
+    "nine",
+    "colon",
+    "semicolon",
+    "less",
+/* 0x20 */
+    "equal",
+    "greater",
+    "question",
+    "at",
+    "A",
+    "B",
+    "C",
+    "D",
+    "E",
+    "F",
+    "G",
+    "H",
+    "I",
+    "J",
+    "K",
+    "L",
+/* 0x30 */
+    "M",
+    "N",
+    "O",
+    "P",
+    "Q",
+    "R",
+    "S",
+    "T",
+    "U",
+    "V",
+    "W",
+    "X",
+    "Y",
+    "Z",
+    "bracketleft",
+    "backslash",
+/* 0x40 */
+    "bracketright",
+    "asciicircum",
+    "underscore",
+    "grave",
+    "a",
+    "b",
+    "c",
+    "d",
+    "e",
+    "f",
+    "g",
+    "h",
+    "i",
+    "j",
+    "k",
+    "l",
+/* 0x50 */
+    "m",
+    "n",
+    "o",
+    "p",
+    "q",
+    "r",
+    "s",
+    "t",
+    "u",
+    "v",
+    "w",
+    "x",
+    "y",
+    "z",
+    "braceleft",
+    "bar",
+/* 0x60 */
+    "braceright",
+    "asciitilde",
+    "Adieresis",
+    "Aring",
+    "Ccedilla",
+    "Eacute",
+    "Ntilde",
+    "Odieresis",
+    "Udieresis",
+    "aacute",
+    "agrave",
+    "acircumflex",
+    "adieresis",
+    "atilde",
+    "aring",
+    "ccedilla",
+/* 0x70 */
+    "eacute",
+    "egrave",
+    "ecircumflex",
+    "edieresis",
+    "iacute",
+    "igrave",
+    "icircumflex",
+    "idieresis",
+    "ntilde",
+    "oacute",
+    "ograve",
+    "ocircumflex",
+    "odieresis",
+    "otilde",
+    "uacute",
+    "ugrave",
+/* 0x80 */
+    "ucircumflex",
+    "udieresis",
+    "dagger",
+    "degree",
+    "cent",
+    "sterling",
+    "section",
+    "bullet",
+    "paragraph",
+    "germandbls",
+    "registered",
+    "copyright",
+    "trademark",
+    "acute",
+    "dieresis",
+    "notequal",
+/* 0x90 */
+    "AE",
+    "Oslash",
+    "infinity",
+    "plusminus",
+    "lessequal",
+    "greaterequal",
+    "yen",
+    "mu",
+    "partialdiff",
+    "Sigma",
+    "Pi",
+    "pi",
+    "integral",
+    "ordfeminine",
+    "ordmasculine",
+    "Omega",
+/* 0xa0 */
+    "ae",
+    "oslash",
+    "questiondown",
+    "exclamdown",
+    "logicalnot",
+    "radical",
+    "florin",
+    "approxequal",
+    "Delta",
+    "guillemotleft",
+    "guillemotright",
+    "ellipsis",
+    "nbspace",
+    "Agrave",
+    "Atilde",
+    "Otilde",
+/* 0xb0 */
+    "OE",
+    "oe",
+    "endash",
+    "emdash",
+    "quotedblleft",
+    "quotedblright",
+    "quoteleft",
+    "quoteright",
+    "divide",
+    "lozenge",
+    "ydieresis",
+    "Ydieresis",
+    "fraction",
+    "currency",
+    "guilsinglleft",
+    "guilsinglright",
+/* 0xc0 */
+    "fi",
+    "fl",
+    "daggerdbl",
+    "periodcentered",
+    "quotesinglbase",
+    "quotedblbase",
+    "perthousand",
+    "Acircumflex",
+    "Ecircumflex",
+    "Aacute",
+    "Edieresis",
+    "Egrave",
+    "Iacute",
+    "Icircumflex",
+    "Idieresis",
+    "Igrave",
+/* 0xd0 */
+    "Oacute",
+    "Ocircumflex",
+    "applelogo",
+    "Ograve",
+    "Uacute",
+    "Ucircumflex",
+    "Ugrave",
+    "dotlessi",
+    "circumflex",
+    "tilde",
+    "macron",
+    "breve",
+    "dotaccent",
+    "ring",
+    "cedilla",
+    "hungarumlaut",
+/* 0xe0 */
+    "ogonek",
+    "caron",
+    "Lslash",
+    "lslash",
+    "Scaron",
+    "scaron",
+    "Zcaron",
+    "zcaron",
+    "brokenbar",
+    "Eth",
+    "eth",
+    "Yacute",
+    "yacute",
+    "Thorn",
+    "thorn",
+    "minus",
+/* 0xf0 */
+    "multiply",
+    "onesuperior",
+    "twosuperior",
+    "threesuperior",
+    "onehalf",
+    "onequarter",
+    "threequarters",
+    "franc",
+    "Gbreve",
+    "gbreve",
+    "Idot",
+    "Scedilla",
+    "scedilla",
+    "Cacute",
+    "cacute",
+    "Ccaron",
+/* 0x100 */
+    "ccaron",
+    "dmacron"
+};
+
+const char *ambiguous_names[] = {
+    "Delta",                    /*   increment   */
+    "Omega",                    /*   Ohm         */
+    "Pi",                       /*   product     */
+    "Sigma",                    /*   summation   */
+    "dmacron",                  /*   dslash      */
+    "macron",                   /*   overscore   */
+    "periodcentered",           /*   middot      */
+    NULL
+};
diff --git a/Build/source/texk/web2c/luatexdir/font/mapfile.c b/Build/source/texk/web2c/luatexdir/font/mapfile.c
new file mode 100644
index 00000000000..1c444e5c1d4
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/mapfile.c
@@ -0,0 +1,967 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: mapfile.c 1013 2008-02-14 00:09:02Z oneiros $
+
+*/
+
+#include <math.h>
+#include "ptexlib.h"
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-memstr.h>
+#include <string.h>
+#include "luatex-api.h"
+
+#define FM_BUF_SIZE     1024
+
+static FILE *fm_file;
+
+static unsigned char *fm_buffer = NULL;
+static integer fm_size = 0;
+static integer fm_curbyte = 0;
+
+#define fm_open()       \
+    open_input (&fm_file, kpse_fontmap_format, FOPEN_RBIN_MODE)
+#define fm_read_file()  \
+    readbinfile(fm_file,&fm_buffer,&fm_size)
+#define fm_close()      xfclose(fm_file, cur_file_name)
+#define fm_getchar()    fm_buffer[fm_curbyte++]
+#define fm_eof()        (fm_curbyte>=fm_size)
+
+typedef enum { FM_DUPIGNORE, FM_REPLACE, FM_DELETE } updatemode;
+typedef enum { MAPFILE, MAPLINE } maptype;
+
+typedef struct mitem {
+    updatemode mode;            /* FM_DUPIGNORE or FM_REPLACE or FM_DELETE */
+    maptype type;               /* map file or map line */
+    char *line;                 /* pointer to map file name or map line */
+    int lineno;                 /* line number in map file */
+} mapitem;
+mapitem *mitem = NULL;
+
+static const char nontfm[] = "<nontfm>";
+
+#define read_field(r, q, buf) do {  \
+    q = buf;                        \
+    while (*r != ' ' && *r != '<' && *r != '"' && *r != '\0') \
+        *q++ = *r++;                \
+    *q = '\0';                      \
+    skip (r, ' ');                  \
+} while (0)
+
+#define set_field(F) do {           \
+    if (q > buf)                    \
+        fm->F = xstrdup(buf);       \
+    if (*r == '\0')                 \
+        goto done;                  \
+} while (0)
+
+fm_entry *new_fm_entry(void)
+{
+    fm_entry *fm;
+    fm = xtalloc(1, fm_entry);
+    fm->tfm_name = NULL;
+    fm->sfd_name = NULL;
+    fm->ps_name = NULL;
+    fm->fd_flags = 4;
+    fm->ff_name = NULL;
+    fm->encname = NULL;
+    fm->type = 0;
+    fm->slant = 0;
+    fm->extend = 0;
+    fm->links = 0;
+    fm->pid = -1;
+    fm->eid = -1;
+    fm->subfont = NULL;
+    fm->in_use = false;
+    return fm;
+}
+
+void delete_fm_entry(fm_entry * fm)
+{
+    xfree(fm->tfm_name);
+    xfree(fm->sfd_name);
+    xfree(fm->ps_name);
+    xfree(fm->ff_name);
+    xfree(fm);
+}
+
+static ff_entry *new_ff_entry (void)
+{
+    ff_entry *ff;
+    ff = xtalloc (1, ff_entry);
+    ff->ff_name = NULL;
+    ff->ff_path = NULL;
+    return ff;
+}
+
+static void delete_ff_entry (ff_entry * ff)
+{
+    xfree (ff->ff_name);
+    xfree (ff->ff_path);
+    xfree (ff);
+}
+
+static fm_entry *dummy_fm_entry ()
+{
+    static const fm_entry const_fm_entry;
+    return (fm_entry *) & const_fm_entry;
+}
+
+/**********************************************************************/
+
+struct avl_table *tfm_tree = NULL;
+struct avl_table *ps_tree = NULL;
+struct avl_table *ff_tree = NULL;
+struct avl_table *encname_tree = NULL;
+
+/* AVL sort fm_entry into tfm_tree by tfm_name */
+
+static int comp_fm_entry_tfm (const void *pa, const void *pb, void *p)
+{
+    return strcmp (((const fm_entry *) pa)->tfm_name,
+                   ((const fm_entry *) pb)->tfm_name);
+}
+
+/* AVL sort fm_entry into ps_tree by ps_name, slant, and extend */
+
+static int comp_fm_entry_ps(const void *pa, const void *pb, void *p)
+{
+    int i;
+    const fm_entry *p1 = (const fm_entry *) pa, *p2 = (const fm_entry *) pb;
+    assert(p1->ps_name != NULL && p2->ps_name != NULL);
+    if ((i = strcmp(p1->ps_name, p2->ps_name)))
+        return i;
+    cmp_return(p1->slant, p2->slant);
+    cmp_return(p1->extend, p2->extend);
+    return 0;
+}
+
+/* AVL sort ff_entry into ff_tree by ff_name */
+
+static int comp_ff_entry (const void *pa, const void *pb, void *p)
+{
+    return strcmp (((const ff_entry *) pa)->ff_name,
+                   ((const ff_entry *) pb)->ff_name);
+}
+
+static void create_avl_trees ()
+{
+    assert(tfm_tree == NULL);
+    tfm_tree = avl_create(comp_fm_entry_tfm, NULL, &avl_xallocator);
+    assert(tfm_tree != NULL);
+    assert(ps_tree == NULL);
+    ps_tree = avl_create(comp_fm_entry_ps, NULL, &avl_xallocator);
+    assert(ps_tree != NULL);
+    assert(ff_tree == NULL);
+    ff_tree = avl_create(comp_ff_entry, NULL, &avl_xallocator);
+    assert(ff_tree != NULL);
+    assert(encname_tree == NULL);
+    encname_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
+    assert(encname_tree != NULL);
+}
+
+/*
+The function avl_do_entry() is not completely symmetrical with regards
+to tfm_name and ps_name handling, e. g. a duplicate tfm_name gives a
+"goto exit", and no ps_name link is tried. This is to keep it compatible
+with the original version.
+*/
+
+int avl_do_entry(fm_entry * fm, int mode)
+{
+    fm_entry *p;
+    void *a;
+    void **aa;
+
+    /* handle tfm_name link */
+
+    if (strcmp(fm->tfm_name, nontfm)) {
+        p = (fm_entry *) avl_find(tfm_tree, fm);
+        if (p != NULL) {
+            switch (mode) {
+            case FM_DUPIGNORE:
+                pdftex_warn
+                    ("fontmap entry for `%s' already exists, duplicates ignored",
+                     fm->tfm_name);
+                goto exit;
+                break;
+            case FM_REPLACE:
+            case FM_DELETE:
+                if (p->in_use) {
+                    pdftex_warn
+                        ("fontmap entry for `%s' has been used, replace/delete not allowed",
+                         fm->tfm_name);
+                    goto exit;
+                }
+                a = avl_delete(tfm_tree, p);
+                assert(a != NULL);
+                unset_tfmlink(p);
+                if (!has_pslink(p))
+                    delete_fm_entry(p);
+                break;
+            default:
+                assert(0);
+            }
+        }
+        if (mode != FM_DELETE) {
+            aa = avl_probe(tfm_tree, fm);
+            assert(aa != NULL);
+            set_tfmlink(fm);
+        }
+    }
+
+    /* handle ps_name link */
+
+    if (fm->ps_name != NULL) {
+        p = (fm_entry *) avl_find(ps_tree, fm);
+        if (p != NULL) {
+            switch (mode) {
+            case FM_DUPIGNORE:
+                goto exit;
+                break;
+            case FM_REPLACE:
+            case FM_DELETE:
+                if (p->in_use)
+                    goto exit;
+                a = avl_delete(ps_tree, p);
+                assert(a != NULL);
+                unset_pslink(p);
+                if (!has_tfmlink(p))
+                    delete_fm_entry(p);
+                break;
+            default:
+                assert(0);
+            }
+        }
+        if (mode != FM_DELETE && is_t1fontfile(fm) && is_included(fm)) {
+            aa = avl_probe(ps_tree, fm);
+            assert(aa != NULL);
+            set_pslink(fm);
+        }
+    }
+  exit:
+    if (!has_tfmlink(fm) && !has_pslink(fm))    /* e. g. after FM_DELETE */
+        return 1;               /* deallocation of fm_entry structure required */
+    else
+        return 0;
+}
+
+/* add the encoding name to an AVL tree. this has nothing to do with writeenc.c */
+
+char *add_encname(char *s)
+{
+    char *p;
+    void **aa;
+    assert(s != NULL);
+    assert(encname_tree != NULL);
+    if ((p = (char *) avl_find(encname_tree, s)) == NULL) {     /* encoding name not yet registered */
+        p = xstrdup(s);
+        aa = avl_probe(encname_tree, p);
+        assert(aa != NULL);
+    }
+    return p;
+}
+
+/**********************************************************************/
+/* consistency check for map entry, with warn flag */
+
+int check_fm_entry(fm_entry * fm, boolean warn)
+{
+    int a = 0;
+    assert(fm != NULL);
+
+    if (is_fontfile(fm) && !is_included(fm)) {
+        if (warn)
+            pdftex_warn
+                ("ambiguous entry for `%s': font file present but not included, "
+                 "will be treated as font file not present", fm->tfm_name);
+        xfree(fm->ff_name);
+        /* do not set variable |a| as this entry will be still accepted */
+    }
+
+    /* if both ps_name and font file are missing, drop this entry */
+    if (fm->ps_name == NULL && !is_fontfile(fm)) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': both ps_name and font file missing",
+                 fm->tfm_name);
+        a += 1;
+    }
+
+    /* TrueType fonts cannot be reencoded without subsetting */
+    if (is_truetype(fm) && is_reencoded(fm) && !is_subsetted(fm)) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': only subsetted TrueType font can be reencoded",
+                 fm->tfm_name);
+        a += 2;
+    }
+
+    /* SlantFont and ExtendFont can be used only with Type1 fonts */
+    if ((fm->slant != 0 || fm->extend != 0)
+        && !(is_t1fontfile(fm) && is_included(fm))) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': SlantFont/ExtendFont can be used only with embedded Type1 fonts",
+                 fm->tfm_name);
+        a += 4;
+    }
+
+    /* the value of SlantFont and ExtendFont must be reasonable */
+    if (abs(fm->slant) > 1000) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': too big value of SlantFont (%g)",
+                 fm->tfm_name, fm->slant / 1000.0);
+        a += 8;
+    }
+    if (abs(fm->extend) > 2000) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': too big value of ExtendFont (%g)",
+                 fm->tfm_name, fm->extend / 1000.0);
+        a += 16;
+    }
+
+    /* subfonts must be used with subsetted non-reencoded TrueType fonts */
+    if (fm->pid != -1 &&
+        !(is_truetype(fm) && is_subsetted(fm) && !is_reencoded(fm))) {
+        if (warn)
+            pdftex_warn
+                ("invalid entry for `%s': PidEid can be used only with subsetted non-reencoded TrueType fonts",
+                 fm->tfm_name);
+        a += 32;
+    }
+
+    return a;
+}
+
+/**********************************************************************/
+/* returns true if s is one of the 14 std. font names; speed-trimmed. */
+
+boolean check_std_t1font(char *s)
+{
+    static const char *std_t1font_names[] = {
+        "Courier",              /* 0:7 */
+        "Courier-Bold",         /* 1:12 */
+        "Courier-Oblique",      /* 2:15 */
+        "Courier-BoldOblique",  /* 3:19 */
+        "Helvetica",            /* 4:9 */
+        "Helvetica-Bold",       /* 5:14 */
+        "Helvetica-Oblique",    /* 6:17 */
+        "Helvetica-BoldOblique",        /* 7:21 */
+        "Symbol",               /* 8:6 */
+        "Times-Roman",          /* 9:11 */
+        "Times-Bold",           /* 10:10 */
+        "Times-Italic",         /* 11:12 */
+        "Times-BoldItalic",     /* 12:16 */
+        "ZapfDingbats"          /* 13:12 */
+    };
+    static const int index[] =
+        { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6, -1,
+        3, -1, 7
+    };
+    const size_t n = strlen(s);
+    int k = -1;
+    if (n > 21)
+        return false;
+    if (n == 12) {              /* three names have length 12 */
+        switch (*s) {
+        case 'C':
+            k = 1;              /* Courier-Bold */
+            break;
+        case 'T':
+            k = 11;             /* Times-Italic */
+            break;
+        case 'Z':
+            k = 13;             /* ZapfDingbats */
+            break;
+        default:
+            return false;
+        }
+    } else
+        k = index[n];
+    if (k > -1 && !strcmp(std_t1font_names[k], s))
+        return true;
+    return false;
+};
+
+/**********************************************************************/
+
+static void fm_scan_line()
+{
+    int a, b, c, j, u = 0, v = 0;
+    float d;
+    fm_entry *fm;
+    char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE];
+    char *p, *q, *r, *s;
+    switch (mitem->type) {
+    case MAPFILE:
+        p = fm_line;
+        do {
+	  c = fm_getchar();
+	  append_char_to_buf(c, p, fm_line, FM_BUF_SIZE);
+        }
+        while (c != 10 && !fm_eof());
+        *(--p) = '\0';
+        r = fm_line;
+        break;
+    case MAPLINE:
+        r = mitem->line;        /* work on string from makecstring() */
+        break;
+    default:
+        assert(0);
+    }
+    if (*r == '\0' || is_cfg_comment(*r))
+        return;
+    fm = new_fm_entry();
+    read_field(r, q, buf);
+    set_field(tfm_name);
+    if (!isdigit(*r)) {         /* 2nd field ps_name may not start with a digit */
+        read_field(r, q, buf);
+        set_field(ps_name);
+    }
+    if (isdigit(*r)) {          /* font descriptor /Flags given? */
+        for (s = r; isdigit(*s); s++);
+        if (*s == ' ' || *s == '"' || *s == '<' || *s == '\0') {        /* not e. g. 8r.enc */
+            fm->fd_flags = atoi(r);
+            while (isdigit(*r))
+                r++;
+        }
+    }
+    while (1) {                 /* loop through "specials", encoding, font file */
+        skip(r, ' ');
+        switch (*r) {
+        case '\0':
+            goto done;
+        case '"':              /* opening quote */
+            r++;
+            u = v = 0;
+            do {
+                skip(r, ' ');
+                if (sscanf(r, "%f %n", &d, &j) > 0) {
+                    s = r + j;  /* jump behind number, eat also blanks, if any */
+                    if (*(s - 1) == 'E' || *(s - 1) == 'e')
+                        s--;    /* e. g. 0.5ExtendFont: %f = 0.5E */
+                    if (str_prefix(s, "SlantFont")) {
+                        d *= 1000.0;    /* correct rounding also for neg. numbers */
+                        fm->slant = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+                        r = s + strlen("SlantFont");
+                    } else if (str_prefix(s, "ExtendFont")) {
+                        d *= 1000.0;
+                        fm->extend = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+                        if (fm->extend == 1000)
+                            fm->extend = 0;
+                        r = s + strlen("ExtendFont");
+                    } else {    /* unknown name */
+                        for (r = s; *r != ' ' && *r != '"' && *r != '\0'; r++); /* jump over name */
+                        c = *r; /* remember char for temporary end of string */
+                        *r = '\0';
+                        pdftex_warn
+                            ("invalid entry for `%s': unknown name `%s' ignored",
+                             fm->tfm_name, s);
+                        *r = c;
+                    }
+                } else
+                    for (; *r != ' ' && *r != '"' && *r != '\0'; r++);
+            }
+            while (*r == ' ');
+            if (*r == '"')      /* closing quote */
+                r++;
+            else {
+                pdftex_warn
+                    ("invalid entry for `%s': closing quote missing",
+                     fm->tfm_name);
+                goto bad_line;
+            }
+            break;
+        case 'P':              /* handle cases for subfonts like 'PidEid=3,1' */
+            if (sscanf(r, "PidEid=%i, %i %n", &a, &b, &c) >= 2) {
+                fm->pid = a;
+                fm->eid = b;
+                r += c;
+                break;
+            }
+        default:               /* encoding or font file specification */
+            a = b = 0;
+            if (*r == '<') {
+                a = *r++;
+                if (*r == '<' || *r == '[')
+                    b = *r++;
+            }
+            read_field(r, q, buf);
+            /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */
+            if (strlen(buf) > 4 && strcasecmp(strend(buf) - 4, ".enc") == 0) {
+                fm->encname = add_encname(buf);
+                u = v = 0;      /* u, v used if intervening blank: "<< foo" */
+            } else if (strlen(buf) > 0) {       /* file name given */
+                /* font file, formats:
+                 * subsetting:    '<cmr10.pfa'
+                 * no subsetting: '<<cmr10.pfa'
+                 * no embedding:  'cmr10.pfa'
+                 */
+                if (a == '<' || u == '<') {
+                    set_included(fm);
+                    if ((a == '<' && b == 0) || (a == 0 && v == 0))
+                        set_subsetted(fm);
+                    /* otherwise b == '<' (or '[') => no subsetting */
+                }
+                set_field(ff_name);
+                u = v = 0;
+            } else {
+                u = a;
+                v = b;
+            }
+        }
+    }
+  done:
+    if (fm->ps_name != NULL && check_std_t1font(fm->ps_name))
+        set_std_t1font(fm);
+    if (is_fontfile(fm)) {
+        if (strcasecmp(strend(fm_fontfile(fm)) - 4, ".ttf") == 0)
+            set_truetype(fm);
+        else if (strcasecmp(strend(fm_fontfile(fm)) - 4, ".otf") == 0)
+            set_opentype(fm);
+        else
+            set_type1(fm);
+    } else
+        set_type1(fm);          /* assume a builtin font is Type1 */
+    if (check_fm_entry(fm, true) != 0)
+        goto bad_line;
+    /*
+       Until here the map line has been completely scanned without errors;
+       fm points to a valid, freshly filled-out fm_entry structure.
+       Now follows the actual work of registering/deleting.
+     */
+    if (handle_subfont_fm(fm, mitem->mode))     /* is this a subfont? */
+        return;
+    if (avl_do_entry(fm, mitem->mode) == 0)     /* if success */
+        return;
+  bad_line:
+    delete_fm_entry(fm);
+}
+
+/**********************************************************************/
+
+void fm_read_info ()
+{
+    int callback_id;
+    int file_opened = 0;
+	char *ftemp = NULL;
+    if (tfm_tree == NULL)
+        create_avl_trees ();
+    if (mitem->line == NULL)    /* nothing to do */
+        return;
+    mitem->lineno = 1;
+    switch (mitem->type) {
+    case MAPFILE:
+        set_cur_file_name (mitem->line);
+		if (fm_buffer!=NULL) {
+		  xfree(fm_buffer);
+		  fm_buffer=NULL;
+		}
+		fm_curbyte=0;
+		fm_size=0;
+		callback_id=callback_defined(find_map_file_callback);
+		if (callback_id>0) {
+		  if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+			if(ftemp!=NULL&&strlen(ftemp)) {
+			  free(nameoffile);
+			  namelength = strlen(ftemp);
+			  nameoffile = xmalloc(namelength+2);
+			  strcpy((char *)(nameoffile+1),ftemp);
+			  free(ftemp);
+			}			
+		  }
+		}
+		callback_id=callback_defined(read_map_file_callback);
+		if (callback_id>0) {
+		  if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+						 &file_opened, &fm_buffer,&fm_size)) {
+			if(file_opened) {
+			  if (fm_size>0) {
+				cur_file_name = (char *) nameoffile + 1;
+				if (tracefilenames)
+				  tex_printf ("{%s", cur_file_name);
+				while (!fm_eof ()) {
+				  fm_scan_line ();
+				  mitem->lineno++;
+				}
+				if (tracefilenames)
+				  tex_printf ("}");
+				fm_file = NULL;
+			  }
+			} else {
+			  pdftex_warn ("cannot open font map file");
+			}
+		  } else {
+			pdftex_warn ("cannot open font map file");
+		  }
+		} else {
+		  if (!fm_open ()) {
+			pdftex_warn ("cannot open font map file");
+		  } else {
+			fm_read_file();
+			cur_file_name = (char *) nameoffile + 1;
+			tex_printf ("{%s", cur_file_name);
+			while (!fm_eof ()) {
+			  fm_scan_line ();
+			  mitem->lineno++;
+			}
+			fm_close ();
+			tex_printf ("}");
+			fm_file = NULL;
+		  }
+		}
+		break;
+    case MAPLINE:
+	  cur_file_name = NULL;   /* makes pdftex_warn() shorter */
+	  fm_scan_line ();
+	  break;
+    default:
+	  assert (0);
+    }
+    mitem->line = NULL;         /* done with this line */
+    cur_file_name = NULL;
+    return;
+}
+
+/**********************************************************************/
+
+static fm_entry_ptr fmlookup(internalfontnumber f)
+{
+    char *tfm;
+    fm_entry *fm;
+    fm_entry tmp;
+    if (tfm_tree == NULL)
+        fm_read_info();         /* only to read default map file */
+    tfm = font_name(f);
+    assert(strcmp(tfm, nontfm));
+
+    /* Look up for full <tfmname>[+-]<expand> */
+    tmp.tfm_name = tfm;
+    fm = (fm_entry *) avl_find(tfm_tree, &tmp);
+    if (fm != NULL) {
+        fm->in_use = true;
+        return (fm_entry_ptr) fm;
+    }
+    return (fm_entry_ptr) dummy_fm_entry();
+}
+
+boolean hasfmentry(internalfontnumber f)
+{
+  if (font_map(f) == NULL)
+	set_font_map(f, (fm_entry_ptr) fmlookup(f));
+  assert(font_map(f) != NULL);
+  return font_map(f) != (fm_entry_ptr) dummy_fm_entry();
+}
+
+/* check whether a map entry is valid for font replacement */
+
+static boolean fm_valid_for_font_replacement(fm_entry * fm)
+{
+    ff_entry *ff;
+
+    assert(fm != NULL);
+    assert(is_fontfile(fm));    /* ps_tree should contain only entries with font file */
+    assert(is_type1(fm));       /* ps_tree should contain only Type1 entries */
+
+    ff = check_ff_exist(fm->ff_name, false);
+    assert(ff != NULL);
+    if (ff->ff_path == NULL)    /* ...there is no font file available */
+        return false;
+    return true;                /* all tests passed */
+}
+
+/**********************************************************************/
+/*
+ * lookup fontmap by ps_name;
+ * used for Type1 font replacement when embedding of PDF files
+ */
+
+fm_entry *lookup_fontmap(char *ps_name)
+{
+    fm_entry *fm, *fm2, tmp;
+    char *a, *b, *c, *d, *e, *s;
+    int i, sl, ex;
+    struct avl_traverser t, t2;
+    if (tfm_tree == NULL)
+        fm_read_info();         /* only to read default map file */
+    assert(ps_name != NULL);
+    s = ps_name;
+    if (strlen(ps_name) > 7) {  /* check for subsetted name tag */
+        for (i = 0; i < 6; i++, s++)
+            if (*s < 'A' || *s > 'Z')
+                break;
+        if (i == 6 && *s == '+')
+            s++;                /* if name tag found, skip behind it */
+        else
+            s = ps_name;
+    }
+
+    /*
+     * Scan -Slant_<slant> and -Extend_<extend> font name extensions;
+     * three valid formats:
+     * <fontname>-Slant_<slant>
+     * <fontname>-Slant_<slant>-Extend_<extend>
+     * <fontname>-Extend_<extend>
+     * Slant entry must come _before_ Extend entry
+     */
+
+    tmp.slant = 0;
+    tmp.extend = 0;
+    if ((a = strstr(s, "-Slant_")) != NULL) {
+        b = a + strlen("-Slant_");
+        sl = (int) strtol(b, &e, 10);
+        if ((e != b) && (e == strend(b))) {
+            tmp.slant = sl;
+            *a = '\0';          /* ps_name string ends before "-Slant_" */
+        } else {
+            if (e != b) {       /* only if <slant> is valid number */
+                if ((c = strstr(e, "-Extend_")) != NULL) {
+                    d = c + strlen("-Extend_");
+                    ex = (int) strtol(d, &e, 10);
+                    if ((e != d) && (e == strend(d))) {
+                        tmp.slant = sl;
+                        tmp.extend = ex;
+                        *a = '\0';      /* ps_name string ends before "-Slant_" */
+                    }
+                }
+            }
+        }
+    } else {
+        if ((a = strstr(s, "-Extend_")) != NULL) {
+            b = a + strlen("-Extend_");
+            ex = (int) strtol(b, &e, 10);
+            if ((e != b) && (e == strend(b))) {
+                tmp.extend = ex;
+                *a = '\0';      /* ps_name string ends before "-Extend_" */
+            }
+        }
+    }
+    tmp.ps_name = s;
+
+    fm = (fm_entry *) avl_t_find(&t, ps_tree, &tmp);
+    if (fm == NULL)
+        return NULL;            /* no entry found */
+
+    /* at this point we know there is at least one fm_entry with given ps_name;
+     * we test all such entries and return the first one that is valid for font
+     * replacement */
+
+    t2 = t;
+    fm2 = (fm_entry *) avl_t_prev(&t2);
+
+    /* search forward */
+    do {
+        if (fm_valid_for_font_replacement(fm))
+            return fm;
+        fm = (fm_entry *) avl_t_next(&t);
+    } while (fm != NULL && comp_fm_entry_ps(fm, &tmp, NULL) == 0);
+
+    /* search backward */
+    while (fm2 != NULL && comp_fm_entry_ps(fm2, &tmp, NULL) == 0) {
+        if (fm_valid_for_font_replacement(fm2))
+            return fm2;
+        fm2 = (fm_entry *) avl_t_prev(&t2);
+    }
+
+    return NULL;
+}
+
+/**********************************************************************/
+/*
+ * Process map file given by its name or map line contents. Items not
+ * beginning with [+-=] flush default map file, if it has not yet been
+ * read. Leading blanks and blanks immediately following [+-=] are
+ * ignored.
+ */
+
+void process_map_item(char *s, int type)
+{
+    char *p;
+    int mode;
+    if (*s == ' ')
+        s++;                    /* ignore leading blank */
+    switch (*s) {
+    case '+':                  /* +mapfile.map, +mapline */
+        mode = FM_DUPIGNORE;    /* insert entry, if it is not duplicate */
+        s++;
+        break;
+    case '=':                  /* =mapfile.map, =mapline */
+        mode = FM_REPLACE;      /* try to replace earlier entry */
+        s++;
+        break;
+    case '-':                  /* -mapfile.map, -mapline */
+        mode = FM_DELETE;       /* try to delete entry */
+        s++;
+        break;
+    default:
+        mode = FM_DUPIGNORE;    /* like +, but also: */
+        mitem->line = NULL;     /* flush default map file name */
+    }
+    if (*s == ' ')
+        s++;                    /* ignore blank after [+-=] */
+    p = s;                      /* map item starts here */
+    switch (type) {
+    case MAPFILE:              /* remove blank at end */
+        while (*p != '\0' && *p != ' ')
+            p++;
+        *p = '\0';
+        break;
+    case MAPLINE:              /* blank at end allowed */
+        break;
+    default:
+        assert(0);
+    }
+    if (mitem->line != NULL)    /* read default map file first */
+        fm_read_info();
+    if (*s != '\0') {           /* only if real item to process */
+        mitem->mode = mode;
+        mitem->type = type;
+        mitem->line = s;
+        fm_read_info();
+    }
+}
+
+void pdfmapfile(integer t)
+{
+    process_map_item(makecstring(tokens_to_string(t)), MAPFILE);
+    flush_str(last_tokens_string);
+}
+
+void pdfmapline(integer t)
+{
+    process_map_item(makecstring(tokens_to_string(t)), MAPLINE);
+    flush_str(last_tokens_string);
+}
+
+void pdf_init_map_file(string map_name)
+{
+    assert(mitem == NULL);
+    mitem = xtalloc(1, mapitem);
+    mitem->mode = FM_DUPIGNORE;
+    mitem->type = MAPFILE;
+    mitem->line = xstrdup(map_name);
+}
+
+
+/**********************************************************************/
+/*
+ * Early check whether a font file exists. Search tree ff_tree is used
+ * in 1st instance, as it may be faster than the kpse_find_file(), and
+ * kpse_find_file() is called only once per font file name + expansion
+ * parameter. This might help keeping speed, if many PDF pages with
+ * same fonts are to be embedded.
+ *
+ * The ff_tree contains only font files, which are actually needed,
+ * so this tree typically is much smaller than the tfm_tree or ps_tree.
+ */
+
+ff_entry *check_ff_exist(char *ff_name, boolean is_tt)
+{
+    ff_entry *ff;
+    ff_entry tmp;
+    void **aa;
+    int callback_id;
+	char *filepath=NULL;
+
+    assert(ff_name != NULL);
+    tmp.ff_name = ff_name;
+    ff = (ff_entry *) avl_find(ff_tree, &tmp);
+    if (ff == NULL) {           /* not yet in database */
+        ff = new_ff_entry();
+        ff->ff_name = xstrdup(ff_name);
+        if (is_tt) {
+           callback_id=callback_defined(find_truetype_file_callback);
+           if (callback_id>0) {
+             run_callback(callback_id,"S->S",ff_name,&filepath);
+                 if (filepath && strlen(filepath)==0)
+                       filepath=NULL;
+             ff->ff_path = filepath;
+           } else {
+             ff->ff_path = kpse_find_file (ff_name, kpse_truetype_format, 0);
+           }
+		}
+		else {
+		  callback_id=callback_defined(find_type1_file_callback);
+		  if (callback_id>0) {
+			run_callback(callback_id,"S->S",ff_name,&filepath);
+			if (filepath && strlen(filepath)==0)
+			  filepath=NULL;
+			ff->ff_path = filepath;
+		  } else {
+			ff->ff_path = kpse_find_file (ff_name, kpse_type1_format, 0);
+		  }
+		}
+        aa = avl_probe(ff_tree, ff);
+        assert(aa != NULL);
+    }
+    return ff;
+}
+
+/**********************************************************************/
+/* cleaning up... */
+
+static void destroy_fm_entry_tfm(void *pa, void *pb)
+{
+    fm_entry *fm;
+    fm = (fm_entry *) pa;
+    if (!has_pslink(fm))
+        delete_fm_entry(fm);
+    else
+        unset_tfmlink(fm);
+}
+
+static void destroy_fm_entry_ps(void *pa, void *pb)
+{
+    fm_entry *fm;
+    fm = (fm_entry *) pa;
+    if (!has_tfmlink(fm))
+        delete_fm_entry(fm);
+    else
+        unset_pslink(fm);
+}
+
+static void destroy_ff_entry(void *pa, void *pb)
+{
+    ff_entry *ff;
+    ff = (ff_entry *) pa;
+    delete_ff_entry(ff);
+}
+
+void fm_free(void)
+{
+    if (tfm_tree != NULL) {
+        avl_destroy(tfm_tree, destroy_fm_entry_tfm);
+        tfm_tree = NULL;
+    }
+    if (ps_tree != NULL) {
+        avl_destroy(ps_tree, destroy_fm_entry_ps);
+        ps_tree = NULL;
+    }
+    if (ff_tree != NULL) {
+        avl_destroy(ff_tree, destroy_ff_entry);
+        ff_tree = NULL;
+    }
+}
+
+/**********************************************************************/
+/* end of mapfile.c */
diff --git a/Build/source/texk/web2c/luatexdir/font/pkin.c b/Build/source/texk/web2c/luatexdir/font/pkin.c
new file mode 100644
index 00000000000..5067d6dbd66
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/pkin.c
@@ -0,0 +1,439 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: pkin.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+/*
+ * NAME
+ * pkin.c - implementation of readchar()
+ * DESCRIPTION
+ * This implementation of readchar() uses parts of the program dvips
+ * written by Tomas Rokicki--the inventor of the pkformat--(loadfont.c,
+ * download.c and unpack.c). Dvips in turn is derived from pktype.
+ * Pktype(TeX) is described in debt in ``The PKtype processor'',
+ * which is available as pktype.weave as part of the METAFONTware.
+ * What was needed to implement readchar() is rearranged in pkfile.c to
+ * get more modularity in the style of MODULA2.
+ * BUGFIXES
+ *      May 1997: Eric Delaunay <delaunay@lix.polytechnique.fr> reports a
+ *      problem with huge fonts (greater than 1008 DPI). The code for
+ *      handling PK characters in `extended format' was wrongly derived
+ *      from dvips. Made some minor improvements regarding error handling.
+ * REDESIGN
+ * Piet Tutelaers
+ * rcpt@urc.tue.nl
+ *
+ *  Modified for use with pdftex by Han The Thanh <thanh@fi.muni.cz>.
+ */
+
+#include "ptexlib.h"
+
+/*
+ *   Now we have some routines to get stuff from the pk file.  pkbyte returns
+ *   the next byte from the pk file.
+ */
+
+
+/*
+static FILE *pkfile ;
+*/
+
+extern FILE *t3_file;
+#define pkfile t3_file
+
+static shalfword pkbyte(void)
+{
+    register shalfword i;
+
+    if ((i = xgetc(pkfile)) == EOF)
+        pdftex_fail("unexpected eof in pk file");
+    return (i);
+}
+
+static integer pkduo(void)
+{
+    register integer i;
+
+    i = pkbyte();
+    if (i > 127)
+        i -= 256;
+    i = i * 256 + pkbyte();
+    return (i);
+}
+
+static integer pktrio(void)
+{
+    register integer i;
+
+    i = pkbyte();
+    if (i > 127)
+        i -= 256;
+    i = i * 256 + pkbyte();
+    i = i * 256 + pkbyte();
+    return (i);
+}
+
+static integer pkquad(void)
+{
+    register integer i;
+
+    i = pkbyte();
+    if (i > 127)
+        i -= 256;
+    i = i * 256 + pkbyte();
+    i = i * 256 + pkbyte();
+    i = i * 256 + pkbyte();
+    return (i);
+}
+
+/*
+ *   The next part is devoted to unpacking the character data.
+ */
+
+/*
+ *   We need procedures to get a nybble, bit, and packed word from the
+ *   packed data structure.
+ */
+
+static halfword inputbyte, flagbyte;
+static halfword bitweight;
+static halfword dynf;
+static halfword repeatcount;
+
+static shalfword getnyb(void)
+{
+    halfword temp;
+    if (bitweight == 0) {
+        bitweight = 16;
+        inputbyte = pkbyte();
+        temp = inputbyte >> 4;
+    } else {
+        bitweight = 0;
+        temp = inputbyte & 15;
+    }
+    return (temp);
+}
+
+static boolean getbit(void)
+{
+    bitweight >>= 1;
+    if (bitweight == 0) {
+        inputbyte = pkbyte();
+        bitweight = 128;
+    }
+    return (inputbyte & bitweight);
+}
+
+static halfword(*realfunc) (void);
+long pk_remainder;
+static halfword handlehuge(halfword i, halfword k);
+
+static halfword pkpackednum(void)
+{
+    register halfword i, j;
+    i = getnyb();
+    if (i == 0) {
+        do {
+            j = getnyb();
+            i++;
+        } while (!(j != 0));
+        if (i > 3) {
+/*
+ *   Damn, we got a huge count!  We *fake* it by giving an artificially
+ *   large repeat count.
+ */
+            return (handlehuge(i, j));
+        } else {
+            while (i > 0) {
+                j = j * 16 + getnyb();
+                i--;
+            }
+            return (j - 15 + (13 - dynf) * 16 + dynf);
+        }
+    } else if (i <= dynf)
+        return (i);
+    else if (i < 14)
+        return ((i - dynf - 1) * 16 + getnyb() + dynf + 1);
+    else {
+        if (i == 14)
+            repeatcount = pkpackednum();
+        else
+            repeatcount = 1;
+#ifdef DEBUG
+        printf("[%d]", (int) repeatcount);
+#endif
+        return ((*realfunc) ());
+    }
+}
+
+static halfword rest(void)
+{
+    halfword i;
+
+    if (pk_remainder < 0) {
+        pk_remainder = -pk_remainder;
+        return (0);
+    } else if (pk_remainder > 0) {
+        if (pk_remainder > 4000) {
+            pk_remainder = 4000 - pk_remainder;
+            return (4000);
+        } else {
+            i = pk_remainder;
+            pk_remainder = 0;
+            realfunc = pkpackednum;
+            return (i);
+        }
+    } else {
+        pdftex_fail("shouldn't happen");
+        return 0;
+     /*NOTREACHED*/}
+}
+
+static halfword handlehuge(halfword i, halfword k)
+{
+    register long j = k;
+
+    while (i) {
+        j = (j << 4L) + getnyb();
+        i--;
+    }
+    pk_remainder = j - 15 + (13 - dynf) * 16 + dynf;
+    realfunc = rest;
+    return (rest());
+}
+
+/*
+ *   And now we have our unpacking routine.
+ */
+
+static halfword gpower[17] = { 0, 1, 3, 7, 15, 31, 63, 127,
+    255, 511, 1023, 2047, 4095, 8191, 16383, 32767, 65535
+};
+
+static void unpack(chardesc * cd)
+{
+    register integer i, j;
+    register halfword word, wordweight;
+    halfword *raster;
+    shalfword rowsleft;
+    boolean turnon;
+    shalfword hbit;
+    halfword count;
+    shalfword wordwidth;
+
+    wordwidth = (cd->cwidth + 15) / 16;
+    i = 2 * cd->cheight * (long) wordwidth;
+    if (i <= 0)
+        i = 2;
+    if (i > cd->rastersize) {
+        xfree(cd->raster);
+        cd->rastersize = i;
+        cd->raster = xtalloc(cd->rastersize, halfword);
+    }
+    raster = cd->raster;
+    realfunc = pkpackednum;
+    dynf = flagbyte / 16;
+    turnon = flagbyte & 8;
+    if (dynf == 14) {
+        bitweight = 0;
+        for (i = 1; i <= cd->cheight; i++) {
+            word = 0;
+            wordweight = 32768;
+            for (j = 1; j <= cd->cwidth; j++) {
+                if (getbit())
+                    word += wordweight;
+                wordweight >>= 1;
+                if (wordweight == 0) {
+                    *raster++ = word;
+                    word = 0;
+                    wordweight = 32768;
+                }
+            }
+            if (wordweight != 32768)
+                *raster++ = word;
+        }
+    } else {
+        rowsleft = cd->cheight;
+        hbit = cd->cwidth;
+        repeatcount = 0;
+        wordweight = 16;
+        word = 0;
+        bitweight = 0;
+        while (rowsleft > 0) {
+            count = (*realfunc) ();
+#ifdef DEBUG
+            if (turnon)
+                printf("(%d) ", (int) count);
+            else
+                printf("%d ", (int) count);
+#endif
+            while (count != 0) {
+                if ((count < wordweight) && (count < hbit)) {
+                    if (turnon)
+                        word += gpower[wordweight] - gpower[wordweight - count];
+                    hbit -= count;
+                    wordweight -= count;
+                    count = 0;
+                } else if ((count >= hbit) && (hbit <= wordweight)) {
+                    if (turnon)
+                        word += gpower[wordweight] - gpower[wordweight - hbit];
+                    *raster++ = word;
+                    for (i = 1; i <= repeatcount; i++) {
+                        for (j = 1; j <= wordwidth; j++) {
+                            *raster = *(raster - wordwidth);
+                            raster++;
+                        }
+                    }
+                    rowsleft -= repeatcount + 1;
+                    repeatcount = 0;
+                    word = 0;
+                    wordweight = 16;
+                    count -= hbit;
+                    hbit = cd->cwidth;
+                } else {
+                    if (turnon)
+                        word += gpower[wordweight];
+                    *raster++ = word;
+                    word = 0;
+                    count -= wordweight;
+                    hbit -= wordweight;
+                    wordweight = 16;
+                }
+            }
+            turnon = !turnon;
+        }
+        if ((rowsleft != 0) || ((integer) hbit != cd->cwidth))
+            pdftex_fail("error while unpacking; more bits than required");
+    }
+}
+
+/*
+ *   readchar(): the main routine
+ *   Reads the character definition of character `c' into `cd' if available,
+ *   return FALSE (0) otherwise.
+ */
+
+/*
+ *   readchar(): the main routine
+ *   check pk preamble if necessary,
+ *   read the next character definition into `cd',
+ *   return EOF if no character definition is available
+ */
+
+int readchar(boolean check_preamble, chardesc * cd)
+{
+    register shalfword i;
+    register integer k;
+    register integer length = 0;
+
+/*
+ *   Check the preamble of the pkfile
+ */
+    if (check_preamble) {
+        if (pkbyte() != 247)
+            pdftex_fail("bad pk file, expected pre");
+        if (pkbyte() != 89)
+            pdftex_fail("bad version of pk file");
+        for (i = pkbyte(); i > 0; i--)  /* creator of pkfile */
+            (void) pkbyte();
+        (void) pkquad();        /* design size */
+        k = pkquad();           /* checksum    */
+        k = pkquad();           /* hppp        */
+        k = pkquad();           /* vppp   */
+    }
+/*
+ *   Now we skip to the desired character definition
+ */
+    while ((flagbyte = pkbyte()) != 245) {
+        if (flagbyte < 240) {
+            switch (flagbyte & 7) {
+            case 0:
+            case 1:
+            case 2:
+            case 3:
+                length = (flagbyte & 7) * 256 + pkbyte() - 3;
+                cd->charcode = pkbyte();
+                (void) pktrio();        /* TFMwidth */
+                cd->xescape = pkbyte(); /* pixel width */
+                cd->cwidth = pkbyte();
+                cd->cheight = pkbyte();
+                cd->xoff = pkbyte();
+                cd->yoff = pkbyte();
+                if (cd->xoff > 127)
+                    cd->xoff -= 256;
+                if (cd->yoff > 127)
+                    cd->yoff -= 256;
+                break;
+            case 4:
+            case 5:
+            case 6:
+                length = (flagbyte & 3) * 65536L + pkbyte() * 256L;
+                length = length + pkbyte() - 4L;
+                cd->charcode = pkbyte();
+                (void) pktrio();        /* TFMwidth */
+                cd->xescape = pkduo();  /* pixelwidth */
+                cd->cwidth = pkduo();
+                cd->cheight = pkduo();
+                cd->xoff = pkduo();
+                cd->yoff = pkduo();
+                break;
+            case 7:
+                length = pkquad() - 9L;
+                cd->charcode = pkquad();
+                (void) pkquad();        /* TFMwidth */
+                cd->xescape = pkquad(); /* pixelwidth */
+                k = pkquad();
+                cd->cwidth = pkquad();
+                cd->cheight = pkquad();
+                cd->xoff = pkquad();
+                cd->yoff = pkquad();
+            }
+            if (length <= 0)
+                pdftex_fail("packet length (%i) too small", (int) length);
+            unpack(cd);
+            return 1;
+        } else {
+            k = 0;
+            switch (flagbyte) {
+            case 243:
+                k = pkbyte();
+                if (k > 127)
+                    k -= 256;
+            case 242:
+                k = k * 256 + pkbyte();
+            case 241:
+                k = k * 256 + pkbyte();
+            case 240:
+                k = k * 256 + pkbyte();
+                while (k-- > 0)
+                    i = pkbyte();
+                break;
+            case 244:
+                k = pkquad();
+                break;
+            case 246:
+                break;
+            default:
+                pdftex_fail("unexpected command (%i)", (int) flagbyte);
+            }
+        }
+    }
+    return 0;                   /* character not found */
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/sfnt.c b/Build/source/texk/web2c/luatexdir/font/sfnt.c
new file mode 100644
index 00000000000..95453a531a0
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/sfnt.c
@@ -0,0 +1,647 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/sfnt.c,v 1.12 2004/09/11 14:50:29 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+/* Based on dvipdfmx-0.13.2c */
+
+#if  HAVE_CONFIG_H
+#include "config.h"
+#endif /* HAVE_CONFIG_H_ */
+
+#include <string.h>
+
+#ifndef pdfTeX
+#include "system.h"
+
+#include "error.h"
+#include "mem.h"
+#include "mfileio.h"
+#else
+extern void pdftex_fail (const char *fmt, ...); /* utils.c */
+#endif
+
+#include "sfnt.h"
+
+#ifdef XETEX
+UNSIGNED_BYTE
+ft_unsigned_byte(sfnt* f)
+{
+  unsigned char byte;
+  unsigned long length = 1;
+  
+  if (FT_Load_Sfnt_Table(f->ft_face, 0, f->loc, &byte, &length) != 0)
+    TT_ERROR("sfnt: Freetype failure...");
+  f->loc += 1;
+
+  return byte;
+}
+
+SIGNED_BYTE
+ft_signed_byte(sfnt* f)
+{
+  int b = ft_unsigned_byte(f);
+  if (b >= 0x80)
+    b -= 0x100;
+  return (SIGNED_BYTE)b;
+}
+
+UNSIGNED_PAIR
+ft_unsigned_pair(sfnt* f)
+{
+  unsigned char buf[2];
+  unsigned long length = 2;
+  
+  if (FT_Load_Sfnt_Table(f->ft_face, 0, f->loc, buf, &length) != 0)
+    TT_ERROR("sfnt: Freetype failure...");
+  f->loc += 2;
+
+  return (UNSIGNED_PAIR)((unsigned)buf[0] << 8) + buf[1];
+}
+
+SIGNED_PAIR
+ft_signed_pair(sfnt* f)
+{
+  int p = ft_unsigned_pair(f);
+  if (p >= 0x8000U)
+    p -= 0x10000U;
+    
+  return (SIGNED_PAIR)p;
+}
+
+UNSIGNED_QUAD
+ft_unsigned_quad(sfnt* f)
+{
+  unsigned char buf[4];
+  unsigned long length = 4;
+
+  if (FT_Load_Sfnt_Table(f->ft_face, 0, f->loc, buf, &length) != 0)
+    TT_ERROR("sfnt: Freetype failure...");
+  f->loc += 4;
+
+  return ((unsigned long)buf[0] << 24) + ((unsigned long)buf[1] << 16)
+       + ((unsigned long)buf[2] << 8) + (unsigned long)buf[3];
+}
+
+unsigned long
+ft_read(unsigned char* buf, unsigned long len, sfnt* f)
+{
+  unsigned long length = len;
+  if (FT_Load_Sfnt_Table(f->ft_face, 0, f->loc, buf, &length) != 0)
+    TT_ERROR("sfnt: Freetype failure...");
+  f->loc += len;
+
+  return length;
+}
+#endif
+
+
+/*
+ * type:
+ *  `true' (0x74727565): TrueType (Mac)
+ *  `typ1' (0x74797031) (Mac): PostScript font housed in a sfnt wrapper
+ *  0x00010000: TrueType (Win)/OpenType
+ *  `OTTO': PostScript CFF font with OpenType wrapper
+ *  `ttcf': TrueType Collection
+*/
+#define SFNT_TRUETYPE   0x00010000UL
+#define SFNT_MAC_TRUE	0x74727565UL
+#define SFNT_OPENTYPE   0x00010000UL
+#define SFNT_POSTSCRIPT 0x4f54544fUL
+#define SFNT_TTC        0x74746366UL
+
+#ifdef XETEX
+sfnt *
+sfnt_open (FT_Face face, int accept_types)
+{
+  sfnt  *sfont;
+  ULONG  type;
+  
+  if (!face || !FT_IS_SFNT(face))
+    return NULL;
+  
+  sfont = NEW(1, sfnt);
+  sfont->ft_face = face;
+  sfont->loc = 0;
+  sfont->type = 0;
+  
+  type = sfnt_get_ulong(sfont);
+  
+  if (type == SFNT_TRUETYPE || type == SFNT_MAC_TRUE) {
+    sfont->type = SFNT_TYPE_TRUETYPE;
+  } else if (type == SFNT_OPENTYPE) {
+    sfont->type = SFNT_TYPE_OPENTYPE;
+  } else if (type == SFNT_POSTSCRIPT) { 
+    sfont->type = SFNT_TYPE_POSTSCRIPT;
+  } else if (type == SFNT_TTC) {
+    sfont->type = SFNT_TYPE_TTC;
+  }
+
+  if ((sfont->type & accept_types) == 0) {
+    RELEASE(sfont);
+    return NULL;
+  }
+
+  sfont->loc = 0;
+  
+  sfont->directory = NULL;
+
+  return sfont;
+}
+#else /* not XETEX */
+#ifdef pdfTeX
+sfnt *
+sfnt_open (unsigned char *buffer, integer buflen)
+{
+  sfnt  *sfont;
+  ULONG  type;
+
+  sfont = xmalloc(sizeof(sfnt));
+  sfont->loc = 0;
+  sfont->buffer = buffer;
+  sfont->buflen = buflen;
+
+  type = sfnt_get_ulong(sfont);
+
+  if (type == SFNT_TRUETYPE || type == SFNT_MAC_TRUE) {
+    sfont->type = SFNT_TYPE_TRUETYPE;
+  } else if (type == SFNT_OPENTYPE) {
+    sfont->type = SFNT_TYPE_OPENTYPE;
+  } else if (type == SFNT_POSTSCRIPT) { 
+    sfont->type = SFNT_TYPE_POSTSCRIPT;
+  } else if (type == SFNT_TTC) {
+    sfont->type = SFNT_TYPE_TTC;
+  }
+
+  sfont->loc=0;
+  sfont->directory = NULL;
+  return sfont;
+}
+#else
+sfnt *
+sfnt_open (FILE *fp)
+{
+  sfnt  *sfont;
+  ULONG  type;
+
+  ASSERT(fp);
+
+  rewind(fp);
+
+  sfont = NEW(1, sfnt);
+
+  sfont->stream = fp;
+
+  type = sfnt_get_ulong(sfont);
+
+  if (type == SFNT_TRUETYPE || type == SFNT_MAC_TRUE) {
+    sfont->type = SFNT_TYPE_TRUETYPE;
+  } else if (type == SFNT_OPENTYPE) {
+    sfont->type = SFNT_TYPE_OPENTYPE;
+  } else if (type == SFNT_POSTSCRIPT) { 
+    sfont->type = SFNT_TYPE_POSTSCRIPT;
+  } else if (type == SFNT_TTC) {
+    sfont->type = SFNT_TYPE_TTC;
+  }
+
+  rewind(sfont->stream);
+
+  sfont->directory = NULL;
+
+  return sfont;
+}
+#endif
+#endif
+
+static void
+release_directory (struct sfnt_table_directory *td)
+{
+  long i;
+
+  if (td) {
+    if (td->tables) {
+      for (i = 0; i < td->num_tables; i++) {
+	if (td->tables[i].data)
+	  RELEASE(td->tables[i].data);
+      }
+      RELEASE(td->tables);
+    }
+    if (td->flags)
+      RELEASE(td->flags);
+    RELEASE(td);
+  }
+
+  return;
+}
+
+void
+sfnt_close (sfnt *sfont)
+{
+
+  if (sfont) {
+    if (sfont->directory)
+      release_directory(sfont->directory);
+    RELEASE(sfont);
+  }
+
+  return;
+}
+
+int
+put_big_endian (void *s, LONG q, int n)
+{
+  int   i;
+  char *p;
+
+  p = (char *) s;
+  for (i = n - 1; i >= 0; i--) {
+    p[i] = (char) (q & 0xff);
+    q >>= 8;
+  }
+
+  return n;
+}
+
+/* Convert four-byte number to big endianess
+ * in a machine independent way.
+ */
+static void
+convert_tag (char *tag, unsigned long u_tag)
+{
+  int i;
+
+  for (i = 3; i >= 0; i--) {
+    tag[i] = (char) (u_tag % 256);
+    u_tag /= 256;
+  }
+
+  return;
+}
+
+/*
+ * Computes the max power of 2 <= n
+ */
+static unsigned
+max2floor (unsigned n)
+{
+  int val = 1;
+
+  while (n > 1) {
+    n   /= 2;
+    val *= 2;
+  }
+
+  return val;
+}
+
+/*
+ * Computes the log2 of the max power of 2 <= n
+ */
+static unsigned
+log2floor (unsigned n)
+{
+  unsigned val = 0;
+
+  while (n > 1) {
+    n /= 2;
+    val++;
+  }
+
+  return val;
+}
+
+static ULONG
+sfnt_calc_checksum(void *data, ULONG length)
+{
+  ULONG  chksum = 0;
+  BYTE  *p, *endptr;
+  int    count  = 0;
+
+  p      = (BYTE *) data;
+  endptr = p + length;
+  while (p < endptr) {
+    chksum += (p[0] << (8 * ( 3 - count)));
+    count   = ((count + 1) & 3);
+    p++;
+  }
+
+  return chksum;
+}
+
+static int
+find_table_index (struct sfnt_table_directory *td, const char *tag)
+{
+  int  idx;
+
+  if (!td)
+    return -1;
+
+  for (idx = 0; idx < td->num_tables; idx++) {
+    if (!memcmp(td->tables[idx].tag, tag, 4))
+      return idx;
+  }
+
+  return -1;
+}
+
+void
+sfnt_set_table (sfnt *sfont, const char *tag, void *data, ULONG length)
+{
+  struct sfnt_table_directory *td;
+  int    idx;
+
+  ASSERT(sfont);
+
+  td  = sfont->directory;
+  idx = find_table_index(td, tag);
+
+  if (idx < 0) {
+    idx = td->num_tables;
+    td->num_tables++;
+    td->tables = RENEW(td->tables, td->num_tables, struct sfnt_table);
+    memcpy(td->tables[idx].tag, tag, 4);
+  }
+
+  td->tables[idx].check_sum = sfnt_calc_checksum(data, length);
+  td->tables[idx].offset    = 0L;
+  td->tables[idx].length    = length;
+  td->tables[idx].data      = data;
+
+  return;
+}
+
+ULONG
+sfnt_find_table_len (sfnt *sfont, const char *tag)
+{
+  ULONG  length;
+  struct sfnt_table_directory *td;
+  int    idx;
+
+  ASSERT(sfont && tag);
+
+  td  = sfont->directory;
+  idx = find_table_index(td, tag);
+  if (idx < 0)
+    length = 0;
+  else {
+    length = td->tables[idx].length;
+  }
+
+  return length;
+}
+
+ULONG
+sfnt_find_table_pos (sfnt *sfont, const char *tag) 
+{
+  ULONG  offset;
+  struct sfnt_table_directory *td;
+  int    idx;
+
+  ASSERT(sfont && tag);
+
+  td  = sfont->directory;
+  idx = find_table_index(td, tag);
+  if (idx < 0)
+    offset = 0;
+  else {
+    offset = td->tables[idx].offset;
+  }
+
+  return offset;
+}
+
+ULONG
+sfnt_locate_table (sfnt *sfont, const char *tag)
+{
+  ULONG offset;
+
+  ASSERT(sfont && tag);
+
+  offset = sfnt_find_table_pos(sfont, tag);
+  if (offset == 0)
+    TT_ERROR("sfnt: table not found...");
+
+  sfnt_seek_set(sfont, offset);
+
+  return offset;
+}
+
+int
+sfnt_read_table_directory (sfnt *sfont, ULONG offset)
+{
+  struct sfnt_table_directory *td;
+  unsigned long i, u_tag;
+
+  ASSERT(sfont);
+
+  if (sfont->directory)
+    release_directory(sfont->directory);    
+  sfont->directory = td = NEW (1, struct sfnt_table_directory);
+
+#ifdef XETEX
+  ASSERT(sfont->ft_face);
+#elif defined(pdfTeX)
+  ASSERT(sfont->buffer);
+#else
+  ASSERT(sfont->stream);
+#endif
+
+  sfnt_seek_set(sfont, offset);
+
+  td->version      = sfnt_get_ulong(sfont);
+  td->num_tables   = sfnt_get_ushort(sfont);
+  td->search_range = sfnt_get_ushort(sfont);
+  td->entry_selector = sfnt_get_ushort(sfont);
+  td->range_shift    = sfnt_get_ushort(sfont);
+
+  td->flags  = NEW(td->num_tables, char);
+  td->tables = NEW(td->num_tables, struct sfnt_table);
+
+  for (i = 0; i < td->num_tables; i++) {
+    u_tag = sfnt_get_ulong(sfont);
+
+    convert_tag(td->tables[i].tag, u_tag);
+    td->tables[i].check_sum = sfnt_get_ulong(sfont);
+    td->tables[i].offset    = sfnt_get_ulong(sfont);
+    td->tables[i].length    = sfnt_get_ulong(sfont);
+    td->tables[i].data      = NULL;
+
+    td->flags[i] = 0;
+  }
+
+  td->num_kept_tables = 0;
+
+  return 0;
+}
+
+int
+sfnt_require_table (sfnt *sfont, const char *tag, int must_exist)
+{
+  struct sfnt_table_directory *td;
+  int    idx;
+
+  ASSERT(sfont && sfont->directory);
+
+  td  = sfont->directory;
+  idx = find_table_index(td, tag);
+  if (idx < 0) {
+    if (must_exist)
+      return -1;
+  } else {
+    td->flags[idx] |= SFNT_TABLE_REQUIRED;
+    td->num_kept_tables++;
+  }
+
+  return 0;
+}
+
+#ifndef pdfTeX
+#include "pdfobj.h"
+#endif
+
+/* 
+ * o All tables begin on four byte boundries, and pad any remaining space
+ *   between tables with zeros
+ *
+ * o Entries in the Table Directory must be sorted in ascending order by tag
+ *
+ * o The head table contains checksum of the whole font file.
+ *   To compute:  first set it to 0, sum the entire font as ULONG,
+ *   then store 0xB1B0AFBA - sum.
+ */
+
+#ifdef pdfTeX
+extern pdf_obj *pdf_new_stream(void);
+extern void pdf_add_stream(pdf_obj *, unsigned char *, long);
+extern void pdf_release_obj(pdf_obj *);
+#undef MIN
+#define MIN(a, b) (((a) < (b)) ? (a) : (b))
+#define STREAM_COMPRESS 
+#endif
+
+static unsigned char wbuf[1024], padbytes[4] = {0, 0, 0, 0};
+
+pdf_obj *
+sfnt_create_FontFile_stream (sfnt *sfont)
+{
+  pdf_obj *stream;
+#ifndef pdfTeX
+  pdf_obj *stream_dict;
+#endif
+  struct sfnt_table_directory *td;
+  long     offset, nb_read, length;
+  int      i, sr;
+  char    *p;
+
+  ASSERT(sfont && sfont->directory);
+
+  stream = pdf_new_stream(STREAM_COMPRESS);
+
+  td  = sfont->directory;
+
+  /* Header */
+  p  = (char *) wbuf;
+  p += sfnt_put_ulong (p, td->version);
+  p += sfnt_put_ushort(p, td->num_kept_tables);
+  sr = max2floor(td->num_kept_tables) * 16;
+  p += sfnt_put_ushort(p, sr);
+  p += sfnt_put_ushort(p, log2floor(td->num_kept_tables));
+  p += sfnt_put_ushort(p, td->num_kept_tables * 16 - sr);
+
+  pdf_add_stream(stream, wbuf, 12);
+
+  /*
+   * Compute start of actual tables (after headers).
+   */
+  offset = 12 + 16 * td->num_kept_tables;
+  for (i = 0; i < td->num_tables; i++) {
+    /* This table must exist in FontFile */
+    if (td->flags[i] & SFNT_TABLE_REQUIRED) {
+      if ((offset % 4) != 0) {
+	offset += 4 - (offset % 4);
+      }
+
+      p = (char *) wbuf;
+      memcpy(p, td->tables[i].tag, 4);
+      p += 4;
+      p += sfnt_put_ulong(p, td->tables[i].check_sum);
+      p += sfnt_put_ulong(p, offset);
+      p += sfnt_put_ulong(p, td->tables[i].length);
+      pdf_add_stream(stream, wbuf, 16);
+
+      offset += td->tables[i].length;
+    }
+  }
+
+  offset = 12 + 16 * td->num_kept_tables;
+  for (i = 0; i < td->num_tables; i++) {
+    if (td->flags[i] & SFNT_TABLE_REQUIRED) {
+      if ((offset % 4) != 0) {
+	length  = 4 - (offset % 4);
+	pdf_add_stream(stream, padbytes, length);
+	offset += length;
+      }
+      if (!td->tables[i].data) {
+#ifdef XETEX
+	if (!sfont->ft_face)
+#elif defined(pdfTeX)
+        if (!sfont->buffer)
+#else
+	if (!sfont->stream)
+#endif
+	{
+	  pdf_release_obj(stream);
+	  TT_ERROR("Font file not opened or already closed...");
+	  return NULL;
+	}
+
+	length = td->tables[i].length;
+	sfnt_seek_set(sfont, td->tables[i].offset); 
+	while (length > 0) {
+	  nb_read = sfnt_read(wbuf, MIN(length, 1024), sfont);
+	  if (nb_read < 0) {
+	    pdf_release_obj(stream);
+	    TT_ERROR("Reading file failed...");
+	    return NULL;
+	  } else if (nb_read > 0) {
+	    pdf_add_stream(stream, wbuf, nb_read);
+	  }
+	  length -= nb_read;
+	}
+      } else {
+	pdf_add_stream(stream,
+		       (unsigned char *)td->tables[i].data, 
+		       td->tables[i].length);
+	RELEASE(td->tables[i].data);
+	td->tables[i].data = NULL;
+      }
+      /* Set offset for next table */
+      offset += td->tables[i].length;
+    }
+  }
+
+#ifndef pdfTeX
+  stream_dict = pdf_stream_dict(stream);
+  pdf_add_dict(stream_dict,
+	       pdf_new_name("Length1"),
+	       pdf_new_number(offset));
+#endif
+  return stream;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/sfnt.h b/Build/source/texk/web2c/luatexdir/font/sfnt.h
new file mode 100644
index 00000000000..8db54dd9c39
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/sfnt.h
@@ -0,0 +1,197 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/sfnt.h,v 1.9 2004/09/11 14:50:29 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+#ifndef _SFNT_H_
+#define _SFNT_H_
+
+#if  HAVE_CONFIG_H
+#include "config.h"
+#endif /* HAVE_CONFIG_H_ */
+
+#ifndef pdfTeX
+#include "mfileio.h"
+#include "numbers.h"
+#include "pdfobj.h"
+#endif
+
+#ifdef XETEX
+#include "ft2build.h"
+#include FT_FREETYPE_H
+#include FT_TRUETYPE_TABLES_H
+#endif
+
+/* Data Types as described in Apple's TTRefMan */
+typedef unsigned char  BYTE;
+typedef signed char    ICHAR;
+typedef unsigned short USHORT;
+typedef signed short   SHORT;
+typedef unsigned long  ULONG;
+typedef signed long    LONG;
+typedef unsigned long  Fixed;   /* 16.16-bit signed fixed-point number */
+typedef short          FWord;
+typedef unsigned short uFWord;
+typedef short          F2Dot14; /* 16-bit signed fixed number with the low
+				   14 bits representing fraction. */
+
+struct sfnt_table
+{
+  /* table header */
+  char   tag[4];
+  ULONG  check_sum;
+  ULONG  offset;
+  ULONG  length;
+  char  *data;   /* table data */
+};
+
+#define SFNT_TABLE_REQUIRED (1 << 0)
+
+struct sfnt_table_directory
+{
+  ULONG   version;         /* Fixed for Win */
+  USHORT  num_tables;
+  USHORT  search_range;
+  USHORT  entry_selector;
+  USHORT  range_shift;
+  USHORT  num_kept_tables; /* number of kept tables */
+  char   *flags;           /* keep or omit */
+  struct  sfnt_table *tables;
+};
+
+/* sfnt resource */
+#define SFNT_TYPE_TRUETYPE   (1 << 0)
+#define SFNT_TYPE_OPENTYPE   (1 << 1)
+#define SFNT_TYPE_POSTSCRIPT (1 << 2)
+#define SFNT_TYPE_TTC        (1 << 4)
+
+typedef struct
+{
+  int    type;
+  struct sfnt_table_directory *directory;
+#ifdef XETEX
+  FT_Face ft_face;
+  long    loc;
+#elif defined(pdfTeX)
+  BYTE *buffer;
+  long buflen;
+  long loc;
+#else
+  FILE  *stream;
+#endif
+} sfnt;
+
+/* Convert sfnt "fixed" type to double */
+#define fixed(a) ((double)((a)%0x10000L)/(double)(0x10000L) + \
+ (a)/0x10000L - (((a)/0x10000L > 0x7fffL) ? 0x10000L : 0))
+
+#ifdef XETEX
+UNSIGNED_BYTE  ft_unsigned_byte(sfnt* f);
+SIGNED_BYTE    ft_signed_byte(sfnt* f);
+UNSIGNED_PAIR  ft_unsigned_pair(sfnt* f);
+SIGNED_PAIR    ft_signed_pair(sfnt* f);
+UNSIGNED_QUAD  ft_unsigned_quad(sfnt* f);
+unsigned long  ft_read(unsigned char* buf, unsigned long len, sfnt* f);
+
+#define sfnt_get_byte(s)   ((BYTE)   ft_unsigned_byte(s))
+#define sfnt_get_char(s)   ((ICHAR)   ft_signed_byte  (s))
+#define sfnt_get_ushort(s) ((USHORT) ft_unsigned_pair(s))
+#define sfnt_get_short(s)  ((SHORT)  ft_signed_pair  (s))
+#define sfnt_get_ulong(s)  ((ULONG)  ft_unsigned_quad(s))
+#define sfnt_get_long(s)   ((LONG)   ft_signed_quad  (s))
+
+#define sfnt_seek_set(s,o) (s)->loc = (o)
+#define sfnt_read(b,l,s)   ft_read((b), (l), (s))
+#elif defined(pdfTeX) 
+BYTE   get_unsigned_byte(sfnt* f);
+ICHAR   get_signed_byte(sfnt* f);
+USHORT get_unsigned_pair(sfnt* f);
+SHORT  get_signed_pair(sfnt* f);
+ULONG  get_unsigned_quad(sfnt* f);
+int    do_sfnt_read (unsigned char *dest, int len, sfnt *f);
+
+#define sfnt_get_byte(s)   ((BYTE)   get_unsigned_byte(s))
+#define sfnt_get_char(s)   ((ICHAR)   get_signed_byte  (s))
+#define sfnt_get_ushort(s) ((USHORT) get_unsigned_pair(s))
+#define sfnt_get_short(s)  ((SHORT)  get_signed_pair  (s))
+#define sfnt_get_ulong(s)  ((ULONG)  get_unsigned_quad(s))
+#define sfnt_get_long(s)   ((LONG)   get_signed_quad  (s))
+
+#define sfnt_seek_set(s,o) (s)->loc = (o)
+#define sfnt_read(b,l,s)   do_sfnt_read((b), (l), (s))
+#else
+/* get_***_*** from numbers.h */
+#define sfnt_get_byte(s)   ((BYTE)   get_unsigned_byte((s)->stream))
+#define sfnt_get_char(s)   ((ICHAR)  get_signed_byte  ((s)->stream))
+#define sfnt_get_ushort(s) ((USHORT) get_unsigned_pair((s)->stream))
+#define sfnt_get_short(s)  ((SHORT)  get_signed_pair  ((s)->stream))
+#define sfnt_get_ulong(s)  ((ULONG)  get_unsigned_quad((s)->stream))
+#define sfnt_get_long(s)   ((LONG)   get_signed_quad  ((s)->stream))
+
+#define sfnt_seek_set(s,o)   seek_absolute((s)->stream, (o))
+#define sfnt_read(b,l,s)     fread((b), 1, (l), (s)->stream)
+#endif
+
+extern  int  put_big_endian (void *s, LONG q, int n);
+
+#define sfnt_put_ushort(s,v) put_big_endian((s), v, 2);
+#define sfnt_put_short(s,v)  put_big_endian((s), v, 2);
+#define sfnt_put_ulong(s,v)  put_big_endian((s), v, 4);
+#define sfnt_put_long(s,v)   put_big_endian((s), v, 4);
+
+#ifdef XETEX
+extern sfnt *sfnt_open  (FT_Face face, int accept_types);
+#elif defined(pdfTeX)
+extern sfnt *sfnt_open (unsigned char *buffer, integer buflen);
+#else
+extern sfnt *sfnt_open  (FILE *fp);
+#endif
+extern void  sfnt_close (sfnt *sfont);
+
+/* table directory */
+extern int   sfnt_read_table_directory (sfnt *sfont, ULONG offset);
+extern ULONG sfnt_find_table_len       (sfnt *sfont, const char *tag);
+extern ULONG sfnt_find_table_pos       (sfnt *sfont, const char *tag);
+extern ULONG sfnt_locate_table         (sfnt *sfont, const char *tag);
+
+extern void  sfnt_set_table     (sfnt *sfont,
+				 const char *tag, void *data, ULONG length);
+extern int   sfnt_require_table (sfnt *sfont, const char *tag, int must_exist);
+
+#ifdef pdfTeX
+typedef struct
+{
+  ULONG  length;
+  BYTE  *data;
+} pdf_obj;
+
+#define ASSERT(a) assert(a)
+#define RELEASE(a) free(a)
+#define NEW(a,b) xmalloc((a)*sizeof(b))
+#define RENEW(a,b,c) xrealloc(a, ((b)*sizeof(c)))
+#define TT_ERROR pdftex_fail
+#define WARN printf
+
+
+#endif
+
+extern pdf_obj *sfnt_create_FontFile_stream (sfnt *sfont);
+
+#endif /* _SFNT_H_ */
diff --git a/Build/source/texk/web2c/luatexdir/font/subfont.c b/Build/source/texk/web2c/luatexdir/font/subfont.c
new file mode 100644
index 00000000000..836985c10fd
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/subfont.c
@@ -0,0 +1,264 @@
+/*
+Copyright (c) 2005-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include "ptexlib.h"
+#include <string.h>
+
+static struct avl_table *sfd_tree = NULL;
+
+static unsigned char *sfd_buffer = NULL;
+static integer sfd_size = 0;
+static integer sfd_curbyte = 0;
+
+#define SFD_BUF_SIZE    SMALL_BUF_SIZE
+
+#define sfd_close()     xfclose(sfd_file, cur_file_name)
+#define sfd_open()      open_input(&sfd_file, kpse_sfd_format, FOPEN_RBIN_MODE)
+
+#define sfd_read_file() readbinfile(sfd_file,&sfd_buffer,&sfd_size)
+#define sfd_getchar()   sfd_buffer[sfd_curbyte++]
+#define sfd_eof()      (sfd_curbyte>sfd_size)
+
+
+static FILE *sfd_file;
+static char sfd_line[SFD_BUF_SIZE];
+
+static subfont_entry *new_subfont_entry (void)
+{
+    int i;
+    subfont_entry *subfont;
+    subfont = xtalloc (1, subfont_entry);
+    subfont->infix = NULL;
+    for (i = 0; i < 256; ++i)
+        subfont->charcodes[i] = -1;     /* unassigned */
+    subfont->next = NULL;
+    return subfont;
+}
+
+static sfd_entry *new_sfd_entry (void)
+{
+    sfd_entry *sfd;
+    sfd = xtalloc (1, sfd_entry);
+    sfd->name = NULL;
+    sfd->subfont = NULL;
+    return sfd;
+}
+
+static void destroy_sfd_entry (void *pa, void *pb)
+{
+    subfont_entry *p, *q;
+    sfd_entry *sfd;
+    sfd = (sfd_entry *) pa;
+    p = sfd->subfont;
+    while (p != NULL) {
+        q = p->next;
+        xfree (p->infix);
+        xfree (p);
+        p = q;
+    }
+    xfree (sfd->name);
+}
+
+static int comp_sfd_entry (const void *pa, const void *pb, void *p)
+{
+    return strcmp (((const sfd_entry *) pa)->name,
+                   ((const sfd_entry *) pb)->name);
+}
+
+void sfd_free (void)
+{
+    if (sfd_tree != NULL)
+        avl_destroy (sfd_tree, destroy_sfd_entry);
+}
+
+static void sfd_getline (boolean expect_eof)
+{
+    char *p;
+    int c;
+  restart:
+    if (sfd_eof ()) {
+        if (expect_eof)
+            return;
+        else
+            pdftex_fail ("unexpected end of file");
+    }
+    p = sfd_line;
+    do {
+        c = sfd_getchar ();
+        append_char_to_buf (c, p, sfd_line, SFD_BUF_SIZE);
+    } while (c != 10 && !sfd_eof());
+    append_eol (p, sfd_line, SFD_BUF_SIZE);
+    if (p - sfd_line < 2 || *sfd_line == '#')
+        goto restart;
+}
+
+static sfd_entry *read_sfd (char *sfd_name)
+{
+    void **aa;
+    sfd_entry *sfd, tmp_sfd;
+    subfont_entry *sf;
+	char *ftemp = NULL;
+    char buf[SMALL_BUF_SIZE], *p;
+    long int i, j, k;
+    int n;
+    int callback_id=0;
+    int file_opened=0;
+    /* check whether this sfd has been read */
+    tmp_sfd.name = sfd_name;
+    if (sfd_tree == NULL) {
+        sfd_tree = avl_create (comp_sfd_entry, NULL, &avl_xallocator);
+        assert (sfd_tree != NULL);
+    }
+    sfd = (sfd_entry *) avl_find (sfd_tree, &tmp_sfd);
+    if (sfd != NULL)
+        return sfd;
+    set_cur_file_name (sfd_name);
+    if (sfd_buffer!=NULL) {
+      xfree(sfd_buffer);
+      sfd_buffer=NULL;
+    }
+    sfd_curbyte=0;
+    sfd_size=0;
+
+	callback_id=callback_defined(find_sfd_file_callback);
+	if (callback_id>0) {
+	  if(run_callback(callback_id,"S->S",cur_file_name,&ftemp)) {
+		if(ftemp!=NULL&&strlen(ftemp)) {
+		  if (cur_file_name)
+			free(cur_file_name);
+		  cur_file_name = xstrdup(ftemp);
+		  free(ftemp);
+		}
+	  }
+	}
+    callback_id=callback_defined(read_sfd_file_callback);
+    if (callback_id>0) {
+      if(! (run_callback(callback_id,"S->bSd",cur_file_name,
+		       &file_opened, &sfd_buffer,&sfd_size) &&
+	    file_opened && 
+	    sfd_size>0 ) ) {
+	pdftex_warn ("cannot open SFD file for reading");
+	cur_file_name = NULL;
+	return NULL;      
+      }
+      sfd_read_file();
+      sfd_close();
+    }
+    tex_printf ("{");
+    tex_printf (cur_file_name);
+    sfd = new_sfd_entry ();
+    sfd->name = xstrdup (sfd_name);
+    while (!sfd_eof ()) {
+        sfd_getline (true);
+        if (*sfd_line == 10)    /* empty line indicating eof */
+            break;
+        sf = new_subfont_entry ();
+        sf->next = sfd->subfont;
+        sfd->subfont = sf;
+        sscanf (sfd_line, "%s %n", buf, &n);
+        sf->infix = xstrdup (buf);
+        p = sfd_line + n;       /* skip to the next word */
+        k = 0;
+      read_ranges:
+        for (;;) {
+            if (*p == '\\') {   /* continue on next line */
+                sfd_getline (false);
+                p = sfd_line;
+                goto read_ranges;
+            } else if (*p == 0) /* end of subfont */
+                break;
+            if (sscanf (p, " %li %n", &i, &n) == 0)
+                pdftex_fail ("invalid token:\n%s", p);
+            p += n;
+            if (*p == ':') {    /* offset */
+                k = i;
+                p++;
+            } else if (*p == '_') {     /* range */
+                if (sscanf (p + 1, " %li %n", &j, &n) == 0)
+                    pdftex_fail ("invalid token:\n%s", p);
+                if (i > j || k + (j - i) > 255)
+                    pdftex_fail ("invalid range:\n%s", p);
+                while (i <= j)
+                    sf->charcodes[k++] = i++;
+                p += n + 1;
+            } else              /* codepoint */
+                sf->charcodes[k++] = i;
+        }
+    }
+    tex_printf ("}");
+    aa = avl_probe (sfd_tree, sfd);
+    assert (aa != NULL);
+    return sfd;
+}
+
+boolean handle_subfont_fm (fm_entry * fm, int mode)
+{
+    size_t l;
+    char *p, *q, *r;
+    sfd_entry *sfd;
+    subfont_entry *sf;
+    fm_entry *fm2;
+    char buf[SMALL_BUF_SIZE];
+    assert (fm->tfm_name != NULL);
+    p = fm->tfm_name;
+    q = strchr (p, '@');        /* search for the first '@' */
+    if (q == NULL)
+        return false;
+    r = strchr (q + 1, '@');    /* search for the second '@' */
+    if (r == NULL)
+        return false;
+    if (q <= p || r <= q + 1    /* prefix or sfd name is empty */
+        || r - p != strlen (p) - 1)     /* or the second '@' is not the last char yet */
+        return false;
+    l = r - (q + 1);            /* length of sfd name */
+    strncpy (buf, q + 1, l);
+    buf[l] = 0;
+	check_buf(strlen(buf) + 4, SMALL_BUF_SIZE);
+    strcat (buf, ".sfd");
+    sfd = read_sfd (buf);
+    if (sfd == NULL)
+        return false;
+    /* at this point we know fm is a subfont */
+    set_subfont (fm);
+    xfree (fm->ps_name);
+    fm->ps_name = NULL;
+    /* set default values for PidEid */
+    if (fm->pid == -1) {
+        fm->pid = 3;
+        fm->eid = 1;
+    }
+    l = q - p;                  /* length of base tfm name (prefix) */
+    for (sf = sfd->subfont; sf != NULL; sf = sf->next) {
+        strncpy (buf, p, l);
+        buf[l] = 0;
+        strcat (buf, sf->infix);
+        fm2 = new_fm_entry ();
+        fm2->tfm_name = xstrdup (buf);
+        fm2->ff_name = xstrdup (fm->ff_name);
+        fm2->type = fm->type;
+        fm2->pid = fm->pid;
+        fm2->eid = fm->eid;
+        fm2->subfont = sf;
+        if (avl_do_entry (fm2, mode) != 0)      /* try to insert the entry */
+            delete_fm_entry (fm2);      /* delete it if failed */
+    }
+    delete_fm_entry (fm);
+    return true;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/subfont.txt b/Build/source/texk/web2c/luatexdir/font/subfont.txt
new file mode 100644
index 00000000000..9fe053cbb9c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/subfont.txt
@@ -0,0 +1,74 @@
+map entry:
+
+cyberb@Unicode@  <cyberbit.ttf PidEid=3,1
+
+means
+
+cyberb<INFIX> => look at Unicode.sfd => find the mapping => charcode 
+    => PidEid=3,1 => glyphs
+
+eg cyberb01 => subfont 01 in Unicode.sfd => charcodes
+
+Infix can be anything, thus the question: given a tfm name, how to find out
+whether this is a subfont?
+
+It is safe to limit the infix to be composed from hexadecimal digits only?
+
+If so, one possibility is:
+
+(1)
+while last-char-of-tfmname is a hexdigit do
+    remove the last char from tfmname
+    do a lookup for the tfmname
+    if found an entry with subfont flag then
+        break
+enddo
+
+(2)
+Or, when a map entry with subfont flag is scanned, let pdftex create all 
+the relevant entries. Which may be a safer and faster solution (but wastes more
+memory)
+
+
+Let's do (2), as infix can be any word.
+
+
+
+Implementation:
+
+- let's have a map entry: 
+
+cyberb@Unicode@  <cyberbit.ttf PidEid=3,1 
+
+- actions:
+    - read Unicode.sfd
+    - create corresponding sfd mapping like ("01", "Unicode") => long[256]
+    - added those subfont to an AVL tree
+    - create map entries for cyberb01--cyberbff, each has a pointer to the
+      corresponding sfd mapping entry
+
+- extended attributes for map entry:
+    - Pid
+    - Eid
+    - sfd_map
+
+- sfd_mapping:
+    - name: sfd name, eg "Unicode"
+    - infix, eg "01"
+    - mapping: long[256]
+
+- how to find out whether a sfd has been loaded:
+    - lookup for any entry with the given sfd name
+
+- functions:
+    - load_sfd
+    - lookup_subfont
+    - extend reading map entries
+
+- when writting ttf:
+    - if re-encoded --> process like in case of type1 fonts
+    - if PidEid is being used:
+        - read cmap tables: store (ttfname, pid, eid)
+        - search for used chars
+        - use sfd to find the charcodes
+        - look into cmap to 
diff --git a/Build/source/texk/web2c/luatexdir/font/texfont.c b/Build/source/texk/web2c/luatexdir/font/texfont.c
new file mode 100644
index 00000000000..150c2cba769
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/texfont.c
@@ -0,0 +1,1094 @@
+/*
+  Copyright (c) 1996-2006 Taco Hoekwater <taco@luatex.org>
+  
+  This file is part of LuaTeX.
+  
+  LuaTeX 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.
+
+  LuaTeX 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 LuaTeX; if not, write to the Free Software
+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+  $Id: texfont.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+/* Main font API implementation for the pascal parts */
+
+/* stuff to watch out for: 
+ *
+ * - Knuth had a 'null_character' that was used when a character could
+ * not be found by the fetch() routine, to signal an error. This has
+ * been deleted, but it may mean that the output of luatex is
+ * incompatible with TeX after fetch() has detected an error condition.
+ *
+ * - Knuth also had a font_glue() optimization. I've removed that
+ * because it was a bit of dirty programming and it also was
+ * problematic if 0 != null.
+ */
+
+#include "ptexlib.h"
+#include "luatex-api.h"
+
+#define proper_char_index(c) (c<=font_ec(f) && c>=font_bc(f))
+#define dxfree(a,b) { xfree(a); a = b ; }
+#define do_realloc(a,b,d)    a = xrealloc(a,(b)*sizeof(d))
+
+texfont **font_tables = NULL;
+
+static integer font_arr_max = 0;
+static integer font_id_maxval = 0;
+
+static void grow_font_table (integer id) {
+  int j;
+  if (id>=font_arr_max) {
+    font_bytes += (font_arr_max-id+8)*sizeof(texfont *);
+    font_tables = xrealloc(font_tables,(id+8)*sizeof(texfont *));
+    j = 8;
+    while (j--) {
+      font_tables[id+j] = NULL;
+    }
+    font_arr_max = id+8;
+  }
+}
+
+integer
+new_font_id (void) {
+  int i;
+  for (i=0;i<font_arr_max;i++) {
+    if (font_tables[i]==NULL) {
+      break;
+    }
+  }
+  if (i>=font_arr_max)
+    grow_font_table (i);
+  if (i>font_id_maxval)
+    font_id_maxval = i;
+  return i;
+}
+
+integer
+max_font_id (void) {
+  return font_id_maxval;
+}
+
+void
+set_max_font_id (integer i) {
+  font_id_maxval = i;
+}
+
+integer
+new_font (void) {
+  int k;
+  int id;
+  charinfo *ci;
+  id = new_font_id();
+  font_bytes += sizeof(texfont);
+  /* most stuff is zero */
+  font_tables[id] = xcalloc(1,sizeof(texfont));
+  font_tables[id]->_font_name = NULL;   
+  font_tables[id]->_font_area = NULL;   
+  font_tables[id]->_font_filename = NULL;   
+  font_tables[id]->_font_fullname = NULL;   
+  font_tables[id]->_font_encodingname = NULL;   
+  font_tables[id]->_font_cidregistry = NULL;   
+  font_tables[id]->_font_cidordering = NULL;   
+  font_tables[id]->_left_boundary = NULL;   
+  font_tables[id]->_right_boundary = NULL;   
+  font_tables[id]->_param_base = NULL;   
+  
+  set_font_bc(id, 1); /* ec = 0 */
+  set_hyphen_char(id,'-');
+  set_skew_char(id,-1);
+
+  /* allocate eight values including 0 */
+  set_font_params(id,7);
+  for (k=0;k<=7;k++) { 
+    set_font_param(id,k,0);
+  }
+  /* character info zero is reserved for notdef */  
+  font_tables[id]->characters = new_sa_tree(1, 0); /* stack size 1, default item value 0 */
+
+  ci = xcalloc(1,sizeof(charinfo));
+  set_charinfo_name(ci,xstrdup(".notdef"));
+  font_tables[id]->charinfo = ci;
+  font_tables[id]->charinfo_cache = NULL;
+
+  return id;
+}
+
+#define Charinfo_count(a) font_tables[a]->charinfo_count
+#define Charinfo_size(a) font_tables[a]->charinfo_size
+#define Characters(a) font_tables[a]->characters
+
+charinfo *
+get_charinfo (internal_font_number f, integer c) { 
+  sa_tree_item glyph;
+  charinfo *ci;
+  if (proper_char_index(c)) {
+    glyph = get_sa_item(Characters(f), c);
+    if (!glyph) {
+      /* this could be optimized using controlled growth */
+      font_bytes += sizeof(charinfo);
+      glyph = ++font_tables[f]->charinfo_count;
+      do_realloc(font_tables[f]->charinfo, (glyph+1), charinfo); 
+      memset (&(font_tables[f]->charinfo[glyph]),0,sizeof(charinfo));
+  	  font_tables[f]->charinfo[glyph].ef = 1000; /* init */
+      font_tables[f]->charinfo_size = glyph;
+      set_sa_item(font_tables[f]->characters, c, glyph, 1); /* 1= global */
+    }
+    return &(font_tables[f]->charinfo[glyph]);
+  } else if (c == left_boundarychar) {
+    if (left_boundary(f)==NULL) {
+      ci = xcalloc(1,sizeof(charinfo));
+      font_bytes += sizeof(charinfo);
+      set_left_boundary(f,ci);
+    }
+    return left_boundary(f);
+  } else if (c == right_boundarychar) {
+    if (right_boundary(f)==NULL) {
+      ci = xcalloc(1,sizeof(charinfo));
+      font_bytes += sizeof(charinfo);
+      set_right_boundary(f,ci);
+    }
+    return right_boundary(f);
+  }
+  return &(font_tables[f]->charinfo[0]);
+}
+
+void
+set_charinfo (internal_font_number f, integer c, charinfo *ci) { 
+  sa_tree_item glyph;
+  if (proper_char_index(c)) {
+    glyph = get_sa_item(Characters(f), c);
+    if (glyph) {
+      font_tables[f]->charinfo[glyph] = *ci;
+    } else {
+      pdftex_fail("font: %s","character insertion failed");
+    }
+  } else if (c == left_boundarychar) {
+    set_left_boundary(f,ci);
+  } else if (c == right_boundarychar) {
+    set_right_boundary(f,ci);
+  }
+}
+
+
+
+charinfo *
+copy_charinfo (charinfo *ci) {
+  int x;
+  kerninfo *kern;
+  liginfo *lig;
+  real_eight_bits *packet;
+  charinfo *co = NULL;
+  if (ci==NULL)
+    return NULL;
+  co = xmalloc(sizeof(charinfo));
+  memcpy(co,ci,sizeof(charinfo));
+  set_charinfo_used(co,false);
+  co->name = NULL;
+  co->tounicode = NULL;
+  co->packets = NULL;
+  co->ligatures = NULL;
+  co->kerns = NULL;
+  co->extensible = NULL;
+  if (ci->name!=NULL) {
+    co->name = xstrdup(ci->name);
+  }
+  if (ci->tounicode!=NULL) {
+    co->tounicode = xstrdup(ci->tounicode);
+  }
+  /* kerns */
+  if ((kern = get_charinfo_kerns(ci)) != NULL) {
+    x = 0;
+    while (!kern_end(kern[x])) { x++; } x++;
+    co->kerns = xmalloc (x*sizeof(kerninfo));
+    memcpy(co->kerns,ci->kerns,(x*sizeof(kerninfo)));
+  } 
+  /* ligs */
+  if ((lig = get_charinfo_ligatures(ci)) != NULL) {
+    x = 0;
+    while (!lig_end(lig[x])) { x++; } x++;
+    co->ligatures = xmalloc (x*sizeof(liginfo));
+    memcpy(co->ligatures,ci->ligatures,(x*sizeof(liginfo)));
+  } 
+  /* packets */
+  if ((packet = get_charinfo_packets(ci)) != NULL) {
+    x = vf_packet_bytes(ci);
+    co->packets = xmalloc (x);
+    memcpy(co->packets,ci->packets,x);
+  }
+  if (get_charinfo_tag(ci)==ext_tag) {
+    int top, bot, rep, mid;
+    top = get_charinfo_extensible(ci,EXT_TOP);
+    bot = get_charinfo_extensible(ci,EXT_BOT);
+    mid = get_charinfo_extensible(ci,EXT_MID);
+    rep = get_charinfo_extensible(ci,EXT_REP);
+    set_charinfo_extensible(co,top,bot,mid,rep);
+  }
+  return co;
+}
+
+#if 0
+int 
+find_charinfo_id (internal_font_number f, integer c) {
+  register int g=0;
+  if (font_tables[f]->charinfo_cache==NULL) {
+    int i  = (font_ec(f)+1)*sizeof(int);
+    font_tables[f]->charinfo_cache = xmalloc(i);
+    memset(font_tables[f]->charinfo_cache,0,i);
+  } else {
+    g = font_tables[f]->charinfo_cache[c];
+  }
+  if (g==0) {
+    g = get_sa_item(font_tables[f]->characters, c);
+    font_tables[f]->charinfo_cache[c] = g;
+  }
+  return g;
+}
+#else
+#define find_charinfo_id(f,c) get_sa_item(font_tables[f]->characters,c)
+#endif
+
+
+charinfo *
+char_info (internal_font_number f, integer c) {
+  if (f>font_id_maxval)
+	return 0;
+  if (proper_char_index(c)) {
+    register int glyph = find_charinfo_id(f,c);
+    return &(font_tables[f]->charinfo[glyph]);
+  } else if (c == left_boundarychar && left_boundary(f)!=NULL) {
+    return left_boundary(f);
+  } else if (c == right_boundarychar && right_boundary(f)!=NULL) {
+    return right_boundary(f);
+  }
+  return &(font_tables[f]->charinfo[0]);
+}
+
+charinfo_short
+char_info_short (internal_font_number f, integer c) {
+  charinfo_short s;
+  charinfo *i;
+  i = char_info(f,c);
+  s.ci_wd = i->width;
+  s.ci_dp = i->depth;
+  s.ci_ht = i->height;
+  return s;
+}
+
+integer
+char_exists (internal_font_number f, integer c) {
+  if (f>font_id_maxval)
+	return 0;
+  if (proper_char_index(c)) {
+    return find_charinfo_id(f,c);
+  } else if ((c == left_boundarychar) && has_left_boundary(f)) {
+    return 1;
+  } else if ((c == right_boundarychar) && has_right_boundary(f)) {
+    return 1;
+  }
+  return 0;
+}
+
+int
+lua_char_exists_callback (internal_font_number f, integer c) {
+  integer callback_id ; 
+  lua_State *L = Luas[0];
+  int ret=0;
+  callback_id = callback_defined(char_exists_callback);
+  if (callback_id!=0) {
+	lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+	lua_rawgeti(L,-1, callback_id);
+	if (!lua_isfunction(L,-1)) {
+	  lua_pop(L,2);
+	  return 0;
+	}
+	lua_pushnumber(L,f);
+	lua_pushnumber(L,c);
+	if (lua_pcall(L,2,1,0) != 0) { /* two args, 1 result */
+	  fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+	  lua_pop(L,2);
+	  error();
+	} else {
+	  ret = lua_toboolean(L,-1);
+	}
+  }
+  return ret;
+}
+
+
+void set_charinfo_width       (charinfo *ci, scaled val)          { ci->width = val;     }
+void set_charinfo_height      (charinfo *ci, scaled val)          { ci->height = val;    }
+void set_charinfo_depth       (charinfo *ci, scaled val)          { ci->depth = val;     }
+void set_charinfo_italic      (charinfo *ci, scaled val)          { ci->italic = val;    }
+void set_charinfo_tag         (charinfo *ci, scaled val)          { ci->tag = val;       }
+void set_charinfo_remainder   (charinfo *ci, scaled val)          { ci->remainder = val; }
+void set_charinfo_used        (charinfo *ci, scaled val)          { ci->used = val;      }
+void set_charinfo_index       (charinfo *ci, scaled val)          { ci->index = val;     }
+void set_charinfo_name        (charinfo *ci, char *val)           { dxfree(ci->name,val);        }
+void set_charinfo_tounicode   (charinfo *ci, char *val)           { dxfree(ci->tounicode,val);        }
+void set_charinfo_ligatures   (charinfo *ci, liginfo *val)        { dxfree(ci->ligatures,val);   }
+void set_charinfo_kerns       (charinfo *ci, kerninfo *val)       { dxfree(ci->kerns,val);       }
+void set_charinfo_packets     (charinfo *ci, real_eight_bits *val){ dxfree(ci->packets,val);     }
+void set_charinfo_ef         (charinfo *ci, scaled val)          { ci->ef = val;       }
+void set_charinfo_lp         (charinfo *ci, scaled val)          { ci->lp = val;       }
+void set_charinfo_rp         (charinfo *ci, scaled val)          { ci->rp = val;       }
+
+
+
+void set_charinfo_extensible  (charinfo *ci, int top, int bot, int mid, int rep) { 
+  if (top == 0 && bot == 0 && mid == 0 && rep == 0) {
+    if (ci->extensible != NULL) {
+      free(ci->extensible);
+      ci->extensible = NULL;
+    }
+  } else {
+    if (ci->extensible == NULL) {
+      ci->extensible = xmalloc(4*sizeof(integer));
+    }
+    ci->extensible[EXT_TOP] = top;
+    ci->extensible[EXT_BOT] = bot;
+    ci->extensible[EXT_MID] = mid;
+    ci->extensible[EXT_REP] = rep;
+  }
+}
+ 
+scaled           get_charinfo_width       (charinfo *ci) { return ci->width;     }
+scaled           get_charinfo_height      (charinfo *ci) { return ci->height;    }
+scaled           get_charinfo_depth       (charinfo *ci) { return ci->depth;     }
+scaled           get_charinfo_italic      (charinfo *ci) { return ci->italic;    }
+char             get_charinfo_tag         (charinfo *ci) { return ci->tag;       }
+integer          get_charinfo_remainder   (charinfo *ci) { return ci->remainder; }
+char             get_charinfo_used        (charinfo *ci) { return ci->used;      }
+integer          get_charinfo_index       (charinfo *ci) { return ci->index;     }
+char            *get_charinfo_name        (charinfo *ci) { return ci->name;      }
+char            *get_charinfo_tounicode   (charinfo *ci) { return ci->tounicode; }
+liginfo         *get_charinfo_ligatures   (charinfo *ci) { return ci->ligatures; }
+kerninfo        *get_charinfo_kerns       (charinfo *ci) { return ci->kerns;     }
+real_eight_bits *get_charinfo_packets     (charinfo *ci) { return ci->packets;   }
+integer          get_charinfo_ef          (charinfo *ci) { return ci->ef;        }
+integer          get_charinfo_rp          (charinfo *ci) { return ci->rp;        }
+integer          get_charinfo_lp          (charinfo *ci) { return ci->lp;        }
+
+integer get_charinfo_extensible  (charinfo *ci, int whch) { 
+  int w = 0;
+  if (ci->extensible != NULL) 
+    w = ci->extensible[whch];
+  return w;
+}
+
+integer ext_top  (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  integer w = get_charinfo_extensible(ci,EXT_TOP);
+  /*  fprintf(stdout,"top of char 0x%4x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+
+integer ext_bot  (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  integer w = get_charinfo_extensible(ci,EXT_BOT);
+  /*fprintf(stdout,"bot of char 0x%4x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+integer ext_mid  (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  integer w = get_charinfo_extensible(ci,EXT_MID);
+  /*fprintf(stdout,"mid of char 0x%4x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+integer ext_rep  (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  integer w = get_charinfo_extensible(ci,EXT_REP);
+  /*fprintf(stdout,"rep of char 0x%4x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+
+scaled char_width (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  scaled w = get_charinfo_width(ci);
+  /*fprintf(stdout,"width of char 0x%x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+
+scaled char_depth (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  scaled w = get_charinfo_depth(ci);
+  /*fprintf(stdout,"depth of char 0x%x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+
+scaled char_height (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  scaled w = get_charinfo_height(ci);
+  /*fprintf(stdout,"height of char 0x%x in font %s: %i\n",c,font_name(f),w);*/
+  return w;
+}
+
+scaled char_italic (internal_font_number f, integer c) { 
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_italic(ci);
+}
+
+integer char_remainder (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_remainder(ci);
+}
+
+char char_tag (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_tag(ci);
+}
+
+char char_used (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_used(ci);
+}
+    
+char *char_name (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_name(ci);
+}
+    
+integer char_index (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_index(ci);
+}
+
+liginfo * char_ligatures (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_ligatures(ci);
+}
+
+kerninfo * char_kerns (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_kerns(ci);
+}
+
+real_eight_bits * char_packets (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_packets(ci);
+}
+    
+
+void
+set_font_params(internal_font_number f, int b) {
+  int i;
+  i = font_params(f);
+  if (i!=b) {								   
+    font_bytes += (b-font_params(f))*sizeof(scaled); 
+    do_realloc(param_base(f), (b+1), integer);	
+    font_params(f) = b;
+    if (b>i) {
+      while (i<b) {
+	i++;
+	set_font_param(f,i,0);
+      }
+    }
+  } 
+}
+
+
+integer
+copy_font (integer f) {
+  int i;
+  charinfo *ci , *co;
+  integer k = new_font();
+  memcpy(font_tables[k],font_tables[f],sizeof(texfont));
+
+  set_font_cache_id(k,0);
+  set_font_used(k,0);
+  set_font_touched(k,0);
+  
+  font_tables[k]->_font_name = NULL;   
+  font_tables[k]->_font_filename = NULL;   
+  font_tables[k]->_font_fullname = NULL;   
+  font_tables[k]->_font_encodingname = NULL;   
+  font_tables[k]->_font_area = NULL;   
+  font_tables[k]->_font_cidregistry = NULL;   
+  font_tables[k]->_font_cidordering = NULL; 
+  font_tables[k]->_left_boundary = NULL; 
+  font_tables[k]->_right_boundary = NULL; 
+
+  set_font_name(k,xstrdup(font_name(f)));
+  if (font_filename(f)!= NULL)
+    set_font_filename(k,xstrdup(font_filename(f)));
+  if (font_fullname(f)!= NULL)
+    set_font_fullname(k,xstrdup(font_fullname(f)));
+  if (font_encodingname(f)!= NULL)
+    set_font_encodingname(k,xstrdup(font_encodingname(f)));
+  if (font_area(f)!= NULL)
+    set_font_area(k,xstrdup(font_area(f)));
+  if (font_cidregistry(f)!= NULL)
+    set_font_cidregistry(k,xstrdup(font_cidregistry(f)));
+  if (font_cidordering(f)!= NULL)
+    set_font_cidordering(k,xstrdup(font_cidordering(f)));
+
+  i = sizeof(*param_base(f))*font_params(f);  
+  font_bytes += i;
+  param_base(k) = xmalloc (i);
+  memcpy(param_base(k),param_base(f), i);
+
+  i = sizeof(charinfo)*(Charinfo_size(f)+1);  
+  font_bytes += i;
+  font_tables[k]->charinfo = xmalloc(i);
+  memset(font_tables[k]->charinfo,0,i);
+  for(i=0;i<=Charinfo_size(k);i++) {
+	ci = copy_charinfo(&font_tables[f]->charinfo[i]);
+	font_tables[k]->charinfo[i] = *ci;
+  }
+
+  if (left_boundary(f)!= NULL ) {
+    ci = copy_charinfo(left_boundary(f));
+    set_charinfo(k,left_boundarychar,ci);
+  }
+
+  if (right_boundary(f)!= NULL ) {
+    ci = copy_charinfo(right_boundary(f));
+    set_charinfo(k,right_boundarychar,ci);
+  }
+  return k;
+}
+
+void delete_font (integer f) {
+  int i;
+  charinfo *co;
+  assert(f>0);
+  if (font_tables[f]!=NULL) {
+    set_font_name(f,NULL);
+    set_font_filename(f,NULL);
+    set_font_fullname(f,NULL);
+    set_font_encodingname(f,NULL);
+    set_font_area(f,NULL);
+    set_font_cidregistry(f,NULL);
+    set_font_cidordering(f,NULL);
+    set_left_boundary(f,NULL);
+    set_right_boundary(f,NULL);
+    
+    for(i=font_bc(f); i<=font_ec(f); i++) {
+      if (char_exists(f,i)) {
+		co = char_info(f,i);
+		set_charinfo_name(co,NULL);
+		set_charinfo_tounicode(co,NULL);
+		set_charinfo_packets(co,NULL);
+		set_charinfo_ligatures(co,NULL);
+		set_charinfo_kerns(co,NULL);
+		set_charinfo_extensible(co,0,0,0,0);
+      }
+    }
+	/* free .notdef */
+	set_charinfo_name(font_tables[f]->charinfo+0,NULL);
+    free(font_tables[f]->charinfo);
+    destroy_sa_tree(font_tables[f]->characters);
+
+    free(param_base(f));
+    free(font_tables[f]);
+    font_tables[f] = NULL;
+
+    if (font_id_maxval==f) {
+      font_id_maxval--;
+    }
+  }
+}
+
+void 
+create_null_font (void) {
+  int i = new_font();
+  assert(i==0);
+  set_font_name(i,xstrdup("nullfont")); 
+  set_font_area(i,xstrdup(""));
+  set_font_touched(i,1);
+}
+
+boolean 
+is_valid_font (integer id) {
+  int ret=0;
+  if (id>=0 && id<=font_id_maxval && font_tables[id]!=NULL)
+    ret=1;
+  return ret;
+}
+
+/* return 1 == identical */
+boolean
+cmp_font_name (integer id, strnumber t) {
+  char *tid , *tt;
+  if (!is_valid_font(id)) 
+    return 0;
+  tt = makecstring(t);
+  tid = font_name(id);
+  if (tt == NULL && tid == NULL)
+    return 1;
+  if (tt == NULL || tid == NULL || strcmp(tid,tt)!=0)
+    return 0;
+  return 1;
+}
+
+boolean
+cmp_font_area (integer id, strnumber t) {
+  char *tt = NULL;
+  char *tid = font_area(id);
+  if (t == 0) {
+    if (tid == NULL || strlen(tid)==0)
+      return 1;
+    else 
+      return 0;
+  }
+  tt = makecstring(t);
+  if ((tt == NULL || strlen(tt)==0) && (tid == NULL  || strlen(tid)==0))
+    return 1;
+  if (tt == NULL || strcmp(tid,tt)!=0)
+    return 0;
+  return 1;
+}
+
+
+static boolean
+same_font_name (integer id, integer t) {
+  int ret = 0;
+  if (font_name(t) == NULL || 
+      font_name(id) == NULL || 
+      strcmp(font_name(t),font_name(id))!=0) {
+    ;
+  } else {
+	ret =1 ;
+  }
+  return ret;
+}
+
+boolean
+font_shareable (internal_font_number f, internal_font_number k) {
+  int ret = 0;
+  if (font_cidregistry(f) == NULL) {
+    if ( hasfmentry ( k ) 
+	 && ( font_map ( k ) == font_map ( f ) ) 
+	 && ( same_font_name ( k , f ) 
+	      || 
+	      ( pdf_font_auto_expand (f)
+		&& ( pdf_font_blink (f) != 0 )  /* 0 = nullfont */
+		&&  same_font_name ( k , pdf_font_blink (f) ) ) ) ) {
+      ret = 1;
+	}
+  } else {
+    if ((font_filename(k) != NULL && font_filename(f) != NULL &&
+		 strcmp(font_filename(k),font_filename(f)) == 0)
+	||
+	( pdf_font_auto_expand (f)
+	  && ( pdf_font_blink (f) != 0 )  /* 0 = nullfont */
+	  &&  same_font_name ( k , pdf_font_blink (f) ) ) ) {
+      ret = 1;
+    }
+  }
+  return ret;
+}
+
+integer 
+test_no_ligatures (internal_font_number f) {
+ integer c;
+ for (c=font_bc(f);c<=font_ec(f);c++) {
+   if (has_lig(f,c)) /* char_exists(f,c) */
+     return 0;
+ }
+ return 1;
+}
+
+integer
+get_tag_code (internal_font_number f, integer c) {
+  small_number i;
+  if (char_exists(f,c)) {
+    i = char_tag(f,c);
+    if      (i==lig_tag)   return 1;
+    else if (i==list_tag)  return 2;
+    else if (i==ext_tag)   return 4;
+    else                   return 0;
+  }
+  return  -1;
+}
+
+integer
+get_lp_code (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_lp(ci);
+}
+
+integer
+get_rp_code (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_rp(ci);
+}
+
+integer
+get_ef_code (internal_font_number f, integer c) {
+  charinfo *ci = char_info(f,c);
+  return get_charinfo_ef(ci);
+}
+
+void
+set_tag_code (internal_font_number f, integer c, integer i) {
+  integer fixedi;
+  charinfo * co;
+  if (char_exists(f,c)) {
+    /* abs(fix_int(i-7,0)) */
+    fixedi = - (i<-7 ? -7 : (i>0 ? 0 : i )) ;
+    co = char_info(f,c);
+    if (fixedi >= 4) {
+      if (char_tag(f,c) == ext_tag) 
+	set_charinfo_tag(co,(char_tag(f,c)- ext_tag));
+      fixedi = fixedi - 4;
+    }
+    if (fixedi >= 2) {
+      if (char_tag(f,c) == list_tag) 
+	set_charinfo_tag(co,(char_tag(f,c)- list_tag));
+      fixedi = fixedi - 2;
+    };
+    if (fixedi >= 1) {
+      if (has_lig(f,c)) 
+	set_charinfo_ligatures(co,NULL);
+      if (has_kern(f,c)) 
+	set_charinfo_kerns(co,NULL);
+    }
+  }
+}
+
+
+void 
+set_lp_code(internal_font_number f, integer c, integer i) {
+  charinfo * co;
+  if (char_exists(f,c)) {
+    co = char_info(f,c);
+	set_charinfo_lp(co,i);
+  }
+}
+
+void 
+set_rp_code(internal_font_number f, integer c, integer i) {
+  charinfo * co;
+  if (char_exists(f,c)) {
+    co = char_info(f,c);
+	set_charinfo_rp(co,i);
+  }
+}
+
+void 
+set_ef_code(internal_font_number f, integer c, integer i) {
+  charinfo * co;
+  if (char_exists(f,c)) {
+    co = char_info(f,c);
+	set_charinfo_ef(co,i);
+  }
+}
+
+void 
+set_no_ligatures (internal_font_number f) {
+  integer c;
+  charinfo * co;
+  
+  if (font_tables[f]->ligatures_disabled)
+	return;
+
+  co = char_info(f,left_boundarychar);
+  set_charinfo_ligatures(co,NULL);
+  co = char_info(f,right_boundarychar); /* this is weird */
+  set_charinfo_ligatures(co,NULL);
+  for (c=0;c<font_tables[f]->charinfo_count;c++) {
+	co = font_tables[f]->charinfo+c;
+	set_charinfo_ligatures(co,NULL);
+  }
+  font_tables[f]->ligatures_disabled =1;
+}
+
+liginfo 
+get_ligature (internal_font_number f, integer lc, integer rc) {
+  liginfo t, u;
+  charinfo * co;
+  t.lig = 0;
+  t.type = 0;
+  t.adj = 0;
+  if (lc == non_boundarychar || rc == non_boundarychar || (!has_lig(f,lc)) )
+    return t;
+  k = 0;
+  co = char_info(f,lc);
+  while (1) {
+    u = charinfo_ligature(co,k);
+    if (lig_end(u))
+      break;    
+    if (lig_char(u) == rc) {
+      if (lig_disabled(u)) {
+	return t;
+      } else {
+	return u;
+      }
+    }
+    k++;
+  }
+  return t;
+}
+
+
+scaled 
+get_kern(internal_font_number f, integer lc, integer rc)
+{
+  integer k;
+  kerninfo u;
+  charinfo * co;
+  if (lc == non_boundarychar || rc == non_boundarychar || (!has_kern(f,lc)) )
+    return 0;
+  k = 0;
+  co = char_info(f,lc);
+  while (1) {
+    u = charinfo_kern(co,k);
+    if (kern_end(u))
+      break;
+    if (kern_char(u) == rc) {
+      if (kern_disabled(u))
+	return 0;
+      else
+	return kern_kern(u);
+    }
+    k++;
+  }
+  return 0;
+}
+
+
+/* dumping and undumping fonts */
+
+#define dump_string(a)				\
+  if (a!=NULL) {				\
+    x = strlen(a)+1;				\
+    dump_int(x);  dump_things(*a, x);		\
+  } else {					\
+    x = 0; dump_int(x);				\
+  }
+
+void
+dump_charinfo (int f , int c) {
+  charinfo *co;
+  int x;
+  liginfo *lig;
+  kerninfo *kern;
+
+  dump_int(c);
+  co = char_info(f,c);
+  set_charinfo_used(co,0);
+  dump_int(get_charinfo_width(co));
+  dump_int(get_charinfo_height(co));
+  dump_int(get_charinfo_depth(co));
+  dump_int(get_charinfo_italic(co));
+  dump_int(get_charinfo_tag(co));
+  dump_int(get_charinfo_ef(co));
+  dump_int(get_charinfo_rp(co));
+  dump_int(get_charinfo_lp(co));
+  dump_int(get_charinfo_remainder(co));
+  dump_int(get_charinfo_used(co));
+  dump_int(get_charinfo_index(co));
+  dump_string(get_charinfo_name(co));
+  dump_string(get_charinfo_tounicode(co));
+
+  /* ligatures */
+  x = 0;
+  if ((lig = get_charinfo_ligatures(co)) != NULL) {
+    while (!lig_end(lig[x])) { x++; }
+    x++;
+    dump_int(x);  dump_things(*lig, x);
+  } else {
+    dump_int(x);
+  }
+  /* kerns */
+  x = 0;
+  if ((kern = get_charinfo_kerns(co)) != NULL) {
+    while (!kern_end(kern[x])) { x++; }
+    x++;
+    dump_int(x);  dump_things(*kern, x);
+  } else {
+    dump_int(x);	
+  }
+  /* packets */
+  x= vf_packet_bytes(co);
+  dump_int(x);  
+  if (x>0) {
+    dump_things(*get_charinfo_packets(co), x);
+  }
+
+  if (get_charinfo_tag(co)==ext_tag) {
+    x = get_charinfo_extensible(co,EXT_TOP);       dump_int(x);
+    x = get_charinfo_extensible(co,EXT_BOT);       dump_int(x);
+    x = get_charinfo_extensible(co,EXT_MID);       dump_int(x);
+    x = get_charinfo_extensible(co,EXT_REP);       dump_int(x);
+  }
+}
+
+void
+dump_font (int f) {
+  int i,x;
+
+  set_font_used(f,0);
+  font_tables[f]->charinfo_cache = NULL;
+  dump_things(*(font_tables[f]), 1);
+  dump_string(font_name(f));
+  dump_string(font_area(f));
+  dump_string(font_filename(f));
+  dump_string(font_fullname(f));
+  dump_string(font_encodingname(f));
+  dump_string(font_cidregistry(f));
+  dump_string(font_cidordering(f));
+
+  dump_things(*param_base(f),(font_params(f)+1));
+
+  if (has_left_boundary(f)) {
+    dump_int(1);  dump_charinfo(f,left_boundarychar);
+  } else {
+    dump_int(0);
+  }
+  if (has_right_boundary(f)) {
+    dump_int(1);  dump_charinfo(f,right_boundarychar);
+  } else {
+    dump_int(0);
+  }
+
+  for(i=font_bc(f); i<=font_ec(f); i++) {
+    if (char_exists(f,i)) {
+      dump_charinfo(f,i);
+    }
+  }
+}
+
+int
+undump_charinfo (int f) {
+  charinfo *co;
+  int x,i;
+  char *s = NULL;
+  liginfo *lig = NULL;
+  kerninfo *kern = NULL;
+  real_eight_bits *packet = NULL;
+  int top = 0, bot = 0, mid = 0, rep = 0;
+
+  undump_int(i);
+  co = get_charinfo(f,i);
+  undump_int(x); set_charinfo_width(co,x);
+  undump_int(x); set_charinfo_height(co,x);
+  undump_int(x); set_charinfo_depth(co,x);
+  undump_int(x); set_charinfo_italic(co,x);
+  undump_int(x); set_charinfo_tag(co,x);
+  undump_int(x); set_charinfo_ef(co,x);
+  undump_int(x); set_charinfo_rp(co,x);
+  undump_int(x); set_charinfo_lp(co,x);
+  undump_int(x); set_charinfo_remainder(co,x);
+  undump_int(x); set_charinfo_used(co,x);
+  undump_int(x); set_charinfo_index(co,x);
+
+  /* name */
+  undump_int (x);
+  if (x>0) {
+    font_bytes += x;
+    s = xmalloc(x); 
+    undump_things(*s,x);
+  }
+  set_charinfo_name(co,s); 
+
+  /* tounicode */
+  undump_int (x);
+  if (x>0) {
+    font_bytes += x;
+    s = xmalloc(x); 
+    undump_things(*s,x);
+  }
+  set_charinfo_tounicode(co,s); 
+
+  /* ligatures */
+  undump_int (x);      
+  if (x>0) {
+    font_bytes += x*sizeof(liginfo);
+    lig = xmalloc(x*sizeof(liginfo)); 
+    undump_things(*lig,x);
+  }
+  set_charinfo_ligatures(co,lig); 
+
+  /* kerns */
+  undump_int (x);      
+  if (x>0) {
+    font_bytes += x*sizeof(kerninfo);
+    kern = xmalloc(x*sizeof(kerninfo)); 
+    undump_things(*kern,x);
+  }
+  set_charinfo_kerns(co,kern); 
+
+  /* packets */
+  undump_int (x);      
+  if (x>0) {
+    font_bytes += x;
+    packet = xmalloc(x); 
+    undump_things(*packet,x);
+  }
+  set_charinfo_packets(co,packet); 
+
+  if (get_charinfo_tag(co)==ext_tag) {
+    undump_int(top);
+    undump_int(bot);
+    undump_int(mid);
+    undump_int(rep);
+    set_charinfo_extensible(co,top,bot,mid,rep);
+  }
+  return i;
+}
+
+#define undump_font_string(a)   undump_int (x);	\
+  if (x>0) {					\
+    font_bytes += x;				\
+    s = xmalloc(x); undump_things(*s,x);	\
+    a(f,s); }
+
+
+void
+undump_font(int f)
+{
+  int x, i;
+  texfont *tt;
+  charinfo *ci;
+  char *s;
+  grow_font_table (f);
+  font_tables[f] = NULL;
+  font_bytes += sizeof(texfont);
+  tt = xmalloc(sizeof(texfont));
+  undump_things(*tt,1);
+  font_tables[f] = tt;
+
+  undump_font_string(set_font_name);
+  undump_font_string(set_font_area);
+  undump_font_string(set_font_filename);
+  undump_font_string(set_font_fullname);
+  undump_font_string(set_font_encodingname);
+  undump_font_string(set_font_cidregistry);
+  undump_font_string(set_font_cidordering);
+
+  i = sizeof(*param_base(f))*(font_params(f)+1); 
+  font_bytes += i;
+  param_base(f) = xmalloc (i);
+  undump_things(*param_base(f),    (font_params(f)+1));
+
+  font_tables[f]->_left_boundary = NULL;
+  undump_int(x);
+  if (x) {  i =  undump_charinfo(f);  } /* left boundary */
+
+  font_tables[f]->_right_boundary = NULL;
+  undump_int(x);
+  if (x) {  i =  undump_charinfo(f);  } /* right boundary */
+
+
+  font_tables[f]->characters = new_sa_tree(1, 0); /* stack size 1, default item value 0 */
+  ci = xcalloc(1,sizeof(charinfo));
+  set_charinfo_name(ci,xstrdup(".notdef"));
+  font_tables[f]->charinfo = ci;
+
+  i = font_bc(f);
+  while(i<font_ec(f)) {
+    i = undump_charinfo(f);
+  }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/texfont.h b/Build/source/texk/web2c/luatexdir/font/texfont.h
new file mode 100644
index 00000000000..21b79f1e876
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/texfont.h
@@ -0,0 +1,524 @@
+/*
+  Copyright (c) 1996-2006 Taco Hoekwater <taco@luatex.org>
+  
+  This file is part of LuaTeX.
+  
+  LuaTeX 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.
+
+  LuaTeX 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 LuaTeX; if not, write to the Free Software
+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+  $Id: texfont.h 1117 2008-03-21 15:26:12Z hhenkel $ */
+
+/* Here we have the interface to LuaTeX's font system, as seen from the
+   main pascal program. There is a companion list in luatex.defines to
+   keep web2c happy */
+
+/* this file is read at the end of ptexlib.h, which is called for at
+   the end of luatexcoerce.h, as well as from the C sources 
+*/
+
+#ifndef TEXFONT_H
+#define TEXFONT_H 1
+
+#include "luatexdir/managed-sa.h"
+
+#define pointer halfword
+
+typedef struct liginfo {
+  integer adj;
+  integer lig;
+  char type;
+} liginfo;
+
+typedef struct kerninfo {
+  integer adj;
+  scaled sc;
+} kerninfo;
+
+typedef struct charinfo {
+  char *name;                /* postscript character name */
+  liginfo *ligatures;        /* ligature items */
+  kerninfo *kerns;           /* kern items */
+  real_eight_bits *packets;  /* virtual commands.  */
+  integer *extensible;       /* extensible recipe (if any) */
+  unsigned short index;        /* CID index */
+  integer remainder;         /* spare value for odd items, could be union-ed with extensible */
+  scaled width;              /* width */
+  scaled height;             /* height */
+  scaled depth;              /* depth */
+  scaled italic;             /* italic correction */
+  integer ef;                /* font expansion factor */
+  integer lp;                /* left protruding factor */
+  integer rp;                /* right protruding factor */
+  char tag ;                 /* list / ext taginfo */
+  char used ;                /* char is typeset ? */
+  char *tounicode;           /* unicode equivalent */
+} charinfo;
+
+
+/* this is for speed reasons, it is called from the web source
+   when more than two of the traditional four char values are needed 
+   at the same time. the structure |charinfo_short| is defined in 
+   web */
+
+#ifndef luaTeX
+typedef struct charinfo_short {
+  scaled ci_wd;              /* width */
+  scaled ci_ht;             /* height */
+  scaled ci_dp;              /* depth */
+} charinfo_short;
+#endif
+
+
+extern charinfo_short char_info_short (internal_font_number f, integer c);
+
+
+
+typedef struct texfont {
+  integer _font_size ;
+  integer _font_dsize ;
+  char * _font_name ;
+  char * _font_area ;
+  char * _font_filename ;
+  char * _font_fullname ;
+  char * _font_encodingname ;
+  char * _font_cidregistry ;
+  char * _font_cidordering ;
+  integer _font_cidversion ;
+  integer _font_cidsupplement ;
+
+  integer _font_ec ;
+  integer _font_checksum ;   /* internal information */
+  char    _font_used ;       /* internal information */
+  char    _font_touched ;    /* internal information */
+  integer _font_cache_id ;   /* internal information */
+  char    _font_encodingbytes ; /* 1 or 2 bytes */
+  integer _font_slant ;      /* a slant in ppt */
+  integer _font_extend ;     /* an extension in ppt, or 0 */
+  char    _font_tounicode ; /* 1 if info is present */
+  fm_entry_ptr _font_map;
+  integer _font_type;
+  integer _font_format;
+  integer _font_embedding;
+  integer _font_bc ;
+  integer _hyphen_char ;
+  integer _skew_char ;
+  integer _font_natural_dir;
+
+  charinfo *_left_boundary;
+  charinfo *_right_boundary;
+
+  integer _font_params;
+  scaled  *_param_base;
+
+  sa_tree   characters;
+  integer   charinfo_count;
+  integer   charinfo_size;
+  charinfo *charinfo;
+  int      *charinfo_cache;
+  integer  ligatures_disabled;
+
+  integer  _pdf_font_num; /* maps to a PDF resource ID */
+  scaled   _pdf_font_size; /* maps to a PDF font size */
+  internal_font_number _pdf_font_blink; /* link to  base font for expanded fonts */
+  internal_font_number _pdf_font_elink; /* link to expanded fonts for base font */
+  integer  _pdf_font_expand_ratio; /* expansion ratio of a particular font */
+  internal_font_number  _pdf_font_shrink; /* font at limit of shrinking */
+  internal_font_number  _pdf_font_stretch; /* font at limit of stretching */
+  integer  _pdf_font_step;  /* amount of one step of expansion */
+  boolean  _pdf_font_auto_expand; /* this font is auto-expanded? */
+  str_number _pdf_font_attr; /* pointer to additional attributes */
+} texfont;
+
+typedef enum {
+  unknown_font_type=0, /* new font (has not been used yet) */
+  virtual_font_type, /* virtual font */
+  real_font_type, /* real font */
+} font_types;
+
+typedef enum {
+  unknown_format=0, 
+  type1_format, 
+  type3_format, 
+  truetype_format, 
+  opentype_format, 
+} font_formats;
+
+typedef enum {
+  unknown_embedding=0, 
+  no_embedding, 
+  subset_embedding, 
+  full_embedding, 
+} font_embedding_option;
+
+extern char *font_type_strings[];
+extern char *font_format_strings[];
+extern char *font_embedding_strings[];
+
+
+#define font_checksum(a)          font_tables[a]->_font_checksum
+#define set_font_checksum(a,b)    font_checksum(a) = b
+
+#define font_check_0(a)           ((font_tables[a]->_font_checksum&0xFF000000)>>24)
+#define font_check_1(a)           ((font_tables[a]->_font_checksum&0x00FF0000)>>16)
+#define font_check_2(a)           ((font_tables[a]->_font_checksum&0x0000FF00)>>8)
+#define font_check_3(a)            (font_tables[a]->_font_checksum&0x000000FF)
+
+#define font_size(a)              font_tables[a]->_font_size
+#define set_font_size(a,b)        font_size(a) = b
+#define font_dsize(a)             font_tables[a]->_font_dsize
+#define set_font_dsize(a,b)       font_dsize(a) = b
+
+#define font_name(a)              font_tables[a]->_font_name
+#define get_font_name(a)          (unsigned char *)font_name(a)
+#define set_font_name(f,b)        font_name(f) = b
+#define tex_font_name(a)          maketexstring(font_name(a))
+
+boolean cmp_font_name (integer, strnumber);
+
+#define font_area(a)              font_tables[a]->_font_area
+#define get_font_area(a)          (unsigned char *)font_area(a)
+#define set_font_area(f,b)        font_area(f) = b
+#define tex_font_area(a)          maketexstring(font_area(a))
+
+boolean cmp_font_area (integer, strnumber);
+
+#define font_reassign(a,b)            { if (a!=NULL) free(a); a = b; }
+
+#define font_filename(a)            font_tables[a]->_font_filename
+#define set_font_filename(f,b)      font_reassign(font_filename(f),b)
+
+#define font_fullname(a)            font_tables[a]->_font_fullname
+#define set_font_fullname(f,b)      font_reassign(font_fullname(f),b)
+
+#define font_encodingname(a)        font_tables[a]->_font_encodingname
+#define set_font_encodingname(f,b)  font_reassign(font_encodingname(f),b)
+
+boolean font_shareable(internal_font_number,internal_font_number);
+
+#define cmp_font_filename(a,b)      (!(font_filename(a)!=NULL || font_filename(b)!=NULL || \
+                                       strcmp(font_filename(a),font_filename(b))))
+#define cmp_font_fullname(a,b)      (!(font_fullname(a)!=NULL || font_fullname(b)!=NULL || \
+                                       strcmp(font_fullname(a),font_fullname(b))))
+#define cmp_font_encodingname(a,b)  (!(font_encoding(a)!=NULL || font_encodingname(b)!=NULL || \
+                                       strcmp(font_encodingname(a),font_encodingname(b))))
+
+#define font_bc(a)                  font_tables[a]->_font_bc
+#define set_font_bc(f,b)            font_bc(f) = b
+
+#define font_ec(a)                  font_tables[a]->_font_ec
+#define set_font_ec(f,b)            font_ec(f) = b
+
+#define font_used(a)                (font_tables[a]!=NULL && font_tables[a]->_font_used)
+#define set_font_used(a,b)          font_tables[a]->_font_used = b
+
+#define font_touched(a)             font_tables[a]->_font_touched
+#define set_font_touched(a,b)       font_touched(a) = b
+ 
+#define font_type(a)                font_tables[a]->_font_type
+#define set_font_type(a,b)          {  /* fprintf(stdout,"set font type of %s to %i: %s\n",font_name(a),b,__FILE__); */ 	\
+                                       font_type(a) = b; }
+
+#define font_format(a)              font_tables[a]->_font_format
+#define font_format_name(a)         font_format_strings[font_tables[a]->_font_format]
+#define set_font_format(a,b)        font_format(a) = b
+
+#define font_embedding(a)           font_tables[a]->_font_embedding
+#define set_font_embedding(a,b)     font_embedding(a) = b
+
+#define font_cidversion(a)          font_tables[a]->_font_cidversion
+#define set_font_cidversion(a,b)    font_cidversion(a) = b
+
+#define font_cidsupplement(a)       font_tables[a]->_font_cidsupplement
+#define set_font_cidsupplement(a,b) font_cidsupplement(a) = b
+
+#define font_cidordering(a)         font_tables[a]->_font_cidordering
+#define set_font_cidordering(f,b)   font_reassign(font_cidordering(f),b)
+
+#define font_cidregistry(a)         font_tables[a]->_font_cidregistry
+#define set_font_cidregistry(f,b)   font_reassign(font_cidregistry(f),b)
+
+#define font_map(a)                 font_tables[a]->_font_map
+#define set_font_map(a,b)           font_map(a) = b
+
+#define font_cache_id(a)            font_tables[a]->_font_cache_id
+#define set_font_cache_id(a,b)      font_cache_id(a) = b
+
+#define font_encodingbytes(a)       font_tables[a]->_font_encodingbytes
+#define set_font_encodingbytes(a,b) font_encodingbytes(a) = b
+
+#define font_slant(a)               font_tables[a]->_font_slant
+#define set_font_slant(a,b)         font_slant(a) = b
+
+#define font_extend(a)              font_tables[a]->_font_extend
+#define set_font_extend(a,b)        font_extend(a) = b
+
+#define font_tounicode(a)           font_tables[a]->_font_tounicode
+#define set_font_tounicode(a,b)     font_tounicode(a) = b
+
+#define hyphen_char(a)              font_tables[a]->_hyphen_char
+#define set_hyphen_char(a,b)        hyphen_char(a) = b
+
+#define skew_char(a)                font_tables[a]->_skew_char
+#define set_skew_char(a,b)          skew_char(a) = b
+
+#define font_natural_dir(a)         font_tables[a]->_font_natural_dir
+#define set_font_natural_dir(a,b)   font_natural_dir(a) = b
+
+#define pdf_font_size(a)            font_tables[a]->_pdf_font_size
+#define set_pdf_font_size(a,b)      pdf_font_size(a) = b
+
+#define pdf_font_num(a)             font_tables[a]->_pdf_font_num
+#define set_pdf_font_num(a,b)       pdf_font_num(a) = b
+
+#define pdf_font_blink(a)            font_tables[a]->_pdf_font_blink
+#define set_pdf_font_blink(a,b)      pdf_font_blink(a) = b
+
+#define pdf_font_elink(a)            font_tables[a]->_pdf_font_elink
+#define set_pdf_font_elink(a,b)      pdf_font_elink(a) = b
+
+#define pdf_font_expand_ratio(a)            font_tables[a]->_pdf_font_expand_ratio
+#define set_pdf_font_expand_ratio(a,b)      pdf_font_expand_ratio(a) = b
+
+#define pdf_font_shrink(a)            font_tables[a]->_pdf_font_shrink
+#define set_pdf_font_shrink(a,b)      pdf_font_shrink(a) = b
+
+#define pdf_font_stretch(a)            font_tables[a]->_pdf_font_stretch
+#define set_pdf_font_stretch(a,b)      pdf_font_stretch(a) = b
+
+#define pdf_font_step(a)            font_tables[a]->_pdf_font_step
+#define set_pdf_font_step(a,b)      pdf_font_step(a) = b
+
+#define pdf_font_auto_expand(a)            font_tables[a]->_pdf_font_auto_expand
+#define set_pdf_font_auto_expand(a,b)      pdf_font_auto_expand(a) = b
+
+#define pdf_font_attr(a)            font_tables[a]->_pdf_font_attr
+#define set_pdf_font_attr(a,b)      pdf_font_attr(a) = b
+
+
+#define left_boundarychar  -1
+#define right_boundarychar -2
+#define non_boundarychar -3
+
+#define left_boundary(a)              font_tables[a]->_left_boundary
+#define has_left_boundary(a)          (left_boundary(a)!=NULL)
+#define set_left_boundary(a,b)        font_reassign(left_boundary(a),b)
+
+#define right_boundary(a)             font_tables[a]->_right_boundary
+#define has_right_boundary(a)         (right_boundary(a)!=NULL)
+#define set_right_boundary(a,b)       font_reassign(right_boundary(a),b)
+
+#define font_bchar(a)       (right_boundary(a)!=NULL ? right_boundarychar : non_boundarychar)
+
+/* font parameters */
+
+#define font_params(a)       font_tables[a]->_font_params
+#define param_base(a)        font_tables[a]->_param_base
+#define font_param(a,b)      font_tables[a]->_param_base[b]
+
+extern void set_font_params(internal_font_number f, int b);
+
+#define set_font_param(f,n,b)                                   \
+  { if (font_params(f)<n) set_font_params(f,n);                 \
+    font_param(f,n) = b; }
+
+/* Font parameters are sometimes referred to as |slant(f)|, |space(f)|, etc.*/
+
+typedef enum {
+  slant_code = 1,
+  space_code = 2,
+  space_stretch_code = 3,
+  space_shrink_code = 4,
+  x_height_code = 5,
+  quad_code = 6,
+  extra_space_code = 7 } font_parameter_codes ;
+
+#define slant(f)         font_param(f,slant_code)
+#define space(f)         font_param(f,space_code)
+#define space_stretch(f) font_param(f,space_stretch_code)
+#define space_shrink(f)  font_param(f,space_shrink_code)
+#define x_height(f)      font_param(f,x_height_code)
+#define quad(f)          font_param(f,quad_code)
+#define extra_space(f)   font_param(f,extra_space_code)
+
+/* now for characters  */
+
+extern charinfo *get_charinfo (internal_font_number f, integer c) ;
+extern integer char_exists (internal_font_number f, integer c);
+extern charinfo *char_info (internal_font_number f, integer c);
+
+
+extern void set_charinfo_width       (charinfo *ci, scaled val);
+extern void set_charinfo_height      (charinfo *ci, scaled val);
+extern void set_charinfo_depth       (charinfo *ci, scaled val);
+extern void set_charinfo_italic      (charinfo *ci, scaled val);
+extern void set_charinfo_tag         (charinfo *ci, scaled val);
+extern void set_charinfo_remainder   (charinfo *ci, scaled val);
+extern void set_charinfo_used        (charinfo *ci, scaled val);
+extern void set_charinfo_index       (charinfo *ci, scaled val);
+extern void set_charinfo_name        (charinfo *ci, char *val) ;
+extern void set_charinfo_tounicode   (charinfo *ci, char *val) ;
+extern void set_charinfo_ligatures   (charinfo *ci, liginfo *val);
+extern void set_charinfo_kerns       (charinfo *ci, kerninfo *val);
+extern void set_charinfo_packets     (charinfo *ci, real_eight_bits *val);
+extern void set_charinfo_extensible  (charinfo *ci, int a, int b, int c, int d);
+
+#define set_char_used(f,a,b)  set_charinfo_used(get_charinfo(f,a),b)
+
+extern scaled get_charinfo_width             (charinfo *ci);
+extern scaled get_charinfo_height            (charinfo *ci);
+extern scaled get_charinfo_depth             (charinfo *ci);
+extern scaled get_charinfo_italic            (charinfo *ci);
+extern char    get_charinfo_tag              (charinfo *ci);
+extern integer get_charinfo_remainder        (charinfo *ci);
+extern char    get_charinfo_used             (charinfo *ci);
+extern integer get_charinfo_index            (charinfo *ci);
+extern char * get_charinfo_name              (charinfo *ci) ;
+extern char * get_charinfo_tounicode         (charinfo *ci) ;
+extern liginfo * get_charinfo_ligatures      (charinfo *ci);
+extern kerninfo *get_charinfo_kerns          (charinfo *ci);
+extern real_eight_bits *get_charinfo_packets (charinfo *ci);
+extern integer get_charinfo_extensible       (charinfo *ci, int which);
+
+extern integer ext_top                       (internal_font_number f, integer c);
+extern integer ext_bot                       (internal_font_number f, integer c);
+extern integer ext_rep                       (internal_font_number f, integer c);
+extern integer ext_mid                       (internal_font_number f, integer c);
+
+#define set_ligature_item(f,b,c,d)  { f.type = b; f.adj = c;  f.lig = d; }
+
+#define set_kern_item(f,b,c)	    { f.adj = b;  f.sc = c; }
+
+
+/* character information */
+
+#define non_char 65536 /* a code that can't match a real character */
+#define non_address 0  /* a spurious |bchar_label| */
+
+
+/* character kerns and ligatures */
+
+#define end_kern               0x7FFFFF /* otherchar value meaning "stop" */
+#define ignored_kern           0x800000 /* otherchar value meaning "disabled" */
+
+#define charinfo_kern(b,c)        b->kerns[c]
+
+#define kern_char(b)          (b).adj
+#define kern_kern(b)          (b).sc
+#define kern_end(b)          ((b).adj == end_kern)
+#define kern_disabled(b)     ((b).adj > end_kern)
+
+/* character ligatures */
+
+#define end_ligature          0x7FFFFF /* otherchar value meaning "stop" */
+#define ignored_ligature      0x800000 /* otherchar value meaning "disabled" */
+
+#define charinfo_ligature(b,c)     b->ligatures[c]
+
+#define is_valid_ligature(a)   ((a).type!=0)
+#define lig_type(a)            ((a).type>>1)
+#define lig_char(a)            (a).adj
+#define lig_replacement(a)     (a).lig
+#define lig_end(a)             (lig_char(a) == end_ligature)
+#define lig_disabled(a)        (lig_char(a) > end_ligature)
+
+#define no_tag 0   /* vanilla character */
+#define lig_tag 1  /* character has a ligature/kerning program */
+#define list_tag 2 /* character has a successor in a charlist */
+#define ext_tag 3  /* character is extensible */
+
+extern scaled char_height (internal_font_number f, integer c);
+extern scaled char_width  (internal_font_number f, integer c);
+extern scaled char_depth  (internal_font_number f, integer c);
+extern scaled char_italic (internal_font_number f, integer c);
+
+extern liginfo * char_ligatures (internal_font_number f, integer c);
+extern kerninfo * char_kerns (internal_font_number f, integer c);
+extern real_eight_bits * char_packets (internal_font_number f, integer c);
+
+#define has_lig(f,b)          (char_exists(f,b) &&( char_ligatures(f,b) != NULL))
+#define has_kern(f,b)         (char_exists(f,b) && (char_kerns(f,b) != NULL))
+#define has_packet(f,b)       (char_exists(f,b) && (char_packets(f,b) != NULL))
+
+extern integer char_remainder (internal_font_number f, integer c);
+extern char char_tag (internal_font_number f, integer c);
+extern char char_used (internal_font_number f, integer c);
+extern char * char_name (internal_font_number f, integer c);
+extern integer char_index (internal_font_number f, integer c);
+
+scaled get_kern(internalfontnumber f, integer lc, integer rc);
+liginfo get_ligature(internalfontnumber f, integer lc, integer rc);
+
+#define EXT_TOP 0
+#define EXT_BOT 1
+#define EXT_MID 2
+#define EXT_REP 3
+
+extern texfont **font_tables;
+
+integer new_font (void) ;
+integer copy_font (integer id) ;
+integer scale_font (integer id, integer atsize) ;
+integer max_font_id (void);
+void set_max_font_id (integer id);
+integer new_font_id (void);
+void create_null_font (void);
+void delete_font(integer id);
+boolean is_valid_font (integer id);
+
+void dump_font (int font_number);
+void undump_font (int font_number);
+
+integer test_no_ligatures (internal_font_number f) ;
+void set_no_ligatures (internal_font_number f) ;
+
+extern integer get_tag_code (internal_font_number f, integer c);
+extern integer get_lp_code (internal_font_number f, integer c);
+extern integer get_rp_code (internal_font_number f, integer c);
+extern integer get_ef_code (internal_font_number f, integer c);
+
+extern void set_tag_code (internal_font_number f, integer c, integer i) ;
+extern void set_lp_code(internal_font_number f, integer c, integer i) ;
+extern void set_rp_code(internal_font_number f, integer c, integer i) ;
+extern void set_ef_code(internal_font_number f, integer c, integer i) ;
+
+int read_tfm_info(internal_font_number f, char *nom, char *aire, scaled s);
+
+
+/* from dofont.c */
+
+extern int read_font_info (pointer u, strnumber nom, strnumber aire, scaled s, integer ndir);
+extern int find_font_id (char *nom, char *aire, scaled s);
+
+/* for and from vfpacket.c */
+
+#define scan_special 3 /* look into special text */ /* this is a hack */
+
+typedef enum {  packet_char_code,
+		packet_font_code,
+		packet_pop_code,
+		packet_push_code,
+		packet_special_code,
+		packet_right_code,
+		packet_down_code,
+		packet_rule_code,
+		packet_node_code,
+		packet_nop_code,
+		packet_end_code } packet_command_codes;
+
+extern scaled sqxfw (scaled sq, integer fw);
+
+extern void do_vf_packet (internal_font_number vf_f, integer c);
+extern int vf_packet_bytes (charinfo *co);
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/font/tfmofm.c b/Build/source/texk/web2c/luatexdir/font/tfmofm.c
new file mode 100644
index 00000000000..db82f94deba
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tfmofm.c
@@ -0,0 +1,1005 @@
+/*
+Copyright (c) 1996-2006 Taco Hoekwater <taco@luatex.org>
+
+This file is part of LuaTeX.
+
+LuaTeX 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.
+
+LuaTeX 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 LuaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: tfmofm.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+#include "luatex-api.h"
+
+/* Here are some macros that help process ligatures and kerns */
+
+#define lig_kern_start(f,c)   char_remainder(f,c)
+#define stop_flag 128 /* value indicating `\.{STOP}' in a lig/kern program */
+#define kern_flag 128 /* op code for a kern step */
+
+#define skip_byte(z)         lig_kerns[z].b0
+#define next_char(z)         lig_kerns[z].b1
+#define op_byte(z)           lig_kerns[z].b2
+#define rem_byte(z)          lig_kerns[z].b3
+#define lig_kern_restart(c)  (256*op_byte(c)+rem_byte(c))
+
+/*
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of 4, we could
+also regard the file as a sequence of 32-bit words, but \TeX\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+$\Omega$ is capable of reading not only \.{TFM} files, but also
+\.{OFM} files, which can describe fonts with up to 65536 characters
+and with huge lig/kern tables.  These fonts will often be virtual
+fonts built up from real fonts with 256 characters, but $\Omega$
+is not aware of this.  
+
+The documentation below describes \.{TFM} files, with slight additions
+to show where \.{OFM} files differ.
+                                         */
+/*
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|lf|&length of the entire file, in words;\cr
+|lh|&length of the header data, in words;\cr
+|bc|&smallest character code in the font;\cr
+|ec|&largest character code in the font;\cr
+|nw|&number of words in the width table;\cr
+|nh|&number of words in the height table;\cr
+|nd|&number of words in the depth table;\cr
+|ni|&number of words in the italic correction table;\cr
+|nl|&number of words in the lig/kern table;\cr
+|nk|&number of words in the kern table;\cr
+|ne|&number of words in the extensible character table;\cr
+|np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a \.{TFM} font may contain as many as 256 characters 
+(if |bc=0| and |ec=255|), and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@!@^BigEndian order@>
+
+The first 52 bytes (13 words) of an \.{OFM} file contains thirteen
+32-bit integers that give the lengths of the various subsequent
+portions of the file.  The first word is 0 (future versions of
+\.{OFM} files could have different values;  what is important is that
+the first two bytes be 0 to differentiate \.{TFM} and \.{OFM} files).
+The next twelve integers are as above, all nonegative and less
+than~$2^{31}$.  We must have |bc-1<=ec<=65535|, and
+$$\hbox{|lf=13+lh+2*(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that an \.{OFM} font may contain as many as 65536 characters 
+(if |bc=0| and |ec=65535|), and as few as 0 characters (if |bc=ec+1|).
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays having the informal specification
+$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2}
+\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr
+header&|[0..lh-1]@t\\{stuff}@>|\cr
+char\_info&|[bc..ec]char_info_word|\cr
+width&|[0..nw-1]fix_word|\cr
+height&|[0..nh-1]fix_word|\cr
+depth&|[0..nd-1]fix_word|\cr
+italic&|[0..ni-1]fix_word|\cr
+lig\_kern&|[0..nl-1]lig_kern_command|\cr
+kern&|[0..nk-1]fix_word|\cr
+exten&|[0..ne-1]extensible_recipe|\cr
+param&|[1..np]fix_word|\cr}}$$
+The most important data type used here is a |@!fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+|header[0]| and |header[1]|, whose meaning is explained below.
+Additional header information of use to other software routines might
+also be included, but \TeX82 does not need to know about such details.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX text}' or `\.{TeX math symbols}'), the next five
+give the font identifier (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.'' The program that converts \.{DVI} files
+to Xerox printing format gets this information by looking at the \.{TFM}
+file, which it needs to read anyway because of other information that
+is not explicitly repeated in \.{DVI}~format.
+
+\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into
+the \.{DVI} output file. Later on when the \.{DVI} file is printed,
+possibly on another computer, the actual font that gets used is supposed
+to have a check sum that agrees with the one in the \.{TFM} file used by
+\TeX. In this way, users will be warned about potential incompatibilities.
+(However, if the check sum is zero in either the font file or the \.{TFM}
+file, no check is made.)  The actual relation between this check sum and
+the rest of the \.{TFM} file is not important; the check sum is simply an
+identification number with the property that incompatible fonts almost
+always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of
+the font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font
+`\.{at} $\delta$ \.{pt}', the effect is to override the design size
+and replace it by $\delta$, and to multiply the $x$ and~$y$ coordinates
+of the points in the font image by a factor of $\delta$ divided by the
+design size.  {\sl All other dimensions in the\/ \.{TFM} file are
+|fix_word|\kern-1pt\ numbers in design-size units}, with the exception of
+|param[1]| (which denotes the slant ratio). Thus, for example, the value
+of |param[6]|, which defines the \.{em} unit, is often the |fix_word| value
+$2^{20}=1.0$, since many fonts have a design size equal to one em.
+The other dimensions must be less than 16 design-size units in absolute
+value; thus, |header[1]| and |param[1]| are the only |fix_word|
+entries in the whole \.{TFM} file whose first byte might be something
+besides 0 or 255.
+
+@ Next comes the |char_info| array, which contains one |@!char_info_word|
+per character. Each word in this part of a \.{TFM} file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: |@!width_index| (8 bits)\par
+\hang second byte: |@!height_index| (4 bits) times 16, plus |@!depth_index|
+  (4~bits)\par
+\hang third byte: |@!italic_index| (6 bits) times 4, plus |@!tag|
+  (2~bits)\par
+\hang fourth byte: |@!remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+For \.{OFM} files, two words (eight bytes) are used. 
+The arrangement is as follows.
+
+\yskip\hang first and second bytes: |@!width_index| (16 bits)\par
+\hang third byte: |@!height_index| (8 bits)\par
+\hang fourth byte: |@!depth_index| (8~bits)\par
+\hang fifth and sixth bytes: 
+|@!italic_index| (14 bits) times 4, plus |@!tag| (2~bits)\par
+\hang seventh and eighth bytes: |@!remainder| (16 bits)\par
+\yskip\noindent
+Therefore the \.{OFM} format imposes a limit of 256 different heights,
+256 different depths, and 16384 different italic corrections.
+
+@!@^italic correction@>
+The italic correction of a character has two different uses.
+(a)~In ordinary text, the italic correction is added to the width only if
+the \TeX\ user specifies `\.{\\/}' after the character.
+(b)~In math formulas, the italic correction is always added to the width,
+except with respect to the positioning of subscripts.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero.  The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+*/
+
+                                                 /*
+@ \TeX\ checks the information of a \.{TFM} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_font_info|. It has four parameters: the user font
+identifier~|u|, the file name and area strings |nom| and |aire|, and the
+``at'' size~|s|. If |s|~is negative, it's the negative of a scale factor
+to be applied to the design size; |s=-1000| is the normal case.
+Otherwise |s| will be substituted for the design size; in this
+case, |s| must be positive and less than $2048\rm\,pt$
+(i.e., it must be less than $2^{27}$ when considered as an integer).
+
+The subroutine opens and closes a global file variable called |tfm_file|.
+It returns the value of the internal font number that was just loaded.
+If an error is detected, an error message is issued and no font
+information is stored; |null_font| is returned in this case.
+
+@d bad_tfm=11 {label for |read_font_info|}
+@d abort==goto bad_tfm {do this when the \.{TFM} data is wrong}
+
+*/
+
+/* 
+The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hangg|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hangg|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at position |remainder| in the |lig_kern| array.\par
+\hangg|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain.  The
+|remainder| field gives the character code of the next larger character.\par
+\hangg|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|@!exten[remainder]|.\par
+\yskip\noindent
+Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
+unless they are used in special circumstances in math formulas. For example,
+the \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
+operation looks for both |list_tag| and |ext_tag|.
+*/
+
+/* The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array,
+in a \.{TFM} file, is a |@!lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+  step if the byte is 128 or more, otherwise the next step is obtained by
+  skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+  then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+  a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In an \.{OFM} file, eight bytes are used, two bytes for each field.
+
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255| in a \.{TFM} file, |<=65535| in an \.{OFM} file.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
+the condition
+$$\hbox{|256*op_byte+remainder<nl|.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+or kerning command is performed.
+*/
+
+/*
+ Extensible characters are specified by an |@!extensible_recipe|, which
+consists of four bytes in a \.{TFM} file, 
+called |@!top|, |@!mid|, |@!bot|, and |@!rep| (in this order). 
+In an \.{OFM} file, each field takes two bytes, for eight in total.
+These bytes are the character codes of individual pieces used to
+build up a large symbol.  If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+*/
+
+/*
+The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it's the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character |" "| in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero. Fonts used for math symbols are required to have
+additional parameter information, which is explained later.
+*/
+
+/*
+ There are programs called \.{TFtoPL} and \.{PLtoTF} that convert
+ between the \.{TFM} format and a symbolic property-list format
+ that can be easily edited. These programs contain extensive
+ diagnostic information, so \TeX\ does not have to bother giving
+ precise details about why it rejects a particular \.{TFM} file.
+
+*/
+
+#define tfm_abort { font_tables[f]->_font_name = NULL; 			\
+                    font_tables[f]->_font_area = NULL; 			\
+                    xfree(tfm_buffer); xfree(kerns);			\
+		    xfree(widths);  xfree(heights);  xfree(depths);     \
+		    xfree(italics);  xfree(extens);  xfree(lig_kerns);	\
+		    xfree(xligs);  xfree(xkerns);						\
+			return 0; }
+
+#define tfm_success { xfree(tfm_buffer); xfree(kerns); 			 \
+         	      xfree(widths);  xfree(heights);  xfree(depths);    \
+		      xfree(italics);  xfree(extens);  xfree(lig_kerns); \
+		      xfree(xligs);  xfree(xkerns); return 1; }
+
+
+int
+open_tfm_file(char *nom, char *aire, unsigned char **tfm_buf, integer *tfm_siz) {
+  boolean res; /* was the callback successful? */
+  boolean opened; /* was |tfm_file| successfully opened?*/
+  integer callback_id;
+  FILE *tfm_file;
+  /* packfilename(nom,aire,getnullstr()); */
+  if(nameoffile != NULL)
+    xfree(nameoffile);
+  nameoffile = malloc(strlen(nom)+2);
+  strcpy(stringcast(nameoffile+1),nom);
+  namelength = strlen(nom);
+  callback_id=callback_defined(read_font_file_callback);
+  if (callback_id>0) {
+        res = run_callback(callback_id,"S->bSd",stringcast(nameoffile+1),
+                                          &opened, tfm_buf, tfm_siz);
+        if (res && opened && (*tfm_siz>0)) {
+          return 1;
+	}
+        if (!opened)
+          return -1;
+  } else {
+    if (ofm_open_in(tfm_file)) {
+      res = read_tfm_file(tfm_file,tfm_buf,tfm_siz);
+      b_close(tfm_file);
+      if (res) {
+	return 1;
+      }
+    } else {
+      return -1;
+    }
+  }
+  return 0;
+}
+
+
+/*
+  Note: A malformed \.{TFM} file might be shorter than it claims to be;
+  thus |eof(tfm_file)| might be true when |read_font_info| refers to
+  |tfm_file^| or when it says |get(tfm_file)|. If such circumstances
+  cause system error messages, you will have to defeat them somehow,
+  for example by defining |fget| to be `\ignorespaces|begin get(tfm_file);|
+  |if eof(tfm_file) then abort; end|\unskip'.
+  @^system dependencies@>
+*/
+
+#define fget  tfm_byte++
+#define fbyte tfm_buffer[tfm_byte]
+
+#define read_sixteen(a)                                                 \
+  { a=tfm_buffer[tfm_byte++];                                           \
+    if (a>127) { tfm_abort; }                                               \
+    a=(a*256)+tfm_buffer[tfm_byte]; }
+
+#define read_sixteen_unsigned(a)                                        \
+  { a=tfm_buffer[tfm_byte++];                                           \
+    a=(a*256)+tfm_buffer[tfm_byte]; }
+
+#define read_thirtytwo(a)                                               \
+  { a=tfm_buffer[++tfm_byte];                                           \
+    if (a>127) { tfm_abort; }                                               \
+    a=(a*256)+tfm_buffer[++tfm_byte];                                   \
+    a=(a*256)+tfm_buffer[++tfm_byte];                                   \
+    a=(a*256)+tfm_buffer[++tfm_byte]; }
+
+#define store_four_bytes(z)                                             \
+  { a=tfm_buffer[++tfm_byte];						\
+    a=(a*256)+tfm_buffer[++tfm_byte];					\
+    a=(a*256)+tfm_buffer[++tfm_byte];					\
+    a=(a*256)+tfm_buffer[++tfm_byte];					\
+    z = a; }
+
+#define store_char_info(z)                                              \
+  { if (font_level!=-1) {                                               \
+      fget; read_sixteen_unsigned(a);					\
+      ci._width_index=a;						\
+      fget; read_sixteen_unsigned(b);					\
+      ci._height_index=b>>8;						\
+      ci._depth_index=b%256;						\
+      fget; read_sixteen_unsigned(c);					\
+      ci._italic_index=c>>8;						\
+      ci._tag=c%4;							\
+      fget; read_sixteen_unsigned(d);					\
+      ci._remainder=d;							\
+    } else {                                                            \
+      a=tfm_buffer[++tfm_byte];						\
+      ci._width_index=a;						\
+      b=tfm_buffer[++tfm_byte];						\
+      ci._height_index=b>>4;						\
+      ci._depth_index=b%16;						\
+      c=tfm_buffer[++tfm_byte];						\
+      ci._italic_index=c>>2;						\
+      ci._tag=c%4;							\
+      d=tfm_buffer[++tfm_byte];						\
+      ci._remainder=d;							\
+    } }
+
+#define read_four_quarters(q)						\
+  { if (font_level!=-1) {                                               \
+      fget; read_sixteen_unsigned(a); q.b0=a;				\
+      fget; read_sixteen_unsigned(b); q.b1=b;				\
+      fget; read_sixteen_unsigned(c); q.b2=c;				\
+      fget; read_sixteen_unsigned(d); q.b3=d;				\
+    } else {                                                            \
+      a=tfm_buffer[++tfm_byte]; q.b0=a;					\
+      b=tfm_buffer[++tfm_byte]; q.b1=b;					\
+      c=tfm_buffer[++tfm_byte]; q.b2=c;					\
+      d=tfm_buffer[++tfm_byte]; q.b3=d;                                \
+    } }
+
+#define check_byte_range(z)  { if ((z<bc)||(z>ec)) tfm_abort ; }
+
+
+/* A |fix_word| whose four bytes are $(a,b,c,d)$ from left to right represents
+   the number
+   $$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+   b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+   -16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+   (No other choices of |a| are allowed, since the magnitude of a number in
+   design-size units must be less than 16.)  We want to multiply this
+   quantity by the integer~|z|, which is known to be less than $2^{27}$.
+   If $|z|<2^{23}$, the individual multiplications $b\cdot z$,
+   $c\cdot z$, $d\cdot z$ cannot overflow; otherwise we will divide |z| by 2,
+   4, 8, or 16, to obtain a multiplier less than $2^{23}$, and we can
+   compensate for this later. If |z| has thereby been replaced by
+   $|z|^\prime=|z|/2^e$, let $\beta=2^{4-e}$; we shall compute
+   $$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$
+   if $a=0$, or the same quantity minus $\alpha=2^{4+e}z^\prime$ if $a=255$.
+   This calculation must be done exactly, in order to guarantee portability
+   of \TeX\ between computers.
+*/
+
+#define store_scaled(zz)						\
+  { fget; a=fbyte; fget; b=fbyte;                                       \
+    fget; c=fbyte; fget; d=fbyte;                                       \
+    sw=(((((d*z)>>8)+(c*z))>>8)+(b*z)) / beta;                          \
+    if (a==0) { zz=sw; } else if (a==255) { zz=sw-alpha; } else tfm_abort;	\
+  }
+
+#define  check_existence(z)                                             \
+  { check_byte_range(z);                                                \
+    if (!char_exists(f,z)) tfm_abort;					\
+  }
+
+typedef struct tfmcharacterinfo {
+  integer _kern_index;  
+  integer _lig_index;   
+  integer _width_index; 
+  integer _height_index;
+  integer _depth_index; 
+  integer _italic_index;
+  integer _remainder;   
+  unsigned char _tag ;           
+} tfmcharacterinfo;
+
+extern charinfo *copy_charinfo(charinfo *ci);
+
+int 
+read_tfm_info(internalfontnumber f, char *cnom, char *caire, scaled s) {
+  integer k; /* index into |font_info| */
+  halfword lf,lh,bc,ec,nw,nh,nd,ni,nl,nk,ne,np,slh;  /* sizes of subfiles */
+  scaled *widths, *heights, *depths, *italics, *kerns;
+  halfword font_dir;
+  integer a,b,c,d; /* byte variables */
+  integer i; /* counter */
+  integer font_level,header_length;
+  integer nco,ncw,npc,nlw,neew;
+  tfmcharacterinfo ci;
+  charinfo *co;
+  four_quarters qw; 
+  four_quarters *lig_kerns, *extens;
+  scaled sw; /* accumulators */
+  integer bch_label; /* left boundary start location, or infinity */
+  int bchar; /* :0..too_big_char; */ /* right boundary character, or |too_big_char| */
+  integer first_two;
+  scaled z; /* the design size or the ``at'' size */
+  integer alpha; 
+  char beta; /* :1..16*/
+  integer *xligs, *xkerns; /* aux. for ligkern processing */
+  liginfo *cligs;
+  kerninfo *ckerns;
+  int fligs, fkerns;
+  char *tmpnam;
+  integer tfm_byte = 0; /* index into |tfm_buffer| */
+  integer saved_tfm_byte = 0; /* saved index into |tfm_buffer| */
+  unsigned char *tfm_buffer = NULL; /* byte buffer for tfm files */
+  integer tfm_size = 0; /* total size of the tfm file */
+  
+  widths=NULL;
+  heights=NULL;
+  depths = NULL;
+  italics = NULL;
+  kerns = NULL;
+  lig_kerns = NULL;
+  extens = NULL;
+  xkerns = NULL;
+  ckerns = NULL;
+  xligs = NULL;
+  cligs = NULL;
+
+  font_dir = 0;
+
+  memset(&ci,0,sizeof(tfmcharacterinfo));
+
+  if(open_tfm_file(cnom,caire,&tfm_buffer,&tfm_size)!=1)
+     tfm_abort;
+
+  /* cnom can be an absolute filename, xbasename() fixes that. */
+
+  tmpnam=strdup(xbasename(cnom));
+  if (strcmp(tmpnam+strlen(tmpnam)-4,".tfm")==0) {
+    *(tmpnam+strlen(tmpnam)-4) =0;
+  }
+  set_font_name(f,tmpnam);
+  set_font_area(f,xstrdup(caire)); /* perhaps it leaks, but it doesnt crash  */
+
+  /* @<Read the {\.{TFM}} size fields@>; */
+  nco=0; ncw=0; npc=0;
+  read_sixteen(first_two);
+  if (first_two!=0) {
+    font_level=-1;
+    lf=first_two;
+    fget; read_sixteen(lh);
+    fget; read_sixteen(bc);
+    fget; read_sixteen(ec);
+    if ((bc>ec+1)||(ec>255))  tfm_abort;
+    if (bc>255) { /* |bc=256| and |ec=255| */
+      bc=1; ec=0;
+    };
+    fget; read_sixteen(nw);
+    fget; read_sixteen(nh);
+    fget; read_sixteen(nd);
+    fget; read_sixteen(ni);
+    fget; read_sixteen(nl);
+    fget; read_sixteen(nk);
+    fget; read_sixteen(ne);
+    fget; read_sixteen(np);
+    header_length=6;
+    ncw=(ec-bc+1);
+    nlw=nl;
+    neew=ne;
+  } else {
+    fget; read_sixteen(font_level);
+    if (font_level!=0) tfm_abort;
+    read_thirtytwo(lf);
+    read_thirtytwo(lh);
+    read_thirtytwo(bc);
+    read_thirtytwo(ec);
+    if ((bc>ec+1)||(ec>65535))  tfm_abort;
+    if (bc>65535) { /* |bc=65536| and |ec=65535| */
+      bc=1; ec=0;
+    };
+    read_thirtytwo(nw);
+    read_thirtytwo(nh);
+    read_thirtytwo(nd);
+    read_thirtytwo(ni);
+    read_thirtytwo(nl);
+    read_thirtytwo(nk);
+    read_thirtytwo(ne);
+    read_thirtytwo(np);
+    read_thirtytwo(font_dir); /* junk */
+    nlw=2*nl;
+    neew=2*ne;
+    header_length=14;
+    ncw=2*(ec-bc+1);
+  };
+  if (lf!=(header_length+lh+ncw+nw+nh+nd+ni+nlw+nk+neew+np)) tfm_abort;
+
+  /* @<Use size fields to allocate font information@>; */
+
+  set_font_natural_dir(f,font_dir);
+  set_font_bc(f,bc); 
+  set_font_ec(f,ec); 
+
+  /* read the arrays first */
+  widths    = xmalloc(nw*sizeof(scaled));
+  heights   = xmalloc(nh*sizeof(scaled));
+  depths    = xmalloc(nd*sizeof(scaled));
+  italics   = xmalloc(ni*sizeof(scaled));
+  extens    = xmalloc(ne*sizeof(four_quarters));
+  lig_kerns = xmalloc(nl*sizeof(four_quarters));
+  kerns     = xmalloc(nk*sizeof(scaled));
+
+  /* @<Read the {\.{TFM}} header@>; */
+
+  /* Only the first two words of the header are needed by \TeX82. */
+  slh = lh;
+  if (lh<2) 
+    tfm_abort;
+  store_four_bytes(font_checksum(f));
+  fget; read_sixteen(z); /* this rejects a negative design size */
+  fget; z=z*256+fbyte; fget; z=(z*16)+(fbyte>>4);
+  if (z<unity) tfm_abort;
+  while (lh>2) {
+    fget;fget;fget;fget;
+    lh--; /* ignore the rest of the header */
+  };
+
+  /* read the arrays before the character info */
+
+  set_font_dsize(f,z);
+  if (s!=-1000) {
+    z = (s>=0 ? s : xn_over_d(z,-s,1000));
+  }
+  set_font_size(f,z);
+
+  if (np>7)
+    set_font_params(f,np);
+
+  saved_tfm_byte = tfm_byte;
+  tfm_byte = (header_length+slh+ncw)*4 - 1;
+
+  /* @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>; */
+
+  alpha=16;
+  while (z>=040000000) {
+    z=z>>1; alpha=alpha+alpha;
+  };
+  beta=256/alpha; alpha=alpha*z;
+
+  /* @<Read box dimensions@>; */
+
+  for (k=0;k<nw;k++) { 
+    store_scaled(sw); widths[k] = sw;  
+  }
+  if (widths[0]!=0) /* \\{width}[0] must be zero */
+    tfm_abort; 
+  for (k=0;k<nh;k++) {
+    store_scaled(sw); heights[k] = sw;  
+  }
+  if (heights[0]!=0) 
+    tfm_abort; /* \\{height}[0] must be zero */
+  for (k=0;k<nd;k++) { 
+    store_scaled(sw); depths[k] = sw;  
+  }
+  if (depths[0]!=0)  
+    tfm_abort; /* \\{depth}[0] must be zero */
+  for (k=0;k<ni;k++) { 
+    store_scaled(sw); italics[k] = sw;  
+  }
+  if (italics[0]!=0) 
+    tfm_abort; /* \\{italic}[0] must be zero */
+  
+
+  /* @<Read ligature/kern program@>; */
+  
+  bch_label=nl; /* infinity*/ 
+  bchar=65536;
+  if (nl>0) {
+    for (k=0;k<nl;k++) { 
+      read_four_quarters(qw);
+      lig_kerns[k] = qw;
+      if (a>128) { 
+        if (256*c+d>=nl)  tfm_abort;
+        if (a==255 && k==0) bchar=b;
+      } else { 
+        /* if (b!=bchar) check_existence(b); */
+        if (c<128) { 
+          /* check_existence(d); */ /* check ligature */
+        } else if (256*(c-128)+d>=nk) {
+          tfm_abort; /* check kern */
+        }
+        if ((a<128) && (k-0+a+1>=nl)) tfm_abort;
+      };
+    };
+    if (a==255) bch_label=256*c+d;
+  };
+
+  /* the actual kerns */
+  for (k=0;k<nk;k++) {
+    store_scaled(sw);  kerns[k] = sw;
+  }
+
+  /* @<Read extensible character recipes@>; */
+  for (k=0;k<ne;k++) {
+    read_four_quarters(qw);  extens[k] = qw;
+  }
+
+  /* @<Read font parameters@>; */
+
+  if (np>7) {
+    set_font_params(f,np);
+  }
+  for (k=1;k<=np;k++) {
+    if (k==1) { /* the |slant| parameter is a pure number */
+      fget; sw=fbyte; 
+      if (sw>127) sw=sw-256;
+      fget; sw=sw*256+fbyte;
+      fget; sw=sw*256+fbyte;
+      fget; sw=(sw*16)+(fbyte>>4);
+      set_font_param(f,k,sw);
+    } else {
+      store_scaled(font_param(f,k));
+    }
+  }
+
+  /* 
+     We check to see that the \.{TFM} file doesn't end prematurely; but
+     no error message is given for files having more than |lf| words.
+  */
+
+  if (tfm_byte<tfm_size-1) tfm_abort;
+
+  tfm_byte = saved_tfm_byte ;
+
+  /* fix up the left boundary character */
+  fligs = 0;
+  fkerns = 0;
+  if (bch_label != nl ) {
+    k = bch_label;
+    /*
+    if (skip_byte(k) > stop_flag)
+      k = lig_kern_restart(k);
+    */
+    while (1) {
+      if (skip_byte(k) <= stop_flag) {
+	if(op_byte(k) >= kern_flag) {	 /* kern */
+	  fkerns++;
+	} else {  /* lig */
+	  fligs++;
+	}
+      }
+      if (skip_byte(k) == 0) {
+	k++;
+      } else {
+	if (skip_byte(k) >= stop_flag) 
+	  break;
+	k += skip_byte(k) + 1;
+      }
+    }
+  }
+  if (fkerns >0 || fligs > 0) {
+    if (fligs>0)	cligs  = xcalloc((fligs+1),sizeof(liginfo));
+    if (fkerns>0)	ckerns = xcalloc((fkerns+1),sizeof(kerninfo));
+    fligs = 0;
+    fkerns = 0;
+    k = bch_label;
+    /*
+    if (skip_byte(k) > stop_flag)
+      k = lig_kern_restart(k);
+    */
+    while (1) {
+      if (skip_byte(k) <= stop_flag) {
+	if(op_byte(k) >= kern_flag) {  /* kern */
+	  set_kern_item(ckerns[fkerns],next_char(k),kerns[256*(op_byte(k)-128)+rem_byte(k)]);
+	  fkerns++;
+	} else {  /* lig */
+	  set_ligature_item(cligs[fligs],(op_byte(k)*2+1),next_char(k),rem_byte(k));
+	  fligs++;
+	}
+      }
+      if (skip_byte(k) == 0) {
+	k++;
+      } else {
+	if (skip_byte(k) >= stop_flag) 
+	  break;
+	k += skip_byte(k) + 1;
+      }
+    }
+    if (fkerns>0 || fligs>0){
+      co = get_charinfo(f,left_boundarychar);
+      if (fkerns>0) {
+	set_kern_item(ckerns[fkerns],end_kern,0);
+	fkerns++;
+	set_charinfo_kerns(co,ckerns);
+      }
+      if (fligs>0){
+	set_ligature_item(cligs[fligs],0,end_ligature,0);
+	fligs++;
+	set_charinfo_ligatures(co,cligs);
+      }
+      set_charinfo_remainder(co,0); 
+    }
+  }
+
+  /* @<Read character data@>; */
+  for (k=bc;k<=ec;k++) {
+    store_char_info(k);
+    if (ci._width_index==0)
+      continue;
+    if (ci._width_index>=nw||ci._height_index>=nh||
+		ci._depth_index>=nd||ci._italic_index>=ni) tfm_abort;
+    d = ci._remainder;
+    switch (ci._tag) {
+    case lig_tag: if (d>=nl) tfm_abort; break;
+    case ext_tag: if (d>=ne) tfm_abort; break;
+    case list_tag: 
+      /* We want to make sure that there is no cycle of characters linked together
+         by |list_tag| entries, since such a cycle would get \TeX\ into an endless
+         loop. If such a cycle exists, the routine here detects it when processing
+         the largest character code in the cycle.
+      */
+      check_byte_range(d);
+      while (d<k) {   /* current_character == k */
+	if (char_tag(f,d)!=list_tag) 
+	  goto NOT_FOUND; /* not a cycle */
+	d=char_remainder(f,d); /* next character on the list */
+      };
+      if (d==k) tfm_abort; /* yes, there's a cycle */
+    NOT_FOUND:
+      break;
+    }
+    /* put it in the actual font */
+    co = get_charinfo(f,k);
+    set_charinfo_index     (co,k);
+    set_charinfo_tag       (co,ci._tag);
+    if (ci._tag == ext_tag) {
+      set_charinfo_extensible(co,
+			      extens[ci._remainder].b0, /* top */
+			      extens[ci._remainder].b2, /* bot */
+			      extens[ci._remainder].b1, /* mid */
+			      extens[ci._remainder].b3); /* rep */
+      set_charinfo_remainder (co,0);
+    } else {
+      set_charinfo_remainder (co,ci._remainder);
+    }
+    set_charinfo_width     (co,widths[ci._width_index]);
+    set_charinfo_height    (co,heights[ci._height_index]);
+    set_charinfo_depth     (co,depths[ci._depth_index]);
+    set_charinfo_italic    (co,italics[ci._italic_index]);
+  };
+  
+  /* first pass: count ligs and kerns */
+  
+  xligs  = xcalloc((ec+1),sizeof(integer));
+  xkerns = xcalloc((ec+1),sizeof(integer));
+
+  for (i=bc;i<=ec;i++) {
+    if (char_tag(f,i) == lig_tag) {
+      k = lig_kern_start(f,i);
+      if (skip_byte(k) > stop_flag)
+	k = lig_kern_restart(k);
+      /* now k is the start index */
+      while (1) {
+	if (skip_byte(k) <= stop_flag) {
+	  if(op_byte(k) >= kern_flag) {	 /* kern */
+	    xkerns[i]++;
+	    if (next_char(k) == bchar)
+	      xkerns[i]++;
+	  } else {  /* lig */
+	    xligs[i]++;
+	    if (next_char(k) == bchar)
+	      xligs[i]++;
+	  }
+	}
+	if (skip_byte(k) == 0) {
+	  k++;
+	} else {
+	  if (skip_byte(k) >= stop_flag) 
+	    break;
+	  k += skip_byte(k) + 1;
+	}
+      }
+    }
+  }
+ 
+  cligs = NULL;
+  ckerns = NULL;
+
+  for (i=bc;i<=ec;i++) {
+    fligs = 0;
+    fkerns = 0;
+    if (char_tag(f,i) == lig_tag) {
+      k = lig_kern_start(f,i);
+      if (skip_byte(k) > stop_flag)
+	k = lig_kern_restart(k);
+      /* now k is the start index */
+      if (xligs[i]>0)	cligs  = xcalloc((xligs[i]+1),sizeof(liginfo));
+      if (xkerns[i]>0)	ckerns = xcalloc((xkerns[i]+1),sizeof(kerninfo));
+      while (1) {
+	if (skip_byte(k) <= stop_flag) {
+	  if(op_byte(k) >= kern_flag) {  /* kern */
+	    if (next_char(k) == bchar) {
+	      set_kern_item(ckerns[fkerns],right_boundarychar,kerns[256*(op_byte(k)-128)+rem_byte(k)]);
+	      fkerns++;
+	    }
+	    set_kern_item(ckerns[fkerns],next_char(k),kerns[256*(op_byte(k)-128)+rem_byte(k)]);
+	    fkerns++;
+	  } else {  /* lig */
+	    if (next_char(k) == bchar) {
+	      set_ligature_item(cligs[fligs],(op_byte(k)*2+1),right_boundarychar,rem_byte(k));
+	      fligs++;
+	    }
+	    set_ligature_item(cligs[fligs],(op_byte(k)*2+1),next_char(k),rem_byte(k));
+	    fligs++;
+	  }
+	}
+	if (skip_byte(k) == 0) {
+	  k++;
+	} else {
+	  if (skip_byte(k) >= stop_flag) 
+	    break;
+	  k += skip_byte(k) + 1;
+	}
+      }
+      if (fkerns>0 || fligs>0){
+	co = get_charinfo(f,i);
+	if (fkerns>0) {
+	  set_kern_item(ckerns[fkerns],end_kern,0);
+	  fkerns++;
+	  set_charinfo_kerns(co,ckerns);
+	}
+	if (fligs>0){
+	  set_ligature_item(cligs[fligs],0,end_ligature,0);
+	  fligs++;
+	  set_charinfo_ligatures(co,cligs);
+	}
+	set_charinfo_remainder(co,0); 
+      }
+    }
+  }
+
+
+  /* @<Make final adjustments and |goto done|@> */
+
+  /* Now to wrap it up, we have checked all the necessary things about the \.{TFM}
+     file, and all we need to do is put the finishing touches on the data for
+     the new font.
+  */
+
+  if (bchar!= 65536) {
+    co = copy_charinfo(char_info(f,bchar));
+    set_right_boundary(f,co);
+  }
+
+  tfm_success;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/tounicode.c b/Build/source/texk/web2c/luatexdir/font/tounicode.c
new file mode 100644
index 00000000000..ff86a8512e2
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tounicode.c
@@ -0,0 +1,604 @@
+/*
+Copyright (c) 2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include "ptexlib.h"
+
+#define isXdigit(c) (isdigit(c) || ('A' <= (c) && (c) <= 'F'))
+#define UNI_UNDEF          -1
+#define UNI_STRING         -2   /* string allocated by def_tounicode() */
+#define UNI_EXTRA_STRING   -3   /* string allocated by set_glyph_unicode() */
+
+static struct avl_table *glyph_unicode_tree = NULL;
+
+static int comp_glyph_unicode_entry(const void *pa, const void *pb, void *p)
+{
+    return strcmp(((const glyph_unicode_entry *) pa)->name,
+                  ((const glyph_unicode_entry *) pb)->name);
+}
+
+static glyph_unicode_entry *new_glyph_unicode_entry(void)
+{
+    glyph_unicode_entry *e;
+    e = xtalloc(1, glyph_unicode_entry);
+    e->name = NULL;
+    e->code = UNI_UNDEF;
+    e->unicode_seq = NULL;
+    return e;
+}
+
+static void destroy_glyph_unicode_entry(void *pa, void *pb)
+{
+    glyph_unicode_entry *e = (glyph_unicode_entry *) pa;
+    xfree(e->name);
+    if (e->code == UNI_STRING) {
+        assert(e->unicode_seq != NULL);
+        xfree(e->unicode_seq);
+    }
+}
+
+void glyph_unicode_free(void)
+{
+    if (glyph_unicode_tree != NULL)
+        avl_destroy(glyph_unicode_tree, destroy_glyph_unicode_entry);
+}
+
+void def_tounicode(strnumber glyph, strnumber unistr)
+{
+    char buf[SMALL_BUF_SIZE], *p;
+    char buf2[SMALL_BUF_SIZE], *q;
+    int valid_unistr;           /* 0: invalid; 1: unicode value; 2: string */
+    int i, l;
+    glyph_unicode_entry *gu, t;
+    void **aa;
+
+    p = makecstring(glyph);
+    assert(strlen(p) < SMALL_BUF_SIZE);
+    strcpy(buf, p);             /* copy the result to buf before next call of makecstring() */
+    p = makecstring(unistr);
+    while (*p == ' ')
+        p++;                    /* ignore leading spaces */
+    l = strlen(p);
+    while (l > 0 && p[l - 1] == ' ')
+        l--;                    /* ignore traling spaces */
+    valid_unistr = 1;           /* a unicode value is the most common case */
+    for (i = 0; i < l; i++) {
+        if (p[i] == ' ')
+            valid_unistr = 2;   /* if a space occurs we treat this entry as a string */
+        else if (!isXdigit(p[i])) {
+            valid_unistr = 0;
+            break;
+        }
+    }
+    if (l == 0 || valid_unistr == 0 || strlen(buf) == 0
+        || strcmp(buf, notdef) == 0) {
+        pdftex_warn("ToUnicode: invalid parameter(s): `%s' => `%s'", buf, p);
+        return;
+    }
+    if (glyph_unicode_tree == NULL) {
+        glyph_unicode_tree =
+            avl_create(comp_glyph_unicode_entry, NULL, &avl_xallocator);
+        assert(glyph_unicode_tree != NULL);
+    }
+    t.name = buf;
+    /* allow overriding existing entries */
+    if ((gu = (glyph_unicode_entry *) avl_find(glyph_unicode_tree, &t)) != NULL) {
+        if (gu->code == UNI_STRING) {
+            assert(gu->unicode_seq != NULL);
+            xfree(gu->unicode_seq);
+        }
+    } else {                    /* make new entry */
+        gu = new_glyph_unicode_entry();
+        gu->name = xstrdup(buf);
+    }
+    if (valid_unistr == 2) {    /* a string with space(s) */
+        /* copy p to buf2, ignoring spaces */
+        for (q = buf2; *p != 0; p++)
+            if (*p != ' ')
+                *q++ = *p;
+        *q = 0;
+        gu->code = UNI_STRING;
+        gu->unicode_seq = xstrdup(buf2);
+    } else {
+        i = sscanf(p, "%lX", &(gu->code));
+        assert(i == 1);
+    }
+    aa = avl_probe(glyph_unicode_tree, gu);
+    assert(aa != NULL);
+}
+
+
+static long check_unicode_value(char *s, boolean multiple_value)
+{
+    int l = strlen(s);
+    int i;
+    long code;
+
+    if (l == 0)
+        return UNI_UNDEF;
+    if (multiple_value && l % 4 != 0)
+        return UNI_UNDEF;
+    if (!multiple_value && !(4 <= l && l <= 6))
+        return UNI_UNDEF;
+
+    for (i = 0; i < l; i++) {
+        if (!isXdigit(s[i]))
+            return UNI_UNDEF;
+        if (multiple_value) {
+            if (i % 4 == 3) {
+                if (sscanf(s + i - 3, "%4lX", &code) != 1)
+                    return UNI_UNDEF;
+                if (!((0x0000 <= code && code <= 0xD7FF) ||
+                      (0xE000 <= code && code <= 0xFFFF)))
+                    return UNI_UNDEF;
+            }
+        } else {                /* single value */
+            if (i == l - 1) {
+                if (sscanf(s, "%lX", &code) != 1)
+                    return UNI_UNDEF;
+                if (!((0x0000 <= code && code <= 0xD7FF) ||
+                      (0xE000 <= code && code <= 0x10FFFF)))
+                    return UNI_UNDEF;
+            }
+        }
+    }
+    return code;
+}
+
+static char *utf16be_str(long code)
+{
+    static char buf[SMALL_BUF_SIZE];
+    long v;
+    unsigned vh, vl;
+
+    assert(code >= 0);
+
+    if (code <= 0xFFFF)
+        sprintf(buf, "%04lX", code);
+    else {
+        v = code - 0x10000;
+        vh = v / 0x400 + 0xD800;
+        vl = v % 0x400 + 0xDC00;
+        sprintf(buf, "%04X%04X", vh, vl);
+    }
+    return buf;
+}
+
+
+/* this function set proper values to *gp based on s; in case it returns
+ * gp->code == UNI_EXTRA_STRING then the caller is responsible for freeing
+ * gp->unicode_seq too */
+static void set_glyph_unicode(char *s, glyph_unicode_entry * gp)
+{
+    char buf[SMALL_BUF_SIZE], buf2[SMALL_BUF_SIZE], *p;
+    long code;
+    boolean last_component;
+    glyph_unicode_entry tmp, *ptmp;
+
+    /* skip dummy entries */
+    if (s == NULL || s == notdef)
+        return;
+
+    /* strip everything after the first dot */
+    p = strchr(s, '.');
+    if (p != NULL) {
+        *buf = 0;
+        strncat(buf, s, p - s);
+        s = buf;
+    }
+
+    if (strlen(s) == 0)
+        return;
+
+    /* check for case of multiple components separated by '_' */
+    p = strchr(s, '_');
+    if (p != NULL) {
+        assert(strlen(s) < sizeof(buf));
+        if (s != buf) {
+            strcpy(buf, s);
+            p = strchr(buf, '_');
+            s = buf;
+        }
+        *buf2 = 0;
+        last_component = false;
+        for (;;) {
+            *p = 0;
+            tmp.code = UNI_UNDEF;
+            set_glyph_unicode(s, &tmp);
+            switch (tmp.code) {
+            case UNI_UNDEF:    /* not found, do nothing */
+                break;
+            case UNI_STRING:   /* s matched an entry with string value in the database */
+                assert(tmp.unicode_seq != NULL);
+                assert(strlen(buf2) + strlen(tmp.unicode_seq) < sizeof(buf2));
+                strcat(buf2, tmp.unicode_seq);
+                break;
+            case UNI_EXTRA_STRING:     /* s is a multiple value of form "uniXXXX" */
+                assert(strlen(buf2) + strlen(tmp.unicode_seq) < sizeof(buf2));
+                strcat(buf2, tmp.unicode_seq);
+                xfree(tmp.unicode_seq);
+                break;
+            default:           /* s matched an entry with numeric value in the
+                                   database, or a value derived from "uXXXX" */
+                assert(tmp.code >= 0);
+                strcat(buf2, utf16be_str(tmp.code));
+            }
+            if (last_component)
+                break;
+            s = p + 1;
+            p = strchr(s, '_');
+            if (p == NULL) {
+                p = strend(s);
+                last_component = true;
+            }
+        }
+        gp->code = UNI_EXTRA_STRING;
+        gp->unicode_seq = xstrdup(buf2);
+        return;
+    }
+
+    /* lookup for glyph name in the database */
+    tmp.name = s;
+    tmp.code = UNI_UNDEF;
+    ptmp = (glyph_unicode_entry *) avl_find(glyph_unicode_tree, &tmp);
+    if (ptmp != NULL) {
+        gp->code = ptmp->code;
+        gp->unicode_seq = ptmp->unicode_seq;
+        return;
+    }
+
+    /* check for case of "uniXXXX" (multiple 4-hex-digit values allowed) */
+    if (str_prefix(s, "uni")) {
+        p = s + strlen("uni");
+        code = check_unicode_value(p, true);
+        if (code != UNI_UNDEF) {
+            if (strlen(p) == 4) /* single value */
+                gp->code = code;
+            else {              /* multiple value */
+                gp->code = UNI_EXTRA_STRING;
+                gp->unicode_seq = xstrdup(p);
+            }
+        }
+        return;                 /* since the last case cannot happen */
+    }
+
+    /* check for case of "uXXXX" (single value up to 6 hex digits) */
+    if (str_prefix(s, "u")) {
+        p = s + strlen("u");
+        code = check_unicode_value(p, false);
+        if (code != UNI_UNDEF) {
+            assert(code >= 0);
+            gp->code = code;
+        }
+    }
+}
+
+static void set_cid_glyph_unicode(long index, glyph_unicode_entry * gp, 
+								  internal_font_number f) {
+  char *s;
+  if (font_tounicode(f)) {
+	if ((s = get_charinfo_tounicode(char_info(f,index)))!=NULL) {
+        gp->code = UNI_EXTRA_STRING;
+        gp->unicode_seq = xstrdup(s);
+	}
+  } else {
+	gp->code = index; /* fallback */
+  }
+}
+
+
+integer write_tounicode(char **glyph_names, char *name)
+{
+    char buf[SMALL_BUF_SIZE], *p;
+    static char builtin_suffix[] = "-builtin";
+    short range_size[257];
+    glyph_unicode_entry gtab[257];
+    integer objnum;
+    int i, j;
+    int bfchar_count, bfrange_count, subrange_count;
+    assert(strlen(name) + strlen(builtin_suffix) < SMALL_BUF_SIZE);
+    if (glyph_unicode_tree == NULL) {
+        pdftex_warn("no GlyphToUnicode entry has been inserted yet!");
+        fixed_gen_tounicode = 0;
+        return 0;
+    }
+    strcpy(buf, name);
+    if ((p = strrchr(buf, '.')) != NULL && strcmp(p, ".enc") == 0)
+        *p = 0;                 /* strip ".enc" from encoding name */
+    else
+        strcat(buf, builtin_suffix);    /* ".enc" not present, this is a builtin
+                                           encoding so the name is eg "cmr10-builtin" */
+    objnum = pdf_new_objnum();
+    pdf_begin_dict(objnum, 0);
+    pdf_begin_stream();
+    pdf_printf("%%!PS-Adobe-3.0 Resource-CMap\n"
+               "%%%%DocumentNeededResources: ProcSet (CIDInit)\n"
+               "%%%%IncludeResource: ProcSet (CIDInit)\n"
+               "%%%%BeginResource: CMap (TeX-%s-0)\n"
+               "%%%%Title: (TeX-%s-0 TeX %s 0)\n"
+               "%%%%Version: 1.000\n"
+               "%%%%EndComments\n"
+               "/CIDInit /ProcSet findresource begin\n"
+               "12 dict begin\n"
+               "begincmap\n"
+               "/CIDSystemInfo\n"
+               "<< /Registry (TeX)\n"
+               "/Ordering (%s)\n"
+               "/Supplement 0\n"
+               ">> def\n"
+               "/CMapName /TeX-%s-0 def\n"
+               "/CMapType 2 def\n"
+               "1 begincodespacerange\n"
+               "<00> <FF>\n" "endcodespacerange\n", buf, buf, buf, buf, buf);
+
+    /* set gtab */
+    for (i = 0; i < 256; ++i) {
+        gtab[i].code = UNI_UNDEF;
+        set_glyph_unicode(glyph_names[i], &gtab[i]);
+    }
+    gtab[256].code = UNI_UNDEF;
+
+    /* set range_size */
+    for (i = 0; i < 256;) {
+        if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
+            range_size[i] = 1;  /* single entry */
+            i++;
+        } else if (gtab[i].code == UNI_UNDEF) {
+            range_size[i] = 0;  /* no entry */
+            i++;
+        } else {                /* gtab[i].code >= 0 */
+            j = i;
+            while (i < 256 && gtab[i + 1].code >= 0 &&
+                   gtab[i].code + 1 == gtab[i + 1].code)
+                i++;
+            /* at this point i is the last entry of the subrange */
+            i++;                /* move i to the next entry */
+            range_size[j] = i - j;
+        }
+    }
+
+    /* calculate bfrange_count and bfchar_count */
+    bfrange_count = 0;
+    bfchar_count = 0;
+    for (i = 0; i < 256;) {
+        if (range_size[i] == 1) {
+            bfchar_count++;
+            i++;
+        } else if (range_size[i] > 1) {
+            bfrange_count++;
+            i += range_size[i];
+        } else
+            i++;
+    }
+
+    /* write out bfrange */
+    i = 0;
+  write_bfrange:
+    if (bfrange_count > 100)
+        subrange_count = 100;
+    else
+        subrange_count = bfrange_count;
+    bfrange_count -= subrange_count;
+    pdf_printf("%i beginbfrange\n", subrange_count);
+    for (j = 0; j < subrange_count; j++) {
+        while (range_size[i] <= 1 && i < 256)
+            i++;
+        assert(i < 256);
+        pdf_printf("<%02X> <%02X> <%s>\n", i, i + range_size[i] - 1,
+                   utf16be_str(gtab[i].code));
+        i += range_size[i];
+    }
+    pdf_printf("endbfrange\n");
+    if (bfrange_count > 0)
+        goto write_bfrange;
+
+    /* write out bfchar */
+    i = 0;
+  write_bfchar:
+    if (bfchar_count > 100)
+        subrange_count = 100;
+    else
+        subrange_count = bfchar_count;
+    bfchar_count -= subrange_count;
+    pdf_printf("%i beginbfchar\n", subrange_count);
+    for (j = 0; j < subrange_count; j++) {
+        while (i < 256) {
+            if (range_size[i] > 1)
+                i += range_size[i];
+            else if (range_size[i] == 0)
+                i++;
+            else                /* range_size[i] == 1 */
+                break;
+        }
+        assert(i < 256 && gtab[i].code != UNI_UNDEF);
+        if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
+            assert(gtab[i].unicode_seq != NULL);
+            pdf_printf("<%02X> <%s>\n", i, gtab[i].unicode_seq);
+        } else
+            pdf_printf("<%02X> <%s>\n", i, utf16be_str(gtab[i].code));
+        i++;
+    }
+    pdf_printf("endbfchar\n");
+    if (bfchar_count > 0)
+        goto write_bfchar;
+
+    /* free strings allocated by set_glyph_unicode() */
+    for (i = 0; i < 256; ++i) {
+        if (gtab[i].code == UNI_EXTRA_STRING)
+            xfree(gtab[i].unicode_seq);
+    }
+
+    pdf_printf("endcmap\n"
+               "CMapName currentdict /CMap defineresource pop\n"
+               "end\n" "end\n" "%%%%EndResource\n" "%%%%EOF\n");
+    pdf_end_stream();
+    return objnum;
+}
+
+integer write_cid_tounicode(fo_entry * fo, internalfontnumber f) {
+
+    int range_size[65537];
+    glyph_unicode_entry gtab[65537];
+    integer objnum;
+    int i, j, k;
+    int bfchar_count, bfrange_count, subrange_count;
+	char *buf;
+
+	assert(fo->fd->fontname);
+	buf = xmalloc(strlen(fo->fd->fontname)+8);
+	sprintf(buf,"%s-%s",(fo->fd->subset_tag!=NULL ? fo->fd->subset_tag : "UCS"),
+			            fo->fd->fontname);
+
+    objnum = pdf_new_objnum();
+    pdf_begin_dict(objnum, 0);
+    pdf_begin_stream();
+    pdf_printf("%%!PS-Adobe-3.0 Resource-CMap\n"
+               "%%%%DocumentNeededResources: ProcSet (CIDInit)\n"
+               "%%%%IncludeResource: ProcSet (CIDInit)\n"
+               "%%%%BeginResource: CMap (TeX-%s-0)\n"
+               "%%%%Title: (TeX-%s-0 TeX %s 0)\n"
+               "%%%%Version: 1.000\n"
+               "%%%%EndComments\n"
+               "/CIDInit /ProcSet findresource begin\n"
+               "12 dict begin\n"
+               "begincmap\n"
+               "/CIDSystemInfo\n"
+               "<< /Registry (TeX)\n"
+               "/Ordering (%s)\n"
+               "/Supplement 0\n"
+               ">> def\n"
+               "/CMapName /TeX-Identity-%s def\n"
+               "/CMapType 2 def\n"
+               "1 begincodespacerange\n"
+               "<0000> <FFFF>\n" 
+               "endcodespacerange\n", buf, buf, buf, buf, buf);
+	xfree(buf);
+    /* set up gtab */
+    for (i = 0; i < 65537; ++i) {
+        gtab[i].code = UNI_UNDEF;
+    }
+	for (k = 1; k <= max_font_id(); k++) {
+	  if (k == f || -f == pdf_font_num(k)) { 
+		for (i = font_bc(k); i <= font_ec(k); i++) {
+		  if (char_exists(k,i) && char_used(k,i)) {
+			j = char_index(k,i);
+			if (gtab[j].code == UNI_UNDEF) {
+			  set_cid_glyph_unicode(i, &gtab[j], f);
+			}
+		  }
+		}
+	  }
+	}
+
+    /* set range_size */
+    for (i = 0; i < 65536;) {
+        if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
+            range_size[i] = 1;  /* single entry */
+            i++;
+        } else if (gtab[i].code == UNI_UNDEF) {
+            range_size[i] = 0;  /* no entry */
+            i++;
+        } else {                /* gtab[i].code >= 0 */
+            j = i;
+            while (i < 65536 && gtab[i + 1].code >= 0 &&
+                   gtab[i].code + 1 == gtab[i + 1].code)
+                i++;
+            /* at this point i is the last entry of the subrange */
+            i++;                /* move i to the next entry */
+            range_size[j] = i - j;
+		}
+    }
+
+    /* calculate bfrange_count and bfchar_count */
+    bfrange_count = 0;
+    bfchar_count = 0;
+    for (i = 0; i < 65536;) {
+        if (range_size[i] == 1) {
+            bfchar_count++;
+            i++;
+        } else if (range_size[i] > 1) {
+            bfrange_count++;
+            i += range_size[i];
+        } else
+            i++;
+    }
+
+    /* write out bfrange */
+    i = 0;
+  write_bfrange:
+    if (bfrange_count > 100)
+        subrange_count = 100;
+    else
+        subrange_count = bfrange_count;
+    bfrange_count -= subrange_count;
+    pdf_printf("%i beginbfrange\n", subrange_count);
+    for (j = 0; j < subrange_count; j++) {
+        while (range_size[i] <= 1 && i < 65536)
+            i++;
+        assert(i < 65536);
+        pdf_printf("<%04X> <%04X> <%s>\n", i, i + range_size[i] - 1,
+                   utf16be_str(gtab[i].code));
+        i += range_size[i];
+    }
+    pdf_printf("endbfrange\n");
+    if (bfrange_count > 0)
+        goto write_bfrange;
+
+    /* write out bfchar */
+    i = 0;
+  write_bfchar:
+    if (bfchar_count > 100)
+        subrange_count = 100;
+    else
+        subrange_count = bfchar_count;
+    bfchar_count -= subrange_count;
+    pdf_printf("%i beginbfchar\n", subrange_count);
+    for (j = 0; j < subrange_count; j++) {
+        while (i < 65536) {
+            if (range_size[i] > 1)
+                i += range_size[i];
+            else if (range_size[i] == 0)
+                i++;
+            else                /* range_size[i] == 1 */
+                break;
+        }
+        assert(i < 65536 && gtab[i].code != UNI_UNDEF);
+        if (gtab[i].code == UNI_STRING || gtab[i].code == UNI_EXTRA_STRING) {
+            assert(gtab[i].unicode_seq != NULL);
+            pdf_printf("<%04X> <%s>\n", i, gtab[i].unicode_seq);
+        } else
+            pdf_printf("<%04X> <%s>\n", i, utf16be_str(gtab[i].code));
+        i++;
+    }
+    pdf_printf("endbfchar\n");
+    if (bfchar_count > 0)
+        goto write_bfchar;
+
+    /* free strings allocated by set_glyph_unicode() */
+    for (i = 0; i < 65536; ++i) {
+        if (gtab[i].code == UNI_EXTRA_STRING)
+            xfree(gtab[i].unicode_seq);
+    }
+
+    pdf_printf("endcmap\n"
+               "CMapName currentdict /CMap defineresource pop\n"
+               "end\n" "end\n" "%%%%EndResource\n" "%%%%EOF\n");
+    pdf_end_stream();
+    return objnum;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/tt_glyf.c b/Build/source/texk/web2c/luatexdir/font/tt_glyf.c
new file mode 100644
index 00000000000..bf21e58c49a
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tt_glyf.c
@@ -0,0 +1,658 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/tt_glyf.c,v 1.2 2005/06/09 14:31:11 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+/*
+ * Subsetting glyf, updating loca, hmtx, ...
+ *
+ */
+
+#include "ptexlib.h"
+
+#include "sfnt.h"
+#include "tt_table.h"
+#include "tt_glyf.h"
+
+#define NUM_GLYPH_LIMIT        65534
+#define TABLE_DATA_ALLOC_SIZE  40960
+#define GLYPH_ARRAY_ALLOC_SIZE 256
+
+static USHORT
+find_empty_slot (struct tt_glyphs *g)
+{
+  USHORT gid;
+
+  ASSERT(g);
+
+  for (gid = 0; gid < NUM_GLYPH_LIMIT; gid++) {
+    if (!(g->used_slot[gid/8] & (1 << (7 - (gid % 8)))))
+      break;
+  }
+  if (gid == NUM_GLYPH_LIMIT)
+    TT_ERROR("No empty glyph slot available.");
+
+  return gid;
+}
+
+USHORT
+tt_find_glyph (struct tt_glyphs *g, USHORT gid)
+{
+  USHORT idx, new_gid = 0;
+
+  ASSERT(g);
+
+  for (idx = 0; idx < g->num_glyphs; idx++) {
+    if (gid == g->gd[idx].ogid) {
+      new_gid = g->gd[idx].gid;
+      break;
+    }
+  }
+
+  return new_gid;
+}
+
+USHORT
+tt_get_index (struct tt_glyphs *g, USHORT gid)
+{
+  USHORT idx;
+
+  ASSERT(g);
+
+  for (idx = 0; idx < g->num_glyphs; idx++) {
+    if (gid == g->gd[idx].gid)
+      break;
+  }
+  if (idx == g->num_glyphs)
+    idx = 0;
+
+  return idx;
+}
+
+USHORT
+tt_add_glyph (struct tt_glyphs *g, USHORT gid, USHORT new_gid)
+{
+  ASSERT(g);
+
+  if (g->used_slot[new_gid/8] & (1 << (7 - (new_gid % 8)))) {
+    WARN("Slot %u already used.", new_gid);
+  } else {
+    if (g->num_glyphs+1 >= NUM_GLYPH_LIMIT)
+      TT_ERROR("Too many glyphs.");
+
+    if (g->num_glyphs >= g->max_glyphs) {
+      g->max_glyphs += GLYPH_ARRAY_ALLOC_SIZE;
+      g->gd = RENEW(g->gd, g->max_glyphs, struct tt_glyph_desc);
+    }
+    g->gd[g->num_glyphs].gid  = new_gid;
+    g->gd[g->num_glyphs].ogid = gid;
+    g->gd[g->num_glyphs].length = 0;
+    g->gd[g->num_glyphs].data   = NULL;
+    g->used_slot[new_gid/8] |= (1 << (7 - (new_gid % 8)));
+    g->num_glyphs += 1;
+  }
+
+  if (new_gid > g->last_gid) {
+    g->last_gid = new_gid;
+  }
+
+  return new_gid;
+}
+
+/*
+ * Initialization
+ */
+struct tt_glyphs *
+tt_build_init (void)
+{
+  struct tt_glyphs *g;
+
+  g = NEW(1, struct tt_glyphs);
+
+  g->num_glyphs  = 0;
+  g->max_glyphs  = 0;
+  g->last_gid    = 0;
+  g->emsize      = 1;
+  g->default_advh = 0;
+  g->default_tsb  = 0;
+  g->gd = NULL;
+  g->used_slot = NEW(8192, unsigned char);
+  memset(g->used_slot, 0, 8192);
+  tt_add_glyph(g, 0, 0);
+
+  return g;
+}
+
+void
+tt_build_finish (struct tt_glyphs *g)
+{
+  if (g) {
+    if (g->gd) {
+      USHORT idx;
+      for (idx = 0; idx < g->num_glyphs; idx++) {
+	if (g->gd[idx].data)
+	  RELEASE(g->gd[idx].data);
+      }
+      RELEASE(g->gd);
+    }
+    if (g->used_slot)
+      RELEASE(g->used_slot);
+    RELEASE(g);
+  }
+}
+
+static int
+glyf_cmp (const void *v1, const void *v2)
+{
+  int cmp = 0;
+  struct tt_glyph_desc *sv1, *sv2;
+
+  sv1 = (struct tt_glyph_desc *) v1;
+  sv2 = (struct tt_glyph_desc *) v2;
+
+  if (sv1->gid == sv2->gid)
+    cmp = 0;
+  else if (sv1->gid < sv2->gid)
+    cmp = -1;
+  else
+    cmp = 1;
+    
+  return cmp;
+}
+
+/*
+ * TrueType outline data.
+ */
+#define ARG_1_AND_2_ARE_WORDS     (1 << 0)
+#define ARGS_ARE_XY_VALUES        (1 << 1)
+#define ROUND_XY_TO_GRID          (1 << 2)
+#define WE_HAVE_A_SCALE           (1 << 3)
+#define RESERVED                  (1 << 4)
+#define MORE_COMPONENT            (1 << 5)
+#define WE_HAVE_AN_X_AND_Y_SCALE  (1 << 6)
+#define WE_HAVE_A_TWO_BY_TWO      (1 << 7)
+#define WE_HAVE_INSTRUCTIONS      (1 << 8)
+#define USE_MY_METRICS            (1 << 9)
+
+int
+tt_build_tables (sfnt *sfont, struct tt_glyphs *g)
+{
+  char  *hmtx_table_data = NULL, *loca_table_data = NULL;
+  char  *glyf_table_data = NULL;
+  ULONG  hmtx_table_size, loca_table_size, glyf_table_size;
+  /* some information available from other TrueType table */
+  struct tt_head_table *head = NULL;
+  struct tt_hhea_table *hhea = NULL;
+  struct tt_maxp_table *maxp = NULL;
+  struct tt_longMetrics *hmtx, *vmtx = NULL;
+  struct tt_os2__table  *os2;
+  /* temp */
+  ULONG  *location, offset;
+  long    i;
+  USHORT *w_stat; /* Estimate most frequently appeared width */
+
+  ASSERT(g);
+
+  if (sfont->type != SFNT_TYPE_TRUETYPE &&
+      sfont->type != SFNT_TYPE_TTC)
+    TT_ERROR("Invalid font type");
+
+  if (g->num_glyphs > NUM_GLYPH_LIMIT)
+    TT_ERROR("Too many glyphs.");
+
+  /*
+   * Read head, hhea, maxp, loca:
+   *
+   *   unitsPerEm       --> head
+   *   numHMetrics      --> hhea
+   *   indexToLocFormat --> head
+   *   numGlyphs        --> maxp
+   */
+  head = tt_read_head_table(sfont);
+  hhea = tt_read_hhea_table(sfont);
+  maxp = tt_read_maxp_table(sfont);
+
+  if (hhea->metricDataFormat != 0)
+    TT_ERROR("Unknown metricDataFormat.");
+
+  g->emsize = head->unitsPerEm;
+
+  sfnt_locate_table(sfont, "hmtx");
+  hmtx = tt_read_longMetrics(sfont, maxp->numGlyphs, hhea->numberOfHMetrics);
+
+  os2 = tt_read_os2__table(sfont);
+  if (os2) {
+    g->default_advh = os2->sTypoAscender - os2->sTypoDescender;
+    g->default_tsb  = g->default_advh - os2->sTypoAscender;
+  }
+
+  if (sfnt_find_table_pos(sfont, "vmtx") > 0) {
+    struct tt_vhea_table *vhea;
+    vhea = tt_read_vhea_table(sfont);
+    sfnt_locate_table(sfont, "vmtx");
+    vmtx = tt_read_longMetrics(sfont, maxp->numGlyphs, vhea->numOfLongVerMetrics);
+    RELEASE(vhea);
+  } else {
+    vmtx = NULL;
+  }
+
+  sfnt_locate_table(sfont, "loca");
+  location = NEW(maxp->numGlyphs + 1, ULONG);
+  if (head->indexToLocFormat == 0) {
+    for (i = 0; i <= maxp->numGlyphs; i++)
+      location[i] = 2*((ULONG) sfnt_get_ushort(sfont));
+  } else if (head->indexToLocFormat == 1) {
+    for (i = 0; i <= maxp->numGlyphs; i++)
+      location[i] = sfnt_get_ulong(sfont);
+  } else {
+    TT_ERROR("Unknown IndexToLocFormat.");
+  }
+
+  w_stat = NEW(g->emsize+2, USHORT);
+  memset(w_stat, 0, sizeof(USHORT)*(g->emsize+2));
+  /*
+   * Read glyf table.
+   */
+  offset = sfnt_locate_table(sfont, "glyf");
+  /*
+   * The num_glyphs may grow when composite glyph is found.
+   * A component of glyph refered by a composite glyph is appended
+   * to used_glyphs if it is not already registered in used_glyphs.
+   * Glyph programs of composite glyphs are modified so that it
+   * correctly refer to new gid of their components.
+   */
+  for (i = 0; i < NUM_GLYPH_LIMIT; i++) {
+    USHORT gid;     /* old gid */
+    ULONG  loc, len;
+    BYTE  *p, *endptr;
+    SHORT  number_of_contours;
+
+    if (i >= g->num_glyphs) /* finished */
+      break;
+
+    gid = g->gd[i].ogid;
+    if (gid >= maxp->numGlyphs)
+      TT_ERROR("Invalid glyph index (gid %u)", gid);
+
+    loc = location[gid];
+    len = location[gid+1] - loc;
+    g->gd[i].advw = hmtx[gid].advance;
+    g->gd[i].lsb  = hmtx[gid].sideBearing;
+    if (vmtx) {
+      g->gd[i].advh = vmtx[gid].advance;
+      g->gd[i].tsb  = vmtx[gid].sideBearing;
+    } else {
+      g->gd[i].advh = g->default_advh;
+      g->gd[i].tsb  = g->default_tsb;
+    }
+    g->gd[i].length = len;
+    g->gd[i].data   = NULL;
+    if (g->gd[i].advw <= g->emsize) {
+      w_stat[g->gd[i].advw] += 1;
+    } else {
+      w_stat[g->emsize+1]   += 1; /* larger than em */
+    }
+
+    if (len == 0) { /* Does not contains any data. */
+      continue;
+    } else if (len < 10) {
+      TT_ERROR("Invalid TrueType glyph data (gid %u).", gid);
+    }
+
+    g->gd[i].data = p = NEW(len, BYTE);
+    endptr = p + len;
+
+    sfnt_seek_set(sfont, offset+loc);
+    number_of_contours = sfnt_get_short(sfont);
+    p += sfnt_put_short(p, number_of_contours);
+
+    /* BoundingBox: FWord x 4 */
+    g->gd[i].llx = sfnt_get_short(sfont);
+    g->gd[i].lly = sfnt_get_short(sfont);
+    g->gd[i].urx = sfnt_get_short(sfont);
+    g->gd[i].ury = sfnt_get_short(sfont);
+    /* _FIXME_ */
+#if  1
+    if (!vmtx) /* vertOriginY == sTypeAscender */
+      g->gd[i].tsb = g->default_advh - g->default_tsb - g->gd[i].ury;
+#endif
+    p += sfnt_put_short(p, g->gd[i].llx);
+    p += sfnt_put_short(p, g->gd[i].lly);
+    p += sfnt_put_short(p, g->gd[i].urx);
+    p += sfnt_put_short(p, g->gd[i].ury);
+
+    /* Read evrything else. */
+    sfnt_read(p, len - 10, sfont);
+    /*
+     * Fix GIDs of composite glyphs.
+     */
+    if (number_of_contours < 0) {
+      USHORT flags, cgid, new_gid; /* flag, gid of a component */
+      do {
+	if (p >= endptr)
+	  TT_ERROR("Invalid TrueType glyph data (gid %u): %u bytes", gid, (unsigned int)len);
+	/*
+	 * Flags and gid of component glyph are both USHORT.
+	 */
+	flags = ((*p) << 8)| *(p+1);
+	p += 2;
+	cgid  = ((*p) << 8)| *(p+1);
+	if (cgid >= maxp->numGlyphs) {
+	  TT_ERROR("Invalid gid (%u > %u) in composite glyph %u.", cgid, maxp->numGlyphs, gid);
+	}
+	new_gid = tt_find_glyph(g, cgid);
+	if (new_gid == 0) {
+	  new_gid = tt_add_glyph(g, cgid, find_empty_slot(g));
+	}
+	p += sfnt_put_ushort(p, new_gid);
+	/*
+	 * Just skip remaining part.
+	 */
+	p += (flags & ARG_1_AND_2_ARE_WORDS) ? 4 : 2;
+	if (flags & WE_HAVE_A_SCALE) /* F2Dot14 */
+	  p += 2;
+	else if (flags & WE_HAVE_AN_X_AND_Y_SCALE) /* F2Dot14 x 2 */
+	  p += 4;
+	else if (flags & WE_HAVE_A_TWO_BY_TWO) /* F2Dot14 x 4 */
+	  p += 8;
+      } while (flags & MORE_COMPONENT);
+      /*
+       * TrueType instructions comes here:
+       *  length_of_instruction (ushort)
+       *  instruction (byte * length_of_instruction)
+       */
+    }
+  }
+  RELEASE(location);
+  RELEASE(hmtx);
+  if (vmtx)
+    RELEASE(vmtx);
+
+  {
+    int max_count = -1;
+
+    g->dw = g->gd[0].advw;
+    for (i = 0; i < g->emsize + 1; i++) {
+      if (w_stat[i] > max_count) {
+	max_count = w_stat[i];
+	g->dw = i;
+      }
+    }
+  }
+  RELEASE(w_stat);
+
+  qsort(g->gd, g->num_glyphs, sizeof(struct tt_glyph_desc), glyf_cmp);
+  {
+    USHORT prev, last_advw;
+    char  *p, *q;
+    int    padlen, num_hm_known;
+
+    glyf_table_size = 0UL;
+    num_hm_known = 0;
+    last_advw = g->gd[g->num_glyphs - 1].advw;
+    for (i = g->num_glyphs - 1; i >= 0; i--) {
+      padlen = (g->gd[i].length % 4) ? (4 - (g->gd[i].length % 4)) : 0;
+      glyf_table_size += g->gd[i].length + padlen;
+      if (!num_hm_known && last_advw != g->gd[i].advw) {
+	hhea->numberOfHMetrics = g->gd[i].gid + 2;
+	num_hm_known = 1;
+      }
+    }
+    /* All advance widths are same. */
+    if (!num_hm_known) {
+      hhea->numberOfHMetrics = 1;
+    }
+    hmtx_table_size = hhea->numberOfHMetrics * 2 + (g->last_gid + 1) * 2;
+
+    /*
+     * Choosing short format does not always give good result
+     * when compressed. Sometimes increases size.
+     */
+    if (glyf_table_size < 0x20000UL) {
+      head->indexToLocFormat = 0;
+      loca_table_size = (g->last_gid + 2)*2;
+    } else {
+      head->indexToLocFormat = 1;
+      loca_table_size = (g->last_gid + 2)*4;
+    }
+
+    hmtx_table_data = p = NEW(hmtx_table_size, char);
+    loca_table_data = q = NEW(loca_table_size, char);
+    glyf_table_data = NEW(glyf_table_size, char);
+
+    offset = 0UL; prev = 0;
+    for (i = 0; i < g->num_glyphs; i++) {
+      long gap, j;
+      gap = (long) g->gd[i].gid - prev - 1;
+      for (j = 1; j <= gap; j++) {
+	if (prev + j == hhea->numberOfHMetrics - 1) {
+	  p += sfnt_put_ushort(p, last_advw);
+	} else if (prev + j < hhea->numberOfHMetrics) {
+	  p += sfnt_put_ushort(p, 0);
+	}
+	p += sfnt_put_short (p, 0);
+	if (head->indexToLocFormat == 0) {
+	  q += sfnt_put_ushort(q, (USHORT) (offset/2));
+	} else {
+	  q += sfnt_put_ulong(q, offset);
+	}
+      }
+      padlen = (g->gd[i].length % 4) ? (4 - (g->gd[i].length % 4)) : 0;
+      if (g->gd[i].gid < hhea->numberOfHMetrics) {
+	p += sfnt_put_ushort(p, g->gd[i].advw);
+      }
+      p += sfnt_put_short (p, g->gd[i].lsb);
+      if (head->indexToLocFormat == 0) {
+	q += sfnt_put_ushort(q, (USHORT) (offset/2));
+      } else {
+	q += sfnt_put_ulong(q, offset);
+      }
+      memset(glyf_table_data + offset, 0, g->gd[i].length + padlen);
+      memcpy(glyf_table_data + offset, g->gd[i].data, g->gd[i].length);
+      offset += g->gd[i].length + padlen;
+      prev    = g->gd[i].gid;
+      /* free data here since it consume much memory */
+      RELEASE(g->gd[i].data);
+      g->gd[i].length = 0; g->gd[i].data = NULL;
+    }
+    if (head->indexToLocFormat == 0) {
+      q += sfnt_put_ushort(q, (USHORT) (offset/2));
+    } else {
+      q += sfnt_put_ulong(q, offset);
+    }
+
+    sfnt_set_table(sfont, "hmtx", (char *) hmtx_table_data, hmtx_table_size);
+    sfnt_set_table(sfont, "loca", (char *) loca_table_data, loca_table_size);
+    sfnt_set_table(sfont, "glyf", (char *) glyf_table_data, glyf_table_size);
+  }
+
+  head->checkSumAdjustment = 0;
+  maxp->numGlyphs          = g->last_gid + 1;
+
+  /* TODO */
+  sfnt_set_table(sfont, "maxp", tt_pack_maxp_table(maxp), TT_MAXP_TABLE_SIZE);
+  sfnt_set_table(sfont, "hhea", tt_pack_hhea_table(hhea), TT_HHEA_TABLE_SIZE);
+  sfnt_set_table(sfont, "head", tt_pack_head_table(head), TT_HEAD_TABLE_SIZE);
+  RELEASE(maxp);
+  RELEASE(hhea);
+  RELEASE(head);
+  if (os2)
+    RELEASE(os2);
+
+  return 0;
+}
+
+int
+tt_get_metrics (sfnt *sfont, struct tt_glyphs *g)
+{
+  struct tt_head_table *head = NULL;
+  struct tt_hhea_table *hhea = NULL;
+  struct tt_maxp_table *maxp = NULL;
+  struct tt_longMetrics *hmtx, *vmtx = NULL;
+  struct tt_os2__table  *os2;
+  /* temp */
+  ULONG  *location, offset;
+  long    i;
+  USHORT *w_stat;
+
+  ASSERT(g);
+
+  if (sfont == NULL ||
+#ifdef XETEX
+      sfont->ft_face == NULL
+#elif defined(pdfTeX)
+      sfont->buffer == NULL
+#else
+      sfont->stream == NULL
+#endif
+     )
+    TT_ERROR("File not opened.");
+
+  if (sfont->type != SFNT_TYPE_TRUETYPE &&
+      sfont->type != SFNT_TYPE_TTC)
+    TT_ERROR("Invalid font type");
+
+  /*
+   * Read head, hhea, maxp, loca:
+   *
+   *   unitsPerEm       --> head
+   *   numHMetrics      --> hhea
+   *   indexToLocFormat --> head
+   *   numGlyphs        --> maxp
+   */
+  head = tt_read_head_table(sfont);
+  hhea = tt_read_hhea_table(sfont);
+  maxp = tt_read_maxp_table(sfont);
+
+  if (hhea->metricDataFormat != 0)
+    TT_ERROR("Unknown metricDataFormat.");
+
+  g->emsize = head->unitsPerEm;
+
+  sfnt_locate_table(sfont, "hmtx");
+  hmtx = tt_read_longMetrics(sfont, maxp->numGlyphs, hhea->numberOfHMetrics);
+
+  os2 = tt_read_os2__table(sfont);
+  g->default_advh = os2->sTypoAscender - os2->sTypoDescender;
+  g->default_tsb  = g->default_advh - os2->sTypoAscender;
+
+  if (sfnt_find_table_pos(sfont, "vmtx") > 0) {
+    struct tt_vhea_table *vhea;
+    vhea = tt_read_vhea_table(sfont);
+    sfnt_locate_table(sfont, "vmtx");
+    vmtx = tt_read_longMetrics(sfont, maxp->numGlyphs, vhea->numOfLongVerMetrics);
+    RELEASE(vhea);
+  } else {
+    vmtx = NULL;
+  }
+
+  sfnt_locate_table(sfont, "loca");
+  location = NEW(maxp->numGlyphs + 1, ULONG);
+  if (head->indexToLocFormat == 0) {
+    for (i = 0; i <= maxp->numGlyphs; i++)
+      location[i] = 2*((ULONG) sfnt_get_ushort(sfont));
+  } else if (head->indexToLocFormat == 1) {
+    for (i = 0; i <= maxp->numGlyphs; i++)
+      location[i] = sfnt_get_ulong(sfont);
+  } else {
+    TT_ERROR("Unknown IndexToLocFormat.");
+  }
+
+  w_stat = NEW(g->emsize+2, USHORT);
+  memset(w_stat, 0, sizeof(USHORT)*(g->emsize+2));
+  /*
+   * Read glyf table.
+   */
+  offset = sfnt_locate_table(sfont, "glyf");
+  for (i = 0; i < g->num_glyphs; i++) {
+    USHORT gid;     /* old gid */
+    ULONG  loc, len;
+    SHORT  number_of_contours;
+
+    gid = g->gd[i].ogid;
+    if (gid >= maxp->numGlyphs)
+      TT_ERROR("Invalid glyph index (gid %u)", gid);
+
+    loc = location[gid];
+    len = location[gid+1] - loc;
+    g->gd[i].advw = hmtx[gid].advance;
+    g->gd[i].lsb  = hmtx[gid].sideBearing;
+    if (vmtx) {
+      g->gd[i].advh = vmtx[gid].advance;
+      g->gd[i].tsb  = vmtx[gid].sideBearing;
+    } else {
+      g->gd[i].advh = g->default_advh;
+      g->gd[i].tsb  = g->default_tsb;
+    }
+    g->gd[i].length = len;
+    g->gd[i].data   = NULL;
+
+    if (g->gd[i].advw <= g->emsize) {
+      w_stat[g->gd[i].advw] += 1;
+    } else {
+      w_stat[g->emsize+1]   += 1; /* larger than em */
+    }
+
+    if (len == 0) { /* Does not contains any data. */
+      continue;
+    } else if (len < 10) {
+      TT_ERROR("Invalid TrueType glyph data (gid %u).", gid);
+    }
+
+    sfnt_seek_set(sfont, offset+loc);
+    number_of_contours = sfnt_get_short(sfont);
+
+    /* BoundingBox: FWord x 4 */
+    g->gd[i].llx = sfnt_get_short(sfont);
+    g->gd[i].lly = sfnt_get_short(sfont);
+    g->gd[i].urx = sfnt_get_short(sfont);
+    g->gd[i].ury = sfnt_get_short(sfont);
+    /* _FIXME_ */
+#if  1
+    if (!vmtx) /* vertOriginY == sTypeAscender */
+      g->gd[i].tsb = g->default_advh - g->default_tsb - g->gd[i].ury;
+#endif
+  }
+  RELEASE(location);
+  RELEASE(hmtx);
+  RELEASE(maxp);
+  RELEASE(hhea);
+  RELEASE(head);
+  RELEASE(os2);
+
+  if (vmtx)
+    RELEASE(vmtx);
+
+  {
+    int max_count = -1;
+
+    g->dw = g->gd[0].advw;
+    for (i = 0; i < g->emsize + 1; i++) {
+      if (w_stat[i] > max_count) {
+	max_count = w_stat[i];
+	g->dw = i;
+      }
+    }
+  }
+  RELEASE(w_stat);
+
+
+  return 0;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/tt_glyf.h b/Build/source/texk/web2c/luatexdir/font/tt_glyf.h
new file mode 100644
index 00000000000..cf33af6733f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tt_glyf.h
@@ -0,0 +1,60 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/tt_glyf.h,v 1.1 2004/09/11 14:50:29 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+#ifndef _TT_GLYF_H_
+#define _TT_GLYF_H_
+
+struct tt_glyph_desc
+{
+  USHORT gid;
+  USHORT ogid; /* GID in original font */
+  USHORT advw, advh;
+  SHORT  lsb, tsb;
+  SHORT  llx, lly, urx, ury;
+  ULONG  length;
+  BYTE  *data;
+};
+
+struct tt_glyphs
+{
+  USHORT num_glyphs;
+  USHORT max_glyphs;
+  USHORT last_gid;
+  USHORT emsize;
+  USHORT dw;           /* optimal value for DW */
+  USHORT default_advh; /* default value */
+  SHORT  default_tsb;  /* default value */
+  struct tt_glyph_desc *gd;
+  unsigned char *used_slot;
+};
+
+extern struct tt_glyphs *tt_build_init (void);
+extern void   tt_build_finish (struct tt_glyphs *g);
+
+extern USHORT tt_add_glyph  (struct tt_glyphs *g, USHORT gid, USHORT new_gid);
+extern USHORT tt_get_index  (struct tt_glyphs *g, USHORT gid);
+extern USHORT tt_find_glyph (struct tt_glyphs *g, USHORT gid);
+
+extern int tt_build_tables (sfnt *sfont, struct tt_glyphs *g);
+extern int tt_get_metrics  (sfnt *sfont, struct tt_glyphs *g);
+
+#endif /* _TT_GLYF_H_ */
diff --git a/Build/source/texk/web2c/luatexdir/font/tt_table.c b/Build/source/texk/web2c/luatexdir/font/tt_table.c
new file mode 100644
index 00000000000..4f82552d9df
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tt_table.c
@@ -0,0 +1,483 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/tt_table.c,v 1.7 2004/09/11 14:50:29 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+#include <stdio.h>
+
+#ifndef pdfTeX
+#include "system.h"
+#include "error.h"
+#include "mem.h"
+#include "mfileio.h"
+#else
+extern void pdftex_fail (const char *fmt, ...); /* utils.c */
+#endif
+
+#include "sfnt.h"
+#include "tt_table.h"
+
+/*
+  tables contains information refered by other tables
+  maxp->numGlyphs, etc --> loca, etc
+  hhea->numberOfHMetrics --> hmtx
+  head->indexToLocFormat --> loca
+  head->glyphDataFormat --> glyf
+*/
+
+char *tt_pack_head_table (struct tt_head_table *table)
+{
+  int i;
+  char *p, *data;
+
+  if (table == NULL)
+    TT_ERROR("passed NULL pointer\n");
+
+  p = data = NEW(TT_HEAD_TABLE_SIZE, char);
+  p += sfnt_put_ulong(p, table->version);
+  p += sfnt_put_ulong(p, table->fontRevision);
+  p += sfnt_put_ulong(p, table->checkSumAdjustment);
+  p += sfnt_put_ulong(p, table->magicNumber);
+  p += sfnt_put_ushort(p, table->flags);
+  p += sfnt_put_ushort(p, table->unitsPerEm);
+  for (i=0; i<8; i++) {
+    *(p++) = (table->created)[i];
+  }
+  for (i=0; i<8; i++) {
+    *(p++) = (table->modified)[i];
+  }
+  p += sfnt_put_short(p, table->xMin);
+  p += sfnt_put_short(p, table->yMin);
+  p += sfnt_put_short(p, table->xMax);
+  p += sfnt_put_short(p, table->yMax);
+  p += sfnt_put_ushort(p, table->macStyle);
+  p += sfnt_put_ushort(p, table->lowestRecPPEM);
+  p += sfnt_put_short(p, table->fontDirectionHint);
+  p += sfnt_put_short(p, table->indexToLocFormat);
+  p += sfnt_put_short(p, table->glyphDataFormat);
+
+  return data;
+}
+
+struct tt_head_table *tt_read_head_table (sfnt *sfont)
+{
+  int i;
+  struct tt_head_table *table = NULL;
+
+  table = NEW(1, struct tt_head_table);
+
+  sfnt_locate_table(sfont, "head");
+
+  table->version = sfnt_get_ulong(sfont);
+  table->fontRevision = sfnt_get_ulong(sfont);
+  table->checkSumAdjustment = sfnt_get_ulong(sfont);
+  table->magicNumber = sfnt_get_ulong(sfont);
+  table->flags = sfnt_get_ushort(sfont);
+  table->unitsPerEm = sfnt_get_ushort(sfont);
+  for (i=0; i<8; i++) {
+    (table->created)[i] = sfnt_get_byte (sfont);
+  }
+  for (i=0; i<8; i++) {
+    (table->modified)[i] = sfnt_get_byte (sfont);
+  }
+  table->xMin = sfnt_get_short(sfont);
+  table->yMin = sfnt_get_short(sfont);
+  table->xMax = sfnt_get_short(sfont);
+  table->yMax = sfnt_get_short(sfont);
+  table->macStyle = sfnt_get_short(sfont);
+  table->lowestRecPPEM = sfnt_get_short(sfont);
+  table->fontDirectionHint = sfnt_get_short(sfont);
+  table->indexToLocFormat = sfnt_get_short(sfont);
+  table->glyphDataFormat = sfnt_get_short(sfont);
+
+  return table;
+}
+
+char *tt_pack_maxp_table (struct tt_maxp_table *table)
+{
+  char *p, *data;
+
+  p = data = NEW(TT_MAXP_TABLE_SIZE, char);
+  p += sfnt_put_ulong(p, table->version);
+  p += sfnt_put_ushort(p, table->numGlyphs);
+  p += sfnt_put_ushort(p, table->maxPoints);
+  p += sfnt_put_ushort(p, table->maxContours);
+  p += sfnt_put_ushort(p, table->maxComponentPoints);
+  p += sfnt_put_ushort(p, table->maxComponentContours);
+  p += sfnt_put_ushort(p, table->maxZones);
+  p += sfnt_put_ushort(p, table->maxTwilightPoints);
+  p += sfnt_put_ushort(p, table->maxStorage);
+  p += sfnt_put_ushort(p, table->maxFunctionDefs);
+  p += sfnt_put_ushort(p, table->maxInstructionDefs);
+  p += sfnt_put_ushort(p, table->maxStackElements);
+  p += sfnt_put_ushort(p, table->maxSizeOfInstructions);
+  p += sfnt_put_ushort(p, table->maxComponentElements);
+  p += sfnt_put_ushort(p, table->maxComponentDepth);
+
+  return data;
+}
+
+struct tt_maxp_table *tt_read_maxp_table (sfnt *sfont)
+{
+  struct tt_maxp_table *table = NULL;
+
+  table = NEW(1, struct tt_maxp_table);
+
+  sfnt_locate_table(sfont, "maxp");
+  table->version = sfnt_get_ulong(sfont);
+  table->numGlyphs = sfnt_get_ushort(sfont);
+  table->maxPoints = sfnt_get_ushort(sfont);
+  table->maxContours = sfnt_get_ushort(sfont);
+  table->maxComponentPoints = sfnt_get_ushort(sfont);
+  table->maxComponentContours = sfnt_get_ushort(sfont);
+  table->maxZones = sfnt_get_ushort(sfont);
+  table->maxTwilightPoints = sfnt_get_ushort(sfont);
+  table->maxStorage = sfnt_get_ushort(sfont);
+  table->maxFunctionDefs = sfnt_get_ushort(sfont);
+  table->maxInstructionDefs = sfnt_get_ushort(sfont);
+  table->maxStackElements = sfnt_get_ushort(sfont);
+  table->maxSizeOfInstructions = sfnt_get_ushort(sfont);
+  table->maxComponentElements = sfnt_get_ushort(sfont);
+  table->maxComponentDepth = sfnt_get_ushort(sfont);
+
+  return table;
+}
+
+char *tt_pack_hhea_table (struct tt_hhea_table *table)
+{
+  int   i;
+  char *p, *data;
+
+  p  = data = NEW(TT_HHEA_TABLE_SIZE, char);
+  p += sfnt_put_ulong(p, table->version);
+  p += sfnt_put_short(p, table->Ascender);
+  p += sfnt_put_short(p, table->Descender);
+  p += sfnt_put_short(p, table->LineGap);
+  p += sfnt_put_ushort(p, table->advanceWidthMax);
+  p += sfnt_put_short(p, table->minLeftSideBearing);
+  p += sfnt_put_short(p, table->minRightSideBearing);
+  p += sfnt_put_short(p, table->xMaxExtent);
+  p += sfnt_put_short(p, table->caretSlopeRise);
+  p += sfnt_put_short(p, table->caretSlopeRun);
+  for (i = 0; i < 5; i++) {
+    p += sfnt_put_short(p, table->reserved[i]);
+  }
+  p += sfnt_put_short(p, table->metricDataFormat);
+  p += sfnt_put_ushort(p, table->numberOfHMetrics);
+
+  return data;
+}
+
+struct tt_hhea_table *
+tt_read_hhea_table (sfnt *sfont)
+{
+  int    i;
+  struct tt_hhea_table *table = NULL;
+
+  table = NEW(1, struct tt_hhea_table);
+
+  sfnt_locate_table(sfont, "hhea");
+  table->version   = sfnt_get_ulong(sfont);
+  table->Ascender  = sfnt_get_short (sfont);
+  table->Descender = sfnt_get_short(sfont);
+  table->LineGap   = sfnt_get_short(sfont);
+  table->advanceWidthMax     = sfnt_get_ushort(sfont);
+  table->minLeftSideBearing  = sfnt_get_short(sfont);
+  table->minRightSideBearing = sfnt_get_short(sfont);
+  table->xMaxExtent     = sfnt_get_short(sfont);
+  table->caretSlopeRise = sfnt_get_short(sfont);
+  table->caretSlopeRun  = sfnt_get_short(sfont);
+  for(i = 0; i < 5; i++) {
+    table->reserved[i] = sfnt_get_short(sfont);
+  }
+  table->metricDataFormat = sfnt_get_short(sfont);
+  if (table->metricDataFormat != 0)
+    TT_ERROR("unknown metricDaraFormat");
+  table->numberOfHMetrics = sfnt_get_ushort(sfont);
+
+  return table;
+}
+
+/* vhea */
+char *
+tt_pack_vhea_table (struct tt_vhea_table *table)
+{
+  int   i;
+  char *p, *data;
+
+  p  = data = NEW(TT_VHEA_TABLE_SIZE, char);
+  p += sfnt_put_ulong(p, table->version);
+  p += sfnt_put_short(p, table->vertTypoAscender);
+  p += sfnt_put_short(p, table->vertTypoDescender);
+  p += sfnt_put_short(p, table->vertTypoLineGap);
+  p += sfnt_put_short(p, table->advanceHeightMax);  /* ushort ? */
+  p += sfnt_put_short(p, table->minTopSideBearing);
+  p += sfnt_put_short(p, table->minBottomSideBearing);
+  p += sfnt_put_short(p, table->yMaxExtent);
+  p += sfnt_put_short(p, table->caretSlopeRise);
+  p += sfnt_put_short(p, table->caretSlopeRun);
+  p += sfnt_put_short(p, table->caretOffset);
+  for(i = 0; i < 5; i++) {
+    p += sfnt_put_short(p, table->reserved[i]);
+  }
+  p += sfnt_put_ushort(p, table->numOfLongVerMetrics);
+
+  return data;
+}
+
+struct tt_vhea_table *tt_read_vhea_table (sfnt *sfont)
+{
+  int i;
+  struct tt_vhea_table *table = NULL;
+
+  table = NEW(1, struct tt_vhea_table);
+
+  sfnt_locate_table(sfont, "vhea");
+  table->version = sfnt_get_ulong(sfont);
+  table->vertTypoAscender = sfnt_get_short (sfont);
+  table->vertTypoDescender = sfnt_get_short(sfont);
+  table->vertTypoLineGap = sfnt_get_short(sfont);
+  table->advanceHeightMax = sfnt_get_short(sfont); /* ushort ? */
+  table->minTopSideBearing = sfnt_get_short(sfont);
+  table->minBottomSideBearing = sfnt_get_short(sfont);
+  table->yMaxExtent = sfnt_get_short(sfont);
+  table->caretSlopeRise = sfnt_get_short(sfont);
+  table->caretSlopeRun = sfnt_get_short(sfont);
+  table->caretOffset = sfnt_get_short(sfont);
+  for(i=0;i<5;i++) {
+    (table->reserved)[i] = sfnt_get_short(sfont);
+  }
+  table->numOfLongVerMetrics = sfnt_get_ushort(sfont);
+
+  return table;
+}
+
+
+struct tt_VORG_table *
+tt_read_VORG_table (sfnt *sfont)
+{
+  struct tt_VORG_table *vorg;
+  ULONG  offset;
+  USHORT i;
+
+  offset = sfnt_find_table_pos(sfont, "VORG");
+
+  if (offset > 0) {
+    vorg = NEW(1, struct tt_VORG_table);
+
+    sfnt_locate_table(sfont, "VORG");
+    if (sfnt_get_ushort(sfont) != 1 ||
+	sfnt_get_ushort(sfont) != 0)
+      TT_ERROR("Unsupported VORG version.");
+
+    vorg->defaultVertOriginY    = sfnt_get_short(sfont);
+    vorg->numVertOriginYMetrics = sfnt_get_ushort(sfont);
+    vorg->vertOriginYMetrics    = NEW(vorg->numVertOriginYMetrics,
+				      struct tt_vertOriginYMetrics);
+    /*
+     * The vertOriginYMetrics array must be sorted in increasing
+     * glyphIndex order.
+     */
+    for (i = 0;
+	 i < vorg->numVertOriginYMetrics; i++) {
+      vorg->vertOriginYMetrics[i].glyphIndex  = sfnt_get_ushort(sfont);
+      vorg->vertOriginYMetrics[i].vertOriginY = sfnt_get_short(sfont);
+    }
+  } else {
+    vorg = NULL;
+  }
+
+  return vorg;
+}
+
+/*
+ * hmtx and vmtx
+ *
+ *  Reading/writing hmtx and vmtx depend on other tables, maxp and hhea/vhea.
+ */
+
+struct tt_longMetrics *
+tt_read_longMetrics (sfnt *sfont, USHORT numGlyphs, USHORT numLongMetrics)
+{
+  struct tt_longMetrics *m;
+  USHORT gid, last_adv = 0;
+
+  m = NEW(numGlyphs, struct tt_longMetrics);
+  for (gid = 0; gid < numGlyphs; gid++) {
+    if (gid < numLongMetrics)
+      last_adv = sfnt_get_ushort(sfont);
+    m[gid].sideBearing = sfnt_get_short(sfont);
+    m[gid].advance     = last_adv;
+  }
+
+  return m;
+}
+
+/* OS/2 table */
+/* this table may not exist */
+struct tt_os2__table *
+tt_read_os2__table (sfnt *sfont)
+{
+  struct tt_os2__table *table = NULL;
+  int    i;
+
+  if (sfnt_find_table_pos(sfont, "OS/2") == 0)
+    return NULL;
+  
+  sfnt_locate_table(sfont, "OS/2");
+    
+  table = NEW(1, struct tt_os2__table);
+
+  table->version       = sfnt_get_ushort(sfont);
+  table->xAvgCharWidth = sfnt_get_short(sfont);
+  table->usWeightClass = sfnt_get_ushort(sfont);
+  table->usWidthClass  = sfnt_get_ushort(sfont);
+  table->fsType        = sfnt_get_short(sfont);
+  table->ySubscriptXSize   = sfnt_get_short(sfont);
+  table->ySubscriptYSize   = sfnt_get_short(sfont);
+  table->ySubscriptXOffset = sfnt_get_short(sfont);
+  table->ySubscriptYOffset = sfnt_get_short(sfont);
+  table->ySuperscriptXSize = sfnt_get_short(sfont);
+  table->ySuperscriptYSize = sfnt_get_short(sfont);
+  table->ySuperscriptXOffset = sfnt_get_short(sfont);
+  table->ySuperscriptYOffset = sfnt_get_short(sfont);
+  table->yStrikeoutSize      = sfnt_get_short(sfont);
+  table->yStrikeoutPosition  = sfnt_get_short(sfont);
+  table->sFamilyClass        = sfnt_get_short(sfont);
+  for (i = 0; i < 10; i++) {
+    table->panose[i] = sfnt_get_byte(sfont);
+  }
+  table->ulUnicodeRange1 = sfnt_get_ulong(sfont);
+  table->ulUnicodeRange2 = sfnt_get_ulong(sfont);
+  table->ulUnicodeRange3 = sfnt_get_ulong(sfont);
+  table->ulUnicodeRange4 = sfnt_get_ulong(sfont);
+  for (i = 0; i < 4; i++) {
+    table->achVendID[i] = sfnt_get_char(sfont);
+  }
+  table->fsSelection      = sfnt_get_ushort(sfont);
+  table->usFirstCharIndex = sfnt_get_ushort(sfont);
+  table->usLastCharIndex  = sfnt_get_ushort(sfont);
+  table->sTypoAscender    = sfnt_get_short(sfont);
+  table->sTypoDescender   = sfnt_get_short(sfont);
+  table->sTypoLineGap     = sfnt_get_short(sfont);
+  table->usWinAscent      = sfnt_get_ushort(sfont);
+  table->usWinDescent     = sfnt_get_ushort(sfont);
+  table->ulCodePageRange1 = sfnt_get_ulong(sfont);
+  table->ulCodePageRange2 = sfnt_get_ulong(sfont);
+  if (table->version == 0x0002) {
+    table->sxHeight      = sfnt_get_short(sfont);
+    table->sCapHeight    = sfnt_get_short(sfont);
+    table->usDefaultChar = sfnt_get_ushort(sfont);
+    table->usBreakChar   = sfnt_get_ushort(sfont);
+    table->usMaxContext  = sfnt_get_ushort(sfont);
+  }
+
+  return table;
+}
+
+USHORT
+tt_get_name (sfnt *sfont, char *dest, USHORT destlen,
+	     USHORT plat_id, USHORT enco_id,
+	     USHORT lang_id, USHORT name_id)
+{
+  USHORT length = 0;
+  USHORT num_names, string_offset;
+  ULONG  name_offset;
+  int    i;
+
+  name_offset = sfnt_locate_table (sfont, "name");
+
+  if (sfnt_get_ushort(sfont)) 
+    TT_ERROR ("Expecting zero");
+
+  num_names = sfnt_get_ushort(sfont);
+  string_offset = sfnt_get_ushort(sfont);
+  for (i=0;i<num_names;i++) {
+    USHORT p_id, e_id, n_id, l_id;
+    USHORT offset;
+
+    p_id = sfnt_get_ushort(sfont);
+    e_id = sfnt_get_ushort(sfont);
+    l_id = sfnt_get_ushort(sfont);
+    n_id = sfnt_get_ushort(sfont);
+    length = sfnt_get_ushort(sfont);
+    offset = sfnt_get_ushort(sfont);
+    /* language ID value 0xffffu for `accept any language ID' */
+    if ((p_id == plat_id) && (e_id == enco_id) &&
+	(lang_id == 0xffffu || l_id == lang_id) && (n_id == name_id)) {
+      if (length > destlen - 1) {
+	fprintf(stderr, "\n** Notice: Name string too long. Truncating **\n");
+	length = destlen - 1;
+      }
+      sfnt_seek_set (sfont, name_offset+string_offset+offset);
+      sfnt_read((unsigned char*)dest, length, sfont);
+      dest[length] = '\0';
+      break;
+    }
+  }
+  if (i == num_names) {
+    length = 0;
+  }
+
+  return length;
+}
+
+USHORT
+tt_get_ps_fontname (sfnt *sfont, char *dest, USHORT destlen)
+{
+  USHORT namelen = 0;
+
+#ifdef XETEX
+
+    const char* name = FT_Get_Postscript_Name(sfont->ft_face);
+    namelen = strlen(name);
+    if (namelen > destlen - 1) {
+      strncpy(dest, name, destlen - 1);
+      dest[destlen] = 0;
+    }
+    else
+      strcpy(dest, name);
+
+#else
+
+  /* First try Mac-Roman PS name and then Win-Unicode PS name */
+  if ((namelen = tt_get_name(sfont, dest, destlen, 1, 0, 0, 6)) != 0 ||
+      (namelen = tt_get_name(sfont, dest, destlen, 3, 1, 0x409u, 6)) != 0 ||
+      (namelen = tt_get_name(sfont, dest, destlen, 3, 5, 0x412u, 6)) != 0)
+    return namelen;
+
+  fprintf(stderr, "\n** Warning: No valid PostScript name available **\n");
+  /*
+    Wrokaround for some bad TTfonts:
+    Language ID value 0xffffu for `accept any language ID'
+  */
+  if ((namelen = tt_get_name(sfont, dest, destlen, 1, 0, 0xffffu, 6)) == 0) {
+    /*
+      Finally falling back to Mac Roman name field.
+      Warning: Some bad Japanese TTfonts using SJIS encoded string in the
+      Mac Roman name field. 
+    */
+    namelen = tt_get_name(sfont, dest, destlen, 1, 0, 0, 1);
+  }
+
+#endif
+
+  return namelen;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/tt_table.h b/Build/source/texk/web2c/luatexdir/font/tt_table.h
new file mode 100644
index 00000000000..ffb2c5b8f45
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/tt_table.h
@@ -0,0 +1,193 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/tt_table.h,v 1.6 2004/09/11 14:50:29 hirata Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+#ifndef _TT_TABLE_H_
+#define _TT_TABLE_H_
+
+#include "sfnt.h"
+
+#define TT_HEAD_TABLE_SIZE 54UL
+#define TT_MAXP_TABLE_SIZE 32UL
+#define TT_HHEA_TABLE_SIZE 36UL
+#define TT_VHEA_TABLE_SIZE 36UL
+
+struct tt_head_table
+{
+  Fixed  version;
+  Fixed  fontRevision;
+  ULONG  checkSumAdjustment;
+  ULONG  magicNumber;
+  USHORT flags;
+  USHORT unitsPerEm;
+  BYTE   created[8];
+  BYTE   modified[8];
+  FWord  xMin, yMin, xMax, yMax;
+  USHORT macStyle;
+  USHORT lowestRecPPEM;
+  SHORT  fontDirectionHint;
+  SHORT  indexToLocFormat;
+  SHORT  glyphDataFormat;
+};
+
+struct tt_hhea_table
+{
+  Fixed  version;
+  FWord  Ascender;
+  FWord  Descender;
+  FWord  LineGap;
+  uFWord advanceWidthMax;
+  FWord  minLeftSideBearing;
+  FWord  minRightSideBearing;
+  FWord  xMaxExtent;
+  SHORT  caretSlopeRise;
+  SHORT  caretSlopeRun;
+  SHORT  reserved[5]; /* set to 0 */
+  SHORT  metricDataFormat;
+  USHORT numberOfHMetrics;
+};
+
+struct tt_vhea_table
+{
+  Fixed  version;
+  SHORT  vertTypoAscender;  /* v.1.1 name */
+  SHORT  vertTypoDescender; /* v.1.1 name */
+  SHORT  vertTypoLineGap;   /* v.1.1 name */ 
+  SHORT  advanceHeightMax;
+  SHORT  minTopSideBearing;
+  SHORT  minBottomSideBearing;
+  SHORT  yMaxExtent;
+  SHORT  caretSlopeRise;
+  SHORT  caretSlopeRun;
+  SHORT  caretOffset;
+  SHORT  reserved[5]; /* set to 0 */
+  USHORT numOfLongVerMetrics;
+};
+
+struct tt_maxp_table
+{
+  Fixed  version;
+  USHORT numGlyphs;
+  USHORT maxPoints;
+  USHORT maxContours;
+  USHORT maxComponentPoints;
+  USHORT maxComponentContours;
+  USHORT maxZones;
+  USHORT maxTwilightPoints;
+  USHORT maxStorage;
+  USHORT maxFunctionDefs;
+  USHORT maxInstructionDefs;
+  USHORT maxStackElements;
+  USHORT maxSizeOfInstructions;
+  USHORT maxComponentElements;
+  USHORT maxComponentDepth;
+};
+
+struct tt_os2__table
+{
+  USHORT  version; /* 0x0001 or 0x0002 */
+  SHORT   xAvgCharWidth;  
+  USHORT  usWeightClass;  
+  USHORT  usWidthClass;   
+  SHORT   fsType;  /* if (faType & 0x08) editable_embedding */
+  SHORT   ySubscriptXSize;        
+  SHORT   ySubscriptYSize;      
+  SHORT   ySubscriptXOffset;
+  SHORT   ySubscriptYOffset;      
+  SHORT   ySuperscriptXSize;      
+  SHORT   ySuperscriptYSize;      
+  SHORT   ySuperscriptXOffset;    
+  SHORT   ySuperscriptYOffset;    
+  SHORT   yStrikeoutSize; 
+  SHORT   yStrikeoutPosition;     
+  SHORT   sFamilyClass;   
+  BYTE    panose[10];
+  ULONG   ulUnicodeRange1;
+  ULONG   ulUnicodeRange2;
+  ULONG   ulUnicodeRange3;
+  ULONG   ulUnicodeRange4;
+  ICHAR   achVendID[4];   
+  USHORT  fsSelection;    
+  USHORT  usFirstCharIndex;
+  USHORT  usLastCharIndex;
+  SHORT   sTypoAscender;  /* TTF spec. from MS is wrong */
+  SHORT   sTypoDescender; /* TTF spec. from MS is wrong */
+  SHORT   sTypoLineGap;   /* TTF spec. from MS is wrong */
+  USHORT  usWinAscent;   
+  USHORT  usWinDescent;    
+  ULONG   ulCodePageRange1;
+  ULONG   ulCodePageRange2;
+  /* version 0x0002 */
+  SHORT   sxHeight;
+  SHORT   sCapHeight;
+  USHORT  usDefaultChar;
+  USHORT  usBreakChar;
+  USHORT  usMaxContext;
+};
+
+struct tt_vertOriginYMetrics {
+  USHORT glyphIndex;
+  SHORT  vertOriginY;
+};
+
+struct tt_VORG_table {
+  SHORT  defaultVertOriginY;
+  USHORT numVertOriginYMetrics;
+  struct tt_vertOriginYMetrics *vertOriginYMetrics;
+};
+
+/* hmtx and vmtx */
+struct tt_longMetrics
+{
+  USHORT advance;
+  SHORT  sideBearing;
+};
+
+
+/* head, hhea, maxp */
+extern char  *tt_pack_head_table (struct tt_head_table *table);
+extern struct tt_head_table *tt_read_head_table (sfnt *sfont);
+extern char  *tt_pack_hhea_table (struct tt_hhea_table *table);
+extern struct tt_hhea_table *tt_read_hhea_table (sfnt *sfont);
+extern char  *tt_pack_maxp_table (struct tt_maxp_table *table);
+extern struct tt_maxp_table *tt_read_maxp_table (sfnt *sfont);
+
+/* vhea */
+extern char  *tt_pack_vhea_table (struct tt_vhea_table *table);
+extern struct tt_vhea_table *tt_read_vhea_table (sfnt *sfont);
+
+/* VORG */
+extern struct tt_VORG_table *tt_read_VORG_table (sfnt *sfont);
+
+/* hmtx and vmtx */
+extern struct tt_longMetrics *tt_read_longMetrics (sfnt *sfont,
+	USHORT numGlyphs, USHORT numLongMetrics);
+
+/* OS/2 table */
+extern struct tt_os2__table *tt_read_os2__table (sfnt *sfont);
+
+/* name table */
+extern USHORT tt_get_name (sfnt *sfont, char *dest, USHORT destlen,
+			   USHORT plat_id, USHORT enco_id,
+			   USHORT lang_id, USHORT name_id);
+extern USHORT tt_get_ps_fontname (sfnt *sfont, char *dest, USHORT destlen);
+
+#endif /* _TT_TABLE_H_ */
diff --git a/Build/source/texk/web2c/luatexdir/font/vfovf.c b/Build/source/texk/web2c/luatexdir/font/vfovf.c
new file mode 100644
index 00000000000..0f23cb07b94
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/vfovf.c
@@ -0,0 +1,1349 @@
+/*
+Copyright (c) 1996-2006 Taco Hoekwater <taco@luatex.org>
+
+This file is part of LuaTeX.
+
+LuaTeX 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.
+
+LuaTeX 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 LuaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: vfovf.c 1022 2008-02-14 11:49:30Z taco $
+*/
+
+#include "ptexlib.h"
+
+#include "luatex-api.h"
+
+/* this is a hack! */
+#define font_max 5000
+
+#define set_char_0 0 /* typeset character 0 and move right */
+#define set1 128 /* typeset a character and move right */
+#define set2 129 /* typeset a character and move right */
+#define set3 130 /* typeset a character and move right */
+#define set4 131 /* typeset a character and move right */
+#define set_rule 132 /* typeset a rule and move right */
+#define put1  133 /* typeset a character without moving */
+#define put2  134 /* typeset a character without moving */
+#define put3  135 /* typeset a character without moving */
+#define put4  136 /* typeset a character without moving */
+#define put_rule 137 /* typeset a rule */
+#define nop 138 /* no operation */
+#define bop 139 /* beginning of page */
+#define eop 140 /* ending of page */
+#define push 141 /* save the current positions */
+#define pop 142 /* restore previous positions */
+#define right1  143 /* move right */
+#define right2  144 /* move right */
+#define right3  145 /* move right */
+#define right4  146 /* move right, 4 bytes */
+#define w0 147 /* move right by |w| */
+#define w1 148 /* move right and set |w| */
+#define w2 149 /* move right and set |w| */
+#define w3 150 /* move right and set |w| */
+#define w4 151 /* move right and set |w| */
+#define x0 152 /* move right by |x| */
+#define x1 153 /* move right and set |x| */
+#define x2 154 /* move right and set |x| */
+#define x3 155 /* move right and set |x| */
+#define x4 156 /* move right and set |x| */
+#define down1 157 /* move down */
+#define down2 158 /* move down */
+#define down3 159 /* move down */
+#define down4 160 /* move down, 4 bytes */
+#define y0 161 /* move down by |y| */
+#define y1 162 /* move down and set |y| */
+#define y2 163 /* move down and set |y| */
+#define y3 164 /* move down and set |y| */
+#define y4 165 /* move down and set |y| */
+#define z0 166 /* move down by |z| */
+#define z1 167 /* move down and set |z| */
+#define z2 168 /* move down and set |z| */
+#define z3 169 /* move down and set |z| */
+#define z4 170 /* move down and set |z| */
+#define fnt_num_0 171 /* set current font to 0 */
+#define fnt1 235 /* set current font */
+#define fnt2 236 /* set current font */
+#define fnt3 237 /* set current font */
+#define fnt4 238 /* set current font */
+#define xxx1 239 /* extension to DVI  primitives */
+#define xxx2 240 /* extension to DVI  primitives */
+#define xxx3 241 /* extension to DVI  primitives */
+#define xxx4 242 /* potentially long extension to DVI primitives */
+#define fnt_def1 243 /* define the meaning of a font number */
+#define pre 247 /* preamble */
+#define post 248 /* postamble beginning */
+#define post_post 249 /* postamble ending */
+#define yyy1 250 /* PDF literal text */
+#define yyy2 251 /* PDF literal text */
+#define yyy3 252 /* PDF literal text */
+#define yyy4 253 /* PDF literal text */
+
+#define null_font 0
+
+#define long_char 242 /* \.{VF} command for general character packet */
+#define vf_id 202 /* identifies \.{VF} files */
+
+/* go out \.{VF} processing with an error message */
+#define bad_vf(a) { xfree(vf_buffer); print_nlp();	\
+    print_string("Error in processing VF font (");	\
+    print_string(font_name(f));				\
+    print_string(".vf): ");				\
+    print_string(a);					\
+    print_string(", virtual font will be ignored");	\
+    print_ln();	 return; }
+
+#define lua_bad_vf(a) { xfree(vf_buffer);		\
+		       lua_settop(L,s_top);		\
+		       lua_pushnil(L);			\
+		       lua_pushstring(L,a);		\
+		       return 2; }
+
+#define tmp_b0  tmp_w.qqqq.b0
+#define tmp_b1  tmp_w.qqqq.b1
+#define tmp_b2  tmp_w.qqqq.b2
+#define tmp_b3  tmp_w.qqqq.b3
+#define tmp_int tmp_w.cint
+
+#define vf_stack_size 100  /* \.{DVI} files shouldn't |push| beyond this depth */
+
+typedef unsigned char vf_stack_index ;  /* an index into the stack */
+
+typedef struct vf_stack_record {
+    scaled stack_w, stack_x, stack_y, stack_z;
+} vf_stack_record;
+
+boolean auto_expand_vf(internal_font_number f); /* forward */
+
+/* get a byte from\.{VF} file */
+
+#define vf_byte(a) { real_eight_bits vf_tmp_b;		\
+    if (vf_cur>=vf_size) {				\
+      pdftex_fail("unexpected eof on virtual font");	\
+    }							\
+    vf_tmp_b = vf_buffer[vf_cur++] ; a = vf_tmp_b; }
+
+
+#define vf_replace_z() {			\
+    vf_alpha=16;				\
+  while (vf_z>=040000000) {			\
+    vf_z= vf_z / 2;				\
+    vf_alpha += vf_alpha;			\
+  }						\
+  vf_beta=256 / vf_alpha;			\
+  vf_alpha=vf_alpha*vf_z; }
+
+/* read |k| bytes as an integer from \.{VF} file */
+
+#define vf_read(k,l) {  integer itmp = 0, dtmp = k, jtmp = 0;		\
+    while (dtmp > 0) {							\
+      vf_byte(jtmp);							\
+      if ((dtmp==k) && jtmp>127)					\
+	jtmp = jtmp - 256;						\
+      itmp  = itmp*256 + jtmp;						\
+      decr(dtmp);							\
+    }									\
+    l = itmp; }
+
+#define vf_read_u(k,l) {  unsigned int dtmp=k, itmp = 0, jtmp = 0;	\
+    while (dtmp-- > 0) {						\
+      vf_byte(jtmp);						\
+      itmp  = itmp*256 + jtmp;					\
+    }								\
+    l = itmp; }
+
+void
+pdf_check_vf_cur_val (void) {
+ internal_font_number f;
+ f = cur_val;
+ if (font_type(f) == virtual_font_type)
+   pdf_error("font", "command cannot be used with virtual font");
+}
+
+static void
+vf_local_font_warning(internal_font_number f, internal_font_number k, char *s, integer a, integer b) {
+  print_nlp();
+  print_string(s);
+  print_string(" in local font ");
+  print_string(font_name(k));
+  print_string(" (");
+  print_int(b);
+  print_string(" != ");
+  print_int(a);
+  print_string(") in virtual font ");
+  print_string(font_name(f));
+  print_string(".vf ignored.");
+}
+
+
+/* process a local font in \.{VF} file */
+
+internal_font_number 
+vf_def_font(internal_font_number f,unsigned char *vf_buffer, integer *vf_cr) {
+    internal_font_number k;
+    str_number s;
+    scaled ds,fs;
+    four_quarters cs;
+    memory_word tmp_w; /* accumulator */
+    integer junk;
+    unsigned long checksum;
+    cs.b0 = vf_buffer[(*vf_cr)]; 
+    cs.b1 = vf_buffer[(*vf_cr)+1]; 
+    cs.b2 = vf_buffer[(*vf_cr)+2]; 
+    cs.b3 = vf_buffer[(*vf_cr)+3]; (*vf_cr)+=4;
+    checksum = cs.b0*256*256*256 +  cs.b1*256*256 + cs.b2*256 +  cs.b3;
+    k =  vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    if (k>127) k-=256;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+
+    fs = sqxfw(k, font_size(f));
+
+    k =  vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    if (k>127) k-=256;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    k = k*256+ vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+
+    ds = k / 16;
+
+
+    tmp_b0 = vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    tmp_b1 = vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+    while (tmp_b0 > 0) {
+      tmp_b0--;
+      (*vf_cr)++; /* skip the font path */
+    }
+    string_room(tmp_b1);
+    while (tmp_b1 > 0) {
+      tmp_b1--;
+      junk = vf_buffer[(*vf_cr)] ; (*vf_cr)++;
+      append_pool_char(junk);
+    }
+    s = make_string();
+    k = tfm_lookup(s, fs);
+    if (k == null_font) 
+      k = read_font_info(get_nullcs(), s, get_nullstr(), fs, -1);
+    if (k != null_font) {
+      if (checksum!=0 && font_checksum(k)!=0 && checksum!= font_checksum(k))
+	vf_local_font_warning(f, k, "checksum mismatch",checksum,font_checksum(k));
+      if (ds != font_dsize(k))
+	vf_local_font_warning(f, k, "design size mismatch",ds,font_dsize(k));
+    }
+    if (pdf_font_expand_ratio(f) != 0)
+      set_expand_params(k, pdf_font_auto_expand(f),
+						pdf_font_expand_ratio(pdf_font_stretch(f)),
+						-pdf_font_expand_ratio(pdf_font_shrink(f)),
+						pdf_font_step(f), pdf_font_expand_ratio(f));
+    return k;
+}
+
+
+int
+open_vf_file (char *fn, unsigned char **vbuffer, integer *vsize) {
+  boolean res; /* was the callback successful? */
+  integer callback_id;
+  boolean file_read; /* was |vf_file| successfully read? */
+  FILE *vf_file;
+  char *fnam = NULL;
+
+
+
+
+  namelength = strlen(fn);
+  nameoffile = xmalloc(namelength+2);
+  strcpy((char *)(nameoffile+1),fn);
+
+  callback_id=callback_defined(find_vf_file_callback);
+  if (callback_id>0) {
+    res = run_callback(callback_id,"S->S",fn, &fnam);
+    if (res && (fnam!=NULL) && (strlen(fnam)>0)) {
+      /* @<Fixup |nameoffile| after callback@>; */
+      free(nameoffile);
+      namelength = strlen(fnam);
+      nameoffile = xmalloc(namelength+2);
+      strcpy((char *)(nameoffile+1),fnam);
+    } else {
+      return 0;
+    }
+  }
+  callback_id=callback_defined(read_vf_file_callback);
+  if (callback_id>0) {
+    file_read = false;
+    res = run_callback(callback_id,"S->bSd",stringcast(nameoffile+1),
+		       &file_read, vbuffer,vsize);
+    if (res && file_read && (*vsize>0)) {
+      return 1; 
+    }
+    if (!file_read)
+      return 0;    /* -1 */
+  } else {
+    if (ovf_b_open_in(vf_file) || vf_b_open_in(vf_file)) {
+      res = read_vf_file(vf_file,vbuffer,vsize);
+      b_close(vf_file);
+      if (res) {
+	return 1;
+      }
+    } else {
+      return 0; /* -1 */
+    }
+  }
+  return 0;
+}
+
+
+/*
+  @ The |do_vf| procedure attempts to read the \.{VF} file for a font, and sets
+  |font_type()| to |real_font_type| if the \.{VF} file could not be found
+  or loaded, otherwise sets |font_type()| to |virtual_font_type|.  At this
+  time, |tmp_f| is the internal font number of the current \.{TFM} font.  To
+  process font definitions in virtual font we call |vf_def_font|.
+*/
+
+#define append_packet(k) vpackets[vf_np++] = k 
+
+/* life is easier if all internal font commands are fnt4 and
+   all character commands are set4 or put4 */
+
+#define append_fnt_set(k) {			\
+    assert(k>0)	;				\
+    append_packet(packet_font_code);		\
+    append_four(k); } 
+
+#define append_four(k) {			\
+    append_packet((k&0xFF000000)>>24);		\
+    append_packet((k&0x00FF0000)>>16);		\
+    append_packet((k&0x0000FF00)>>8);		\
+    append_packet((k&0x000000FF));  } 
+
+/* some of these things happen twice, adding a define is simplest */
+
+#define test_checksum()  { vf_byte(tmp_b0); vf_byte(tmp_b1);		\
+    vf_byte(tmp_b2); vf_byte(tmp_b3);					\
+    if (((tmp_b0 != 0) || (tmp_b1 != 0) || (tmp_b2 != 0) || (tmp_b3 != 0)) && \
+	((font_check_0(f) != 0) || (font_check_1(f) != 0) ||		\
+	 (font_check_2(f) != 0) || (font_check_3(f) != 0)) &&		\
+	((tmp_b0 != font_check_0(f)) || (tmp_b1 != font_check_1(f)) ||	\
+	 (tmp_b2 != font_check_2(f)) || (tmp_b3 != font_check_3(f)))) {	\
+      print_nlp();							\
+      print_string("checksum mismatch in font ");			\
+      print_string(font_name(f));					\
+      print_string(".vf ignored "); } }
+
+#define test_dsize() {  int read_tmp; vf_read(4,read_tmp);		\
+    if ((read_tmp / 16) != font_dsize(f)) {				\
+      print_nlp();							\
+      print_string("design size mismatch in font ");			\
+      print_string(font_name(f));					\
+      print_string(".vf ignored");					\
+    } }
+
+
+int count_packet_bytes (real_eight_bits *vf_buf, int cur_bute, int count) {
+  int k = 0;
+  int ff = 0;
+  int acc = 0;
+  unsigned int cmd = 0;
+  unsigned int d = 0;
+  while (k<count) {
+	cmd = vf_buf[cur_bute+k]; k++;
+	if ((cmd >= set_char_0) && (cmd < set1)) {
+	  if (ff==0) { ff = 1; acc+=5;  }
+	  acc+=5;
+	} else if ((fnt_num_0 <= cmd) && (cmd <= fnt_num_0 + 63)) {
+	  ff = 1;
+	  acc+=5;
+	} else { 
+	  switch (cmd) {
+	  case fnt1:     acc+=5; k+=1; ff=1 ; break;
+	  case fnt2:     acc+=5; k+=2; ff=1 ; break;
+	  case fnt3:     acc+=5; k+=3; ff=1 ; break;
+	  case fnt4:     acc+=5; k+=4; ff=1 ; break;
+	  case set_rule: acc+=9; k+=8; break;
+	  case put_rule: acc+=11; k+=8; break; 
+	  case set1:     acc+=5; k+=1; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case set2:     acc+=5; k+=2; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case set3:     acc+=5; k+=3; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case set4:     acc+=5; k+=4; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case put1:     acc+=7; k+=1; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case put2:     acc+=7; k+=2; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case put3:     acc+=7; k+=3; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case put4:     acc+=7; k+=4; if (ff==0) { ff = 1; acc+=5;  } break;
+	  case right1:   acc+=5; k+=1; break;
+	  case right2:   acc+=5; k+=2; break;
+	  case right3:   acc+=5; k+=3; break;
+	  case right4:   acc+=5; k+=4; break;
+	  case w1:       acc+=5; k+=1; break;
+	  case w2:       acc+=5; k+=2; break;
+	  case w3:       acc+=5; k+=3; break;
+	  case w4:       acc+=5; k+=4; break;
+	  case x1:       acc+=5; k+=1; break;
+	  case x2:       acc+=5; k+=2; break; 
+	  case x3:       acc+=5; k+=3; break; 
+	  case x4:       acc+=5; k+=4; break;
+	  case down1:    acc+=5; k+=1; break;  
+	  case down2:    acc+=5; k+=2; break;  
+	  case down3:    acc+=5; k+=3; break;  
+	  case down4:    acc+=5; k+=4; break;
+	  case y1:       acc+=5; k+=1; break;
+	  case y2:       acc+=5; k+=2; break; 
+	  case y3:       acc+=5; k+=3; break; 
+	  case y4:       acc+=5; k+=4; break;
+	  case z1:       acc+=5; k+=1; break;
+	  case z2:       acc+=5; k+=2; break; 
+	  case z3:       acc+=5; k+=3; break; 
+	  case z4:       acc+=5; k+=4; break;
+	  case xxx1: 
+		d = vf_buf[cur_bute+k]; k++;
+		k += d; acc += 5 + d;
+		break;
+	  case xxx2: 
+		d = vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		k += d; acc += 5 + d;
+		break;
+	  case xxx3: 
+		d = vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		k += d; acc += 5 + d;
+		break;
+	  case xxx4:
+		d = vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		d = d*256 + vf_buf[cur_bute+k]; k++;
+		k += d; acc += 5 + d;
+	  break;
+	  case w0:      acc+=5; break;
+	  case x0:      acc+=5; break;
+	  case y0:      acc+=5; break;
+	  case z0:      acc+=5; break;
+	  case nop:	    break;
+	  case push:    acc+=1; break;
+	  case pop:     acc+=1; break;
+	  }
+	}
+  }
+  return (acc+1);
+}
+
+void 
+do_vf(internal_font_number f) {
+  integer k, n, i;
+  unsigned cmd;
+  scaled x,y,w,z,h,v;
+  integer cc, cmd_length, packet_length;
+  charinfo *co;
+  scaled tfm_width;
+  integer save_cur_byte;
+  vf_stack_index stack_level;
+  integer vf_z; /* multiplier */
+  integer vf_alpha; /* correction for negative values */
+  char vf_beta; /* divisor */
+  integer vf_np; 
+  real_eight_bits *vpackets;
+  memory_word tmp_w; /* accumulator */
+  vf_stack_record vf_stack[256];
+  integer junk;
+  unsigned char *vf_buffer;
+  integer vf_size; 
+  integer vf_cur;
+  integer *vf_local_fnts = NULL; /* external font ids */
+  integer *vf_real_fnts = NULL; /* internal font ids */
+  unsigned vf_nf = 0; /* local font counter */
+
+  if (font_type(f)!= unknown_font_type)
+    return;
+  set_font_type(f,real_font_type);
+  if (auto_expand_vf(f))
+    return; /* auto-expanded virtual font */
+  stack_level = 0;
+  /* @<Open |vf_file|, return if not found@>; */
+  vf_cur=0; vf_buffer=NULL; vf_size=0;
+  if (!open_vf_file(font_name(f), &vf_buffer, &vf_size))
+    return;
+  /* @<Process the preamble@>;@/ */
+  set_font_type(f,virtual_font_type);
+  vf_byte(k);
+  if (k != pre) 
+    bad_vf("PRE command expected");
+  vf_byte(k);
+  if (k != vf_id)
+    bad_vf("wrong id byte");
+  vf_byte(cmd_length);
+  for (k = 1;k<= cmd_length;k++)
+    vf_byte(junk);
+  test_checksum();
+  test_dsize();
+  /* update_terminal;*/
+  vf_z = font_size(f);
+  vf_replace_z();
+  /* @<Process the font definitions@>;@/ */
+  /* scan forward to find the number of internal fonts */
+  vf_nf = 0;
+  save_cur_byte = vf_cur;
+  vf_byte(cmd);
+  while ((cmd >= fnt_def1) && (cmd <= (fnt_def1 + 3))) {
+    vf_read((cmd - fnt_def1 + 1),junk);
+    vf_read(4,junk);
+    vf_read(4,junk);
+    vf_read(4,junk);
+    vf_byte(k);
+    vf_byte(junk);
+    k += junk;
+    while (k-- > 0) {  vf_byte(junk); } 
+    incr(vf_nf);
+    vf_byte(cmd);
+  }
+  vf_cur = save_cur_byte;
+  vf_byte(cmd);
+  /* malloc and fill the local font arrays */
+  if (vf_nf>0) {
+    i = vf_nf*sizeof(integer);
+    vf_local_fnts= xmalloc(i);
+    memset(vf_local_fnts,0,i);
+    vf_real_fnts= xmalloc(i);
+    memset(vf_real_fnts,0,i);
+    vf_nf = 0;
+    while ((cmd >= fnt_def1) && (cmd <= (fnt_def1 + 3))) {
+      vf_read_u((cmd - fnt_def1 + 1),vf_local_fnts[vf_nf]);
+      vf_real_fnts[vf_nf] = vf_def_font(f, vf_buffer, &vf_cur);
+      incr(vf_nf);    
+      vf_byte(cmd);
+    }
+  }
+
+
+  while (cmd <= long_char) {
+    /* @<Build a character packet@>;@/ */
+	vf_np = 0;
+    if (cmd == long_char) {
+      vf_read_u(4,packet_length);
+      vf_read_u(4,cc);
+      if (!char_exists(f,cc)) {
+        bad_vf("invalid character code");
+      }
+      vf_read(4,k);
+      tfm_width = sqxfw(k, font_size(f));
+    } else {
+      packet_length = cmd;
+      vf_byte(cc);
+      if (!char_exists(f,cc)) {
+        bad_vf("invalid character code");
+      }
+      vf_read(3,k);
+      tfm_width = sqxfw(k, font_size(f));
+    }
+    if (packet_length < 0)
+      bad_vf("negative packet length");
+    if (tfm_width != char_width(f,cc)) {
+      /* precisely 'one off' errors are rampant */
+      if (abs(tfm_width - char_width(f,cc))>1) {
+		print_nlp();
+		print_string("character width mismatch in font ");
+		print_string(font_name(f));
+		print_string(".vf ignored");
+      }
+    }
+    k  = count_packet_bytes(vf_buffer,vf_cur,packet_length);
+    vpackets = xmalloc(k+1);
+    co = get_charinfo(f,cc);
+    k = 0; 
+    w = 0; x = 0; y = 0; z = 0;
+    while (packet_length > 0) {
+      vf_byte(cmd);
+      decr(packet_length);
+
+      if ((cmd >= set_char_0) && (cmd < set1)) {
+		if (k == 0) {
+		  k = vf_real_fnts[0];
+		  append_fnt_set(k);
+		}
+		append_packet(packet_char_code);
+		append_four(cmd);
+		cmd_length = 0;
+		cmd = nop;
+		
+      } else if (((fnt_num_0 <= cmd) && (cmd <= fnt_num_0 + 63)) ||
+				 ((fnt1 <= cmd) && (cmd <= fnt1 + 3))) {
+		if (cmd >= fnt1) {
+		  vf_read_u((cmd - fnt1 + 1),k);
+		  packet_length -= (cmd - fnt1 + 1);
+		} else {
+		  k = cmd - fnt_num_0;
+		}
+
+		/*  change from local to external font id */
+		n = 0;
+		while ((n < vf_nf) && (vf_local_fnts[n] != k)) 
+		  n++;
+		if (n==vf_nf)
+		  bad_vf("undefined local font");
+
+		k = vf_real_fnts[n];
+		append_fnt_set(k);
+		cmd_length = 0;
+		cmd = nop;
+      } else { 
+		switch (cmd) {
+		case set_rule: 
+		  vf_read(4,h); vf_read(4,v);
+		  append_packet(packet_rule_code);
+		  append_four(h);
+		  append_four(v);
+		  packet_length -= 8;
+		  break;
+		case put_rule: 
+		  vf_read(4,h); vf_read(4,v);
+		  append_packet(packet_push_code);
+		  append_packet(packet_rule_code);
+		  append_four(h);
+		  append_four(v);
+		  append_packet(packet_pop_code);
+		  packet_length -= 8;
+		  break;
+		case set1: 
+		case set2: 
+		case set3: 
+		case set4:
+		  if (k == 0) {
+		    k = vf_real_fnts[0];
+		    append_fnt_set(k);
+		  }
+		  vf_read_u((cmd - set1 + 1),i);
+		  append_packet(packet_char_code);
+		  append_four(i);
+		  packet_length -= (cmd - set1 + 1);
+		  break;
+		case put1: 
+		case put2: 
+		case put3: 
+		case put4:
+		  if (k == 0) {
+			k = vf_real_fnts[0];
+			append_fnt_set(k);
+		  }
+		  vf_read_u((cmd - put1 + 1),i);
+		  append_packet(packet_push_code);
+		  append_packet(packet_char_code);
+		  append_four(i);
+		  append_packet(packet_pop_code);
+		  packet_length -= (cmd - put1 + 1);
+		  break;
+		case right1: 
+		case right2: 
+		case right3: 
+		case right4: 
+		  vf_read((cmd - right1 + 1),i);
+		  append_packet(packet_right_code);
+		  append_four(i);
+		  packet_length -= (cmd - right1 + 1);
+		  break;
+		case w1: 
+		case w2: 
+		case w3: 
+		case w4:
+		  vf_read((cmd - w1 + 1),w);
+		  append_packet(packet_right_code);
+		  append_four(w);
+		  packet_length -= (cmd - w1 + 1);
+		  break;
+		case x1:
+		case x2: 
+		case x3: 
+		case x4:
+		  vf_read((cmd - x1 + 1),x);
+		  append_packet(packet_right_code);
+		  append_four(x);
+		  packet_length -= (cmd - x1 + 1);
+		  break;
+		case down1:  
+		case down2:  
+		case down3:  
+		case down4:
+		  vf_read((cmd - down1 + 1),i);
+		  append_packet(packet_down_code);
+		  append_four(i);
+		  packet_length -= (cmd - down1 + 1);
+		  break;
+		case y1: 
+		case y2: 
+		case y3: 
+		case y4:
+		  vf_read((cmd - y1 + 1),y);
+		  append_packet(packet_down_code);
+		  append_four(y);
+		  packet_length -= (cmd - y1 + 1);
+		  break;
+		case z1: 
+		case z2: 
+		case z3: 
+		case z4:
+		  vf_read((cmd - z1 + 1),z);
+		  append_packet(packet_down_code);
+		  append_four(z);
+		  packet_length -= (cmd - z1 + 1);
+		  break;
+		case xxx1: 
+		case xxx2: 
+		case xxx3: 
+		case xxx4:
+		  vf_read_u((cmd - xxx1 + 1),cmd_length);
+		  packet_length -= (cmd - xxx1 + 1);
+		  if (cmd_length <= 0)
+			bad_vf("special of negative length");
+		  packet_length -= cmd_length;
+
+		  append_packet(packet_special_code);
+		  append_four(cmd_length);
+		  while (cmd_length > 0) {
+			cmd_length--;
+			vf_byte(i);
+			append_packet(i);
+		  }
+		  append_packet(0);
+		  break;
+		case w0: 
+		  append_packet(packet_right_code);
+		  append_four(w);
+		  break;
+		case x0: 
+		  append_packet(packet_right_code);
+		  append_four(x);
+		  break;
+		case y0: 
+		  append_packet(packet_down_code);
+		  append_four(y);
+		  break;
+		case z0: 
+		  append_packet(packet_down_code);
+		  append_four(z);
+		  break;
+		case nop:
+		  break;
+		case push: 
+		  if (stack_level == vf_stack_size) {
+			overflow_string("virtual font stack size", vf_stack_size);
+		  } else {
+			vf_stack[stack_level].stack_w = w;
+			vf_stack[stack_level].stack_x = x;
+			vf_stack[stack_level].stack_y = y;
+			vf_stack[stack_level].stack_z = z;
+			incr(stack_level);
+			append_packet(packet_push_code);
+		  }
+		  break;
+		case pop: 
+		  if (stack_level == 0) {
+			bad_vf("more POPs than PUSHs in character");
+		  } else {
+			decr(stack_level);
+			w = vf_stack[stack_level].stack_w;
+			x = vf_stack[stack_level].stack_x;
+			y = vf_stack[stack_level].stack_y;
+			z = vf_stack[stack_level].stack_z;
+			append_packet(packet_pop_code);
+		  }
+		  break;
+		default:
+		  bad_vf("improver DVI command");
+		}
+      }
+    }
+    /* signal end of packet */
+    append_packet(packet_end_code); 
+
+    if (stack_level != 0)
+      bad_vf("more PUSHs than POPs in character packet");
+    if (packet_length != 0) 
+      bad_vf("invalid packet length or DVI command in packet");
+    /* @<Store the packet being built@>; */
+    set_charinfo_packets(co,vpackets);
+    vf_byte(cmd);
+  }
+  if (cmd != post)
+    bad_vf("POST command expected");
+
+  xfree(vf_buffer);
+}
+
+#define make_command0(N,K) {			\
+    lua_newtable(L);				\
+    lua_pushstring(L, N);			\
+    lua_rawseti(L,-2, 1);			\
+    lua_rawseti(L,-2, K);			\
+    K++; }
+
+#define make_command1(N,V,K) {			\
+    lua_newtable(L);				\
+    lua_pushstring(L, N);			\
+    lua_rawseti(L,-2, 1);			\
+    lua_pushnumber(L, V);			\
+    lua_rawseti(L,-2, 2);			\
+    lua_rawseti(L,-2, K);			\
+    K++; }
+
+#define make_command2(N,V,W,K) {		\
+    lua_newtable(L);				\
+    lua_pushstring(L, N);			\
+    lua_rawseti(L,-2, 1);			\
+    lua_pushnumber(L, V);			\
+    lua_rawseti(L,-2, 2);			\
+    lua_pushnumber(L, W);			\
+    lua_rawseti(L,-2, 3);			\
+    lua_rawseti(L,-2, K);			\
+    K++; }
+
+#define make_commands(N,S,V,K) {		\
+    lua_newtable(L);				\
+    lua_pushstring(L, N);			\
+    lua_rawseti(L,-2, 1);			\
+    lua_pushlstring(L, S, V);			\
+    lua_rawseti(L,-2, 2);			\
+    lua_rawseti(L,-2, K);			\
+    K++; }
+
+
+int 
+make_vf_table(lua_State *L, char *cnom, scaled atsize) {
+  integer cmd, k, i;
+  integer cc, cmd_length, packet_length;
+  scaled tfm_width;
+  vf_stack_index stack_level;
+  integer vf_z; /* multiplier */
+  integer vf_alpha; /* correction for negative values */
+  char vf_beta; /* divisor */
+  char *s;
+  scaled h,v;
+  scaled w, x, y, z;
+  integer s_top; /* lua stack */
+  integer vf_nf ; /* local font counter */
+  scaled ds,fs;
+  four_quarters cs;
+  memory_word tmp_w; /* accumulator */
+  vf_stack_record vf_stack[256];
+  unsigned char *vf_buffer;
+  integer vf_size; 
+  integer vf_cur;
+
+
+  stack_level = 0;
+  /* @<Open |vf_file|, return if not found@>; */
+  vf_cur=0; vf_buffer=NULL; vf_size=0;  
+  if (!open_vf_file(cnom, &vf_buffer, &vf_size)) {
+    lua_pushnil(L);
+    return 1;
+  }
+
+  /* start by creating a table */
+  s_top = lua_gettop(L);
+  lua_newtable(L);
+
+  /* @<Process the preamble@>;@/ */
+  vf_byte(k);
+  if (k != pre) 
+    lua_bad_vf("PRE command expected");
+  vf_byte(k);
+  if (k != vf_id)
+    lua_bad_vf("wrong id byte");
+  vf_byte(cmd_length);
+
+  s = xmalloc(cmd_length);
+  for (k = 1;k<= cmd_length;k++)
+    vf_byte(s[(k-1)]);
+
+  lua_pushlstring(L,s,cmd_length);
+  free(s);
+  lua_setfield(L,-2,"header");
+
+  vf_byte(cs.b0); vf_byte(cs.b1); vf_byte(cs.b2); vf_byte(cs.b3); 
+  lua_pushnumber(L, (unsigned long)(cs.b0<<24)+(cs.b1<<16)+(cs.b2<<8)+cs.b3 );
+  lua_setfield(L,-2,"checksum");
+  
+  vf_read(4,k);
+  ds = k /16;
+  lua_pushinteger(L,ds);
+  lua_setfield(L,-2,"designsize");
+
+
+  lua_pushstring(L,cnom);
+  lua_setfield(L,-2,"name");
+
+  lua_pushinteger(L,atsize);
+  lua_setfield(L,-2,"size");
+
+
+  /* update_terminal;*/
+  vf_z = atsize;
+  vf_replace_z();
+  /* @<Process the font definitions@>;@/ */
+  vf_byte(cmd);
+  lua_newtable(L);  
+
+  i = 1;
+  while ((cmd >= fnt_def1) && (cmd <= fnt_def1 + 3)) {
+
+    lua_newtable(L);      
+    vf_read_u((cmd - fnt_def1 + 1),vf_nf);
+    vf_nf++;
+    /* checksum */
+    vf_byte(cs.b0); vf_byte(cs.b1); vf_byte(cs.b2); vf_byte(cs.b3); 
+
+    vf_read(4,k);
+    fs = sqxfw(k, atsize);
+	lua_pushstring(L,"size");
+    lua_pushnumber(L,fs);
+    lua_rawset(L,-3);
+    
+    vf_read(4,k);
+    ds = k / 16; /* dsize, not used */
+    
+    vf_byte(tmp_b0);
+    vf_byte(tmp_b1);
+    while (tmp_b0 > 0) {  tmp_b0--; vf_byte(k); } /* skip the font path */
+    
+    s = xmalloc(tmp_b1+1); k = 0;
+    while (tmp_b1-- > 0)
+      vf_byte(s[k++]);    
+    s[k]=0;
+	lua_pushstring(L,"name");
+    lua_pushstring(L,xstrdup(s));
+    free(s);
+    lua_rawset(L,-3);
+    
+    lua_rawseti(L,-2,vf_nf);
+    i++;   
+    vf_byte(cmd);
+  }
+
+  if (i>1) {
+    lua_setfield(L,-2,"fonts");
+  } else {
+    lua_pop(L,1);
+  }
+
+  lua_newtable(L); /* 'characters' */
+  while (cmd <= long_char) {
+    /* @<Build a character packet@>;@/ */
+    if (cmd == long_char) {
+      vf_read_u(4,packet_length);
+      vf_read_u(4,cc);
+      vf_read(4,tfm_width);
+    } else {
+      packet_length = cmd;
+      vf_byte(cc);
+      vf_read(3,tfm_width);
+    }
+    if (packet_length < 0)
+      lua_bad_vf("negative packet length");
+
+    lua_newtable(L); /* for this character */
+
+    lua_pushnumber(L,tfm_width);
+    lua_setfield(L,-2,"width");
+
+    lua_newtable(L); /* for 'commands' */
+
+    k = 1; vf_nf = 0;
+    w = 0; x = 0; y = 0; z = 0;
+    while (packet_length > 0) {
+      vf_byte(cmd);
+      decr(packet_length);
+	  
+      if ((cmd >= set_char_0) && (cmd < set1)) {
+		if (vf_nf == 0) {
+		  vf_nf  = 1;
+		  make_command1("font",vf_nf,k);
+		}
+		make_command1("char",cmd,k);
+		
+      } else if (((fnt_num_0 <= cmd) && (cmd <= fnt_num_0 + 63)) ||
+		 ((fnt1 <= cmd) && (cmd <= fnt1 + 3))) {
+		if (cmd >= fnt1) {
+		  vf_read_u((cmd - fnt1 + 1),vf_nf); vf_nf++;
+		  packet_length -= (cmd - fnt1 + 1);
+		} else {
+		  vf_nf = cmd - fnt_num_0 + 1;
+		}
+		make_command1("font",vf_nf,k);
+      } else { 
+	switch (cmd) {
+	case set_rule: 
+	  vf_read(4,h); vf_read(4,v);
+	  make_command2("rule",sqxfw(h,atsize),sqxfw(v,atsize),k);
+	  packet_length -= 8;
+	  break;
+	case put_rule: 
+	  vf_read(4,h); vf_read(4,v);
+	  make_command0("push",k);
+	  make_command2("rule",sqxfw(h,atsize),sqxfw(v,atsize),k);
+	  make_command0("pop",k);
+	  packet_length -= 8;
+	  break;
+	case set1: 
+	case set2: 
+	case set3: 
+	case set4:
+	  if (vf_nf == 0) {
+	    vf_nf  = 1;
+	    make_command1("font",vf_nf,k);
+	  }
+	  vf_read_u((cmd - set1 + 1),i);
+	  make_command1("char",i,k);
+	  packet_length -= (cmd - set1 + 1);
+	  break;
+	case put1: 
+	case put2: 
+	case put3: 
+	case put4:
+	  if (vf_nf == 0) {
+	    vf_nf  = 1;
+	    make_command1("font",vf_nf,k);
+	  }
+	  vf_read_u((cmd - put1 + 1),i);
+	  make_command0("push",k);
+	  make_command1("char",i,k);
+	  make_command0("pop",k);
+	  packet_length -= (cmd - put1 + 1);
+	  break;
+	case right1: 
+	case right2: 
+	case right3: 
+	case right4: 
+	  vf_read((cmd - right1 + 1),i);
+	  make_command1("right",sqxfw(i,atsize),k);
+	  packet_length -= (cmd - right1 + 1);
+	  break;
+	case w1: 
+	case w2: 
+	case w3: 
+	case w4:
+	  vf_read((cmd - w1 + 1),w);
+	  make_command1("right",sqxfw(w,atsize),k);
+	  packet_length -= (cmd - w1 + 1);
+	  break;
+	case x1:
+	case x2: 
+	case x3: 
+	case x4:
+	  vf_read((cmd - x1 + 1),x);	  
+	  make_command1("right",sqxfw(x,atsize),k);
+	  packet_length -= (cmd - x1 + 1);
+	  break;
+	case down1:  
+	case down2:  
+	case down3:  
+	case down4:  
+	  vf_read((cmd - down1 + 1),i);
+	  make_command1("down",sqxfw(i,atsize),k);
+	  packet_length -= (cmd - down1 + 1);
+	  break;
+	case y1: 
+	case y2: 
+	case y3: 
+	case y4:
+	  vf_read((cmd - y1 + 1),y);
+	  make_command1("down",sqxfw(y,atsize),k);
+	  packet_length -= (cmd - y1 + 1);
+	  break;
+	case z1: 
+	case z2: 
+	case z3: 
+	case z4:
+	  vf_read((cmd - z1 + 1),z);
+	  make_command1("down",sqxfw(z,atsize),k);
+	  packet_length -= (cmd - z1 + 1);
+	  break;
+	case xxx1: 
+	case xxx2: 
+	case xxx3: 
+	case xxx4:
+	  vf_read_u((cmd - xxx1 + 1),cmd_length);
+	  packet_length -= (cmd - xxx1 + 1);
+	  if (cmd_length <= 0)
+	    lua_bad_vf("special of negative length");
+	  packet_length -= cmd_length;
+
+	  s = xmalloc(cmd_length+1); i = 0;
+	  while (cmd_length > 0) {
+	    cmd_length--;
+	    vf_byte(s[i]);
+	    i++;
+	  }
+	  s[i]=0;
+	  make_commands("special",strdup(s),i,k);
+	  free(s);
+	  break;
+	case w0: 
+	  make_command1("right",sqxfw(w,atsize),k);
+	  break;
+	case x0: 
+	  make_command1("right",sqxfw(x,atsize),k);
+	  break;
+	case y0: 
+	  make_command1("down",sqxfw(y,atsize),k);
+	  break;
+	case z0: 
+	  make_command1("down",sqxfw(z,atsize),k);
+	  break;
+	case nop:
+	  break;
+	case push: 
+	  if (stack_level == vf_stack_size) {
+	    overflow_string("virtual font stack size", vf_stack_size);
+	  } else {
+	    vf_stack[stack_level].stack_w = w;
+	    vf_stack[stack_level].stack_x = x;
+	    vf_stack[stack_level].stack_y = y;
+	    vf_stack[stack_level].stack_z = z;
+	    incr(stack_level);
+	    make_command0("push",k);
+	  }
+	  break;
+	case pop: 
+	  if (stack_level == 0) {
+	    lua_bad_vf("more POPs than PUSHs in character");
+	  } else {
+	    decr(stack_level);
+	    w = vf_stack[stack_level].stack_w;
+	    x = vf_stack[stack_level].stack_x;
+	    y = vf_stack[stack_level].stack_y;
+	    z = vf_stack[stack_level].stack_z;
+	    make_command0("pop",k);
+	  }
+	  break;
+	default:
+	  lua_bad_vf("improver DVI command");
+	}
+      }
+    }
+    /* signal end of packet */
+    lua_setfield(L,-2,"commands");
+
+    if (stack_level != 0)
+      lua_bad_vf("more PUSHs than POPs in character packet");
+    if (packet_length != 0) 
+      lua_bad_vf("invalid packet length or DVI command in packet");
+
+    lua_rawseti(L,-2,cc);
+
+    vf_byte(cmd);
+  }
+  lua_setfield(L,-2,"characters");
+
+  if (cmd != post)
+    lua_bad_vf("POST command expected");
+  xfree(vf_buffer);
+  return 1;
+}
+
+
+extern void replace_packet_fonts(internal_font_number f, integer *old_fontid, integer *new_fontid, int count) ;
+extern integer *packet_local_fonts(internal_font_number f, integer *num);
+extern internal_font_number auto_expand_font (internal_font_number f, integer e) ;
+
+
+/* This function is called from |do_vf|, and fixes up the virtual data 
+   inside an auto-expanded virtual font */
+
+boolean 
+auto_expand_vf(internal_font_number f) {
+
+  internal_font_number bf;
+  integer e, k;
+  integer *vf_old_fonts, *vf_new_fonts;
+  integer num = 0;
+
+  if ((! pdf_font_auto_expand(f)) || (pdf_font_blink(f) == null_font))
+    return false ; /* not an auto-expanded font */
+  bf = pdf_font_blink(f);
+  
+  if (font_type(bf) != virtual_font_type)
+    return false; /* not a virtual font */
+
+  e = pdf_font_expand_ratio(f);
+
+  vf_old_fonts = packet_local_fonts(bf,&num);
+  if (num>0) {
+    vf_new_fonts = xmalloc(num*sizeof(integer));
+    for (k=0;k<num;k++) {
+      vf_new_fonts[k] = auto_expand_font(vf_old_fonts[k], e);
+      copy_expand_params(vf_new_fonts[k], vf_old_fonts[k], e);
+    }
+    replace_packet_fonts(f,vf_old_fonts,vf_new_fonts,num);
+    xfree(vf_new_fonts);
+    xfree(vf_old_fonts);
+  }
+  set_font_type(f,virtual_font_type);
+  return true;
+}
+
+/* this function is not always safe, because it needs makecstring() */
+str_number 
+expand_font_name (internal_font_number f, integer e) {
+  int old_setting;
+  old_setting=selector; 
+  selector=new_string;
+  print_string(font_name(f));
+  if (e > 0) {
+	print_char('+');
+  }
+  print_int(e);
+  selector=old_setting;
+  return make_string();
+}
+
+
+internal_font_number
+auto_expand_font (internal_font_number f, integer e) {
+  internal_font_number k;
+  kerninfo *krn;
+  charinfo *co, *ci;
+  char *fn;
+  integer i;
+  scaled w;
+  k = copy_font(f);
+  i = strlen(font_name(f))+12;
+  fn = xmalloc(i);
+  snprintf(fn,i,"%s%s%d",font_name(f),(e>0 ? "+" : ""), (int)e);
+  set_font_name(k,fn);
+  for (i = font_bc(k);i<=font_ec(k);i++) {	
+    if (char_exists(k,i)) {
+      co = get_charinfo(k,i);
+      w = round_xn_over_d(char_width(f,i),  1000 + e, 1000);
+	  set_charinfo_width (co, w);
+      w = round_xn_over_d(char_italic(f,i), 1000 + e, 1000);
+      set_charinfo_italic(co, w);
+      krn = get_charinfo_kerns(co);
+      if (krn != NULL) {
+		while (!kern_end((*krn))) {
+		  kern_kern(*krn) = round_xn_over_d(kern_kern(*krn), 1000 + e, 1000);
+		  krn++;
+		}
+      }
+    }
+  }
+  return k;
+}
+
+void 
+vf_expand_local_fonts(internal_font_number f) {
+  internal_font_number lf;
+  integer k, num;
+  integer *vf_old_fonts;
+  pdfassert(font_type(f) == virtual_font_type);
+  num  = 0;
+  vf_old_fonts = packet_local_fonts(f,&num);
+  if (num>0) {
+    for (k = 0;k<num;k++) {
+      lf = vf_old_fonts[k];
+      set_expand_params(lf, pdf_font_auto_expand(f),
+						pdf_font_expand_ratio(pdf_font_stretch(f)),
+						-pdf_font_expand_ratio(pdf_font_shrink(f)),
+						pdf_font_step(f), pdf_font_expand_ratio(f));
+      if (font_type(lf) == virtual_font_type)
+	vf_expand_local_fonts(lf);
+    }
+    xfree(vf_old_fonts);
+  }
+}
+
+internal_font_number 
+letter_space_font (halfword u, internal_font_number f, integer e) {
+  internal_font_number k;
+  scaled  w, r;
+
+  char *new_font_name;
+  integer vf_z;
+  integer vf_alpha;
+  integer vf_beta;
+  memory_word tmp_w; /* accumulator */
+
+
+  /* read a new font and expand the character widths */
+  k = read_font_info(u, tex_font_name(f), get_nullstr(), font_size(f), font_natural_dir(f));
+  set_no_ligatures(k); /* disable ligatures for letter-spaced fonts */
+/*
+  for (i = 0;i <= font_widths(k);i++) {
+    set_font_width(k,i,font_width(f,i)+round_xn_over_d(quad(k), e, 1000));
+  }
+*/
+  /* append eg '+100ls' to font name */
+  new_font_name = xmalloc(strlen(font_name(k)) + 8); /* |abs(e) <= 1000| */
+  if (e > 0) {
+    sprintf(new_font_name,"%s+%ils",font_name(k),(int)e);
+  } else {
+    /* minus from %i */
+    sprintf(new_font_name,"%s%ils",font_name(k),(int)e);
+  }
+  set_font_name(k, new_font_name);
+  
+  /* create the corresponding virtual font */
+  set_font_type(k,virtual_font_type);
+
+  vf_z = font_size(f);
+  vf_replace_z();
+  w = round_xn_over_d(quad(f), e, 2000);
+  if (w > 0) {
+    tmp_b0 = 0;
+  } else {
+    tmp_b0 = 255;
+    w = vf_alpha + w;
+  }
+  r = w*vf_beta;
+  tmp_b1 = r / vf_z;
+  r = r % vf_z;
+  if (r == 0) {
+    tmp_b2 = 0;
+  } else {
+    r = r * 256;
+    tmp_b2 = r / vf_z;
+    r = r % vf_z;
+  }
+  if (r == 0) {
+    tmp_b3 = 0;
+  } else {
+    r = r * 256;
+    tmp_b3 = r / vf_z;
+  }
+  /*
+  vf_packet_base[k] = new_vf_packet(k);
+
+  for (c=font_bc(k);c<=font_ec(k);c++) {
+    string_room(17); 
+    append_fnt_set(f);
+    append_packet(right1 + 3);
+    append_packet(tmp_b0);
+    append_packet(tmp_b1);
+    append_packet(tmp_b2);
+    append_packet(tmp_b3);
+
+    append_packet(set1);
+    append_packet(c);
+      
+    append_packet(right1 + 3);
+    append_packet(tmp_b0);
+    append_packet(tmp_b1);
+    append_packet(tmp_b2);
+    append_packet(tmp_b3);
+    s = make_string();
+    store_packet(k, c, s);
+    flush_str(s);
+  }
+*/
+  return k;
+}
+
+
diff --git a/Build/source/texk/web2c/luatexdir/font/vfpacket.c b/Build/source/texk/web2c/luatexdir/font/vfpacket.c
new file mode 100644
index 00000000000..4d8445f2227
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/vfpacket.c
@@ -0,0 +1,377 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: vfpacket.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+/*
+  The |do_vf_packet| procedure is called in order to interpret the
+  character packet for a virtual character. Such a packet may contain
+  the instruction to typeset a character from the same or an other
+  virtual font; in such cases |do_vf_packet| calls itself
+  recursively. The recursion level, i.e., the number of times this has
+  happened, is kept in the global variable |packet_cur_s| and should
+  not exceed |packet_max_recursion|.
+*/
+
+#define packet_max_recursion 100
+
+typedef unsigned char packet_stack_index ;  /* an index into the stack */
+
+typedef struct packet_stack_record {
+  scaled stack_h;
+  scaled stack_v;
+} packet_stack_record;
+
+
+static packet_stack_index  packet_cur_s = 0; /* current recursion level */
+static packet_stack_record packet_stack [packet_max_recursion];
+static packet_stack_index  packet_stack_ptr = 0; /* pointer into |packet_stack| */
+
+
+/* Some macros for processing character packets. */
+
+#define do_packet_byte() vf_packets[cur_packet_byte++]
+
+#define packet_number(fw)  {					\
+	fw = do_packet_byte();						\
+	fw = fw*256 + do_packet_byte();				\
+	fw = fw*256 + do_packet_byte();				\
+	fw = fw*256 + do_packet_byte(); }
+
+#define packet_scaled(a,fs) { integer fw;		\
+	fw = do_packet_byte();						\
+	if (fw>127) fw = fw - 256;					\
+	fw = fw*256 + do_packet_byte();				\
+	fw = fw*256 + do_packet_byte();				\
+	fw = fw*256 + do_packet_byte();				\
+    a = sqxfw(fw, fs); }
+
+
+/* count the number of bytes in a command packet */
+int 
+vf_packet_bytes (charinfo *co) {
+  real_eight_bits *vf_packets;
+  integer cur_packet_byte;
+  unsigned k;
+  int cmd;
+
+  vf_packets = get_charinfo_packets(co);
+  if (vf_packets == NULL) {
+    return 0;
+  }
+  cur_packet_byte = 0;
+  while ((cmd = vf_packets[cur_packet_byte]) != packet_end_code) {
+    cur_packet_byte++;
+    switch (cmd) {
+    case packet_char_code: 
+    case packet_font_code:
+    case packet_right_code:
+    case packet_down_code:
+    case packet_node_code:
+	  cur_packet_byte += 4;
+      break;
+    case packet_push_code: 
+    case packet_pop_code:
+      break;
+    case packet_rule_code: 
+	  cur_packet_byte += 8;
+      break;
+    case packet_special_code:
+      packet_number(k); /* +4 */
+	  cur_packet_byte += k;
+      break;
+    case packet_nop_code:
+      break;
+    default: 
+      pdf_error("vf", "invalid DVI command");     
+    }
+  };
+  return (cur_packet_byte +1);
+}
+
+
+/* typeset the \.{DVI} commands in the
+   character packet for character |c| in current font |f| */
+
+char *packet_command_names[] = {  
+  "char", "font","pop",	"push",	"special",
+  "right","down","rule","node", "nop","end", NULL};
+
+
+void 
+do_vf_packet (internal_font_number vf_f, integer c) {
+  internal_font_number lf;
+  charinfo *co;
+  scaled save_cur_h, save_cur_v;
+  real_eight_bits *vf_packets;
+  integer cur_packet_byte;
+  integer cmd, fs_f;
+  scaled i;
+  unsigned k;
+  str_number s;
+
+  packet_cur_s++;
+  if (packet_cur_s >= packet_max_recursion)
+    overflow_string("max level recursion of virtual fonts", packet_max_recursion);
+  save_cur_v = cur_v;
+  save_cur_h = cur_h;
+  
+  lf = 0; /* for -Wall */
+  co = get_charinfo(vf_f,c);
+  vf_packets = get_charinfo_packets(co);
+  if (vf_packets == NULL) {
+    packet_cur_s--;
+    return ;
+  }
+  cur_packet_byte = 0;
+  fs_f = font_size(vf_f);
+  while ((cmd = vf_packets[cur_packet_byte]) != packet_end_code) {
+    cur_packet_byte++;
+    /*
+    if (cmd>packet_end_code) {
+      fprintf(stdout, "do_vf_packet(%i,%i) command code = illegal \n", vf_f,c);
+    } else {
+      fprintf(stdout, "do_vf_packet(%i,%i) command code = %s\n",vf_f, c, packet_command_names[cmd]);
+    }
+    */
+    switch (cmd) {
+    case packet_font_code:
+      packet_number(lf);
+      break;
+    case packet_push_code: 
+      packet_stack[packet_stack_ptr].stack_h = cur_h;
+      packet_stack[packet_stack_ptr].stack_v = cur_v;
+      packet_stack_ptr++;
+      break;
+    case packet_pop_code:
+      packet_stack_ptr--;
+      cur_h = packet_stack[packet_stack_ptr].stack_h;
+      cur_v = packet_stack[packet_stack_ptr].stack_v;
+      break;
+    case packet_char_code: 
+      packet_number(k);
+      if (!char_exists(lf,k)) {
+	char_warning(lf, k);
+      } else {
+	output_one_char(lf, k);
+      }
+      cur_h = cur_h + char_width(lf,k);
+      break;
+    case packet_rule_code: 
+      packet_scaled(rule_ht,fs_f);
+      packet_scaled(rule_wd,fs_f);
+      if ((rule_wd > 0) && (rule_ht > 0)) {
+	pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+	cur_h = cur_h + rule_wd;
+      }
+      break;
+    case packet_right_code:
+      packet_scaled(i,fs_f);
+      cur_h = cur_h + i;
+      break;
+    case packet_down_code:
+	  packet_scaled(i,fs_f);
+      cur_v = cur_v + i;
+      break;
+    case packet_special_code:
+      packet_number(k);
+      string_room(k);
+      while (k > 0) {
+		k--;
+		append_pool_char(do_packet_byte());
+      }
+      s = make_string();
+      literal(s, scan_special, false);
+      flush_str(s);
+      break;
+	case packet_node_code:
+	  packet_number(k);
+	  temp_ptr = k; 
+	  pdf_hlist_out();
+	  break;
+    case packet_nop_code:
+      break;
+    default: 
+      pdf_error("vf", "invalid DVI command");     
+    }
+  };
+  cur_h = save_cur_h;
+  cur_v = save_cur_v;
+  packet_cur_s--;
+}
+
+
+integer *packet_local_fonts(internal_font_number f, integer *num) {
+  int c, cmd, cur_packet_byte, lf, k,l, i;
+  integer localfonts[256] = {0};
+  integer *lfs;
+  charinfo *co;
+  
+  real_eight_bits *vf_packets;
+  k = 0;
+  for (c = font_bc(f);c <= font_ec(f);c++) {
+    if (char_exists(f,c)) {
+      co = get_charinfo(f,c);
+      vf_packets = get_charinfo_packets(co);
+      if (vf_packets == NULL) 
+	continue;
+      cur_packet_byte = 0;
+      while ((cmd = vf_packets[cur_packet_byte]) != packet_end_code) {
+	cur_packet_byte++;
+	switch (cmd) {
+	case packet_font_code:
+	  packet_number(lf);
+	  for (l=0;l<k;l++) {
+	    if (localfonts[l]==lf) {
+	      break;
+	    }
+	  }
+	  if (l==k) {
+	    localfonts[k++]=lf;
+	  }
+	  break;
+	case packet_push_code: 
+	case packet_pop_code:
+	case packet_nop_code:
+	  break;
+	case packet_char_code: 
+	case packet_right_code:
+	case packet_down_code:
+	case packet_node_code:
+	  cur_packet_byte+=4;
+	  break;
+	case packet_rule_code: 
+	  cur_packet_byte+=8;
+	  break;
+	case packet_special_code:
+	  packet_number(i);
+	  while (i-- > 0) 
+	    (void)do_packet_byte();
+	  break;
+	default: 
+	  pdf_error("vf", "invalid DVI command");     
+	}
+      }
+    }
+  }  
+  *num = k;
+  if (k>0) {
+    lfs = xmalloc (k*sizeof(integer));
+    memcpy(lfs,localfonts,k*sizeof(integer));
+    return lfs;
+  }
+  return NULL;
+}
+
+
+void 
+replace_packet_fonts(internal_font_number f, integer *old_fontid, integer *new_fontid, int count) {
+  int c, cmd, cur_packet_byte, lf, k,l;
+  charinfo *co;
+  real_eight_bits *vf_packets;
+
+  k = 0;
+  for (c = font_bc(f);c <= font_ec(f);c++) {
+    if (char_exists(f,c)) {
+      co = get_charinfo(f,c);
+      vf_packets = get_charinfo_packets(co);
+      if (vf_packets == NULL) 
+	continue;
+      cur_packet_byte = 0;
+      while ((cmd = vf_packets[cur_packet_byte]) != packet_end_code) {
+	cur_packet_byte++;
+	switch (cmd) {
+	case packet_font_code:
+	  packet_number(lf);
+	  for (l=0;l<count;l++) {
+	    if (old_fontid[l]==lf) {
+	      break;
+	    }
+	  }
+	  if(l<count) {
+	    k = new_fontid[l];
+	    vf_packets[(cur_packet_byte-4)] = (k&0xFF000000)>>24;
+	    vf_packets[(cur_packet_byte-3)] = (k&0x00FF0000)>>16;
+	    vf_packets[(cur_packet_byte-2)] = (k&0x0000FF00)>>8;
+	    vf_packets[(cur_packet_byte-1)] = (k&0x000000FF);
+	  }
+	  break;
+	case packet_push_code: 
+	case packet_pop_code:
+	case packet_nop_code:
+	  break;
+	case packet_char_code: 
+	case packet_right_code:
+	case packet_down_code:
+	case packet_node_code:
+	  cur_packet_byte+=4;
+	  break;
+	case packet_rule_code: 
+	  cur_packet_byte+=8;
+	  break;
+	case packet_special_code:
+	  packet_number(k);
+	  while (k-- > 0) 
+	    (void)do_packet_byte();
+	  break;
+	default: 
+	  pdf_error("vf", "invalid DVI command");     
+	}
+      }
+    }
+  }  
+}
+
+/* this function was copied/borrowed/stolen from dvipdfm code */
+
+scaled sqxfw (scaled sq, integer fw)
+{
+  int sign = 1;
+  unsigned long a, b, c, d, ad, bd, bc, ac;
+  unsigned long e, f, g, h, i, j, k;
+  unsigned long result;
+  /* Make positive. */
+  if (sq < 0) {
+    sign = -sign;
+    sq = -sq;
+  }
+  if (fw < 0) {
+    sign = -sign;
+    fw = -fw;
+  }
+  a = ((unsigned long) sq) >> 16u;
+  b = ((unsigned long) sq) & 0xffffu;
+  c = ((unsigned long) fw) >> 16u;
+  d = ((unsigned long) fw) & 0xffffu;
+  ad = a*d; bd = b*d; bc = b*c; ac = a*c;
+  e = bd >> 16u;
+  f = ad >> 16u;
+  g = ad & 0xffffu;
+  h = bc >> 16u;
+  i = bc & 0xffffu;
+  j = ac >> 16u;
+  k = ac & 0xffffu;
+  result = (e+g+i + (1<<3)) >> 4u;  /* 1<<3 is for rounding */
+  result += (f+h+k) << 12u;
+  result += j << 28u;
+  return (sign>0)?result:-result;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/writecff.c b/Build/source/texk/web2c/luatexdir/font/writecff.c
new file mode 100644
index 00000000000..69c35c6950e
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writecff.c
@@ -0,0 +1,3381 @@
+/*
+Copyright (c) 2007 Taco Hoekwater, taco@luatex.org
+
+This file is part of luaTeX.
+
+luaTeX 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.
+
+luaTeX 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 luaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writecff.c 1021 2008-02-14 10:24:34Z taco $
+*/
+
+#include "ptexlib.h"
+
+#include "writecff.h"
+
+#define get_offset(s,n) get_unsigned(s, (n))
+#define get_card8(a)  a->stream[a->offset++]
+#define get_card16(a) get_unsigned(a,2)
+
+#undef b0
+#undef b1
+#undef b2
+#undef b3
+
+#define WORK_BUFFER_SIZE 1024
+
+static char work_buffer[WORK_BUFFER_SIZE];
+
+static unsigned long get_unsigned (cff_font *cff, int n)
+{
+  unsigned long v = 0;
+  while (n-- > 0)
+    v = v*256 + get_card8(cff);
+  return v;
+}
+
+#define CFF_ERROR pdftex_fail
+#define WARN pdftex_warn
+
+
+const char *const cff_stdstr[CFF_STDSTR_MAX] = {
+  ".notdef", "space", "exclam", "quotedbl", "numbersign",
+  "dollar", "percent", "ampersand", "quoteright", "parenleft",
+  "parenright", "asterisk", "plus", "comma", "hyphen",
+  "period", "slash", "zero", "one", "two",
+  "three", "four", "five", "six", "seven",
+  "eight", "nine", "colon", "semicolon", "less",
+  "equal", "greater", "question", "at", "A",
+  "B", "C", "D", "E", "F",
+  "G", "H", "I", "J", "K",
+  "L", "M", "N", "O", "P",
+  "Q", "R", "S", "T", "U",
+  "V", "W", "X", "Y", "Z",
+  "bracketleft", "backslash", "bracketright", "asciicircum", "underscore",
+  "quoteleft", "a", "b", "c", "d",
+  "e", "f", "g", "h", "i",
+  "j", "k", "l", "m", "n",
+  "o", "p", "q", "r", "s",
+  "t", "u", "v", "w", "x",
+  "y", "z", "braceleft", "bar", "braceright",
+  "asciitilde", "exclamdown", "cent", "sterling", "fraction",
+  "yen", "florin", "section", "currency", "quotesingle",
+  "quotedblleft", "guillemotleft", "guilsinglleft", "guilsinglright", "fi",
+  "fl", "endash", "dagger", "daggerdbl", "periodcentered",
+  "paragraph", "bullet", "quotesinglbase", "quotedblbase", "quotedblright",
+  "guillemotright", "ellipsis", "perthousand", "questiondown", "grave",
+  "acute", "circumflex", "tilde", "macron", "breve",
+  "dotaccent", "dieresis", "ring", "cedilla", "hungarumlaut",
+  "ogonek", "caron", "emdash", "AE", "ordfeminine",
+  "Lslash", "Oslash", "OE", "ordmasculine", "ae",
+  "dotlessi", "lslash", "oslash", "oe", "germandbls",
+  "onesuperior", "logicalnot", "mu", "trademark", "Eth",
+  "onehalf", "plusminus", "Thorn", "onequarter", "divide",
+  "brokenbar", "degree", "thorn", "threequarters", "twosuperior",
+  "registered", "minus", "eth", "multiply", "threesuperior",
+  "copyright", "Aacute", "Acircumflex", "Adieresis", "Agrave",
+  "Aring", "Atilde", "Ccedilla", "Eacute", "Ecircumflex",
+  "Edieresis", "Egrave", "Iacute", "Icircumflex", "Idieresis",
+  "Igrave", "Ntilde", "Oacute", "Ocircumflex", "Odieresis",
+  "Ograve", "Otilde", "Scaron", "Uacute", "Ucircumflex",
+  "Udieresis", "Ugrave", "Yacute", "Ydieresis", "Zcaron",
+  "aacute", "acircumflex", "adieresis", "agrave", "aring",
+  "atilde", "ccedilla", "eacute", "ecircumflex", "edieresis",
+  "egrave", "iacute", "icircumflex", "idieresis", "igrave",
+  "ntilde", "oacute", "ocircumflex", "odieresis", "ograve",
+  "otilde", "scaron", "uacute", "ucircumflex", "udieresis",
+  "ugrave", "yacute", "ydieresis", "zcaron", "exclamsmall",
+  "Hungarumlautsmall", "dollaroldstyle", "dollarsuperior", "ampersandsmall", "Acutesmall",
+  "parenleftsuperior", "parenrightsuperior", "twodotenleader", "onedotenleader", "zerooldstyle",
+  "oneoldstyle", "twooldstyle", "threeoldstyle", "fouroldstyle", "fiveoldstyle",
+  "sixoldstyle", "sevenoldstyle", "eightoldstyle", "nineoldstyle", "commasuperior",
+  "threequartersemdash", "periodsuperior", "questionsmall", "asuperior", "bsuperior",
+  "centsuperior", "dsuperior", "esuperior", "isuperior", "lsuperior",
+  "msuperior", "nsuperior", "osuperior", "rsuperior", "ssuperior",
+  "tsuperior", "ff", "ffi", "ffl", "parenleftinferior",
+  "parenrightinferior", "Circumflexsmall", "hyphensuperior", "Gravesmall", "Asmall",
+  "Bsmall", "Csmall", "Dsmall", "Esmall", "Fsmall",
+  "Gsmall", "Hsmall", "Ismall", "Jsmall", "Ksmall",
+  "Lsmall", "Msmall", "Nsmall", "Osmall", "Psmall",
+  "Qsmall", "Rsmall", "Ssmall", "Tsmall", "Usmall",
+  "Vsmall", "Wsmall", "Xsmall", "Ysmall", "Zsmall",
+  "colonmonetary", "onefitted", "rupiah", "Tildesmall", "exclamdownsmall",
+  "centoldstyle", "Lslashsmall", "Scaronsmall", "Zcaronsmall", "Dieresissmall",
+  "Brevesmall", "Caronsmall", "Dotaccentsmall", "Macronsmall", "figuredash",
+  "hypheninferior", "Ogoneksmall", "Ringsmall", "Cedillasmall", "questiondownsmall",
+  "oneeighth", "threeeighths", "fiveeighths", "seveneighths", "onethird",
+  "twothirds", "zerosuperior", "foursuperior", "fivesuperior", "sixsuperior",
+  "sevensuperior", "eightsuperior", "ninesuperior", "zeroinferior", "oneinferior",
+  "twoinferior", "threeinferior", "fourinferior", "fiveinferior", "sixinferior",
+  "seveninferior", "eightinferior", "nineinferior", "centinferior", "dollarinferior",
+  "periodinferior", "commainferior", "Agravesmall", "Aacutesmall", "Acircumflexsmall",
+  "Atildesmall", "Adieresissmall", "Aringsmall", "AEsmall", "Ccedillasmall",
+  "Egravesmall", "Eacutesmall", "Ecircumflexsmall", "Edieresissmall", "Igravesmall",
+  "Iacutesmall", "Icircumflexsmall", "Idieresissmall", "Ethsmall", "Ntildesmall",
+  "Ogravesmall", "Oacutesmall", "Ocircumflexsmall", "Otildesmall", "Odieresissmall",
+  "OEsmall", "Oslashsmall", "Ugravesmall", "Uacutesmall", "Ucircumflexsmall",
+  "Udieresissmall", "Yacutesmall", "Thornsmall", "Ydieresissmall",
+  "001.000", "001.001", "001.002", "001.003",
+  "Black", "Bold", "Book", "Light", "Medium", "Regular", "Roman", "Semibold"
+};
+
+
+/* Only read header part but not body */
+cff_index *
+cff_get_index_header (cff_font *cff)
+{
+  cff_index *idx;
+  card16     i, count;
+
+  idx = xcalloc(1, sizeof(cff_index));
+
+  idx->count = count = get_card16(cff);
+  if (count > 0) {
+    idx->offsize = get_card8(cff);
+    if (idx->offsize < 1 || idx->offsize > 4)
+      CFF_ERROR("invalid offsize data");
+
+    idx->offset = xcalloc(count+1, sizeof(l_offset));
+    for (i=0;i<count+1;i++) {
+      (idx->offset)[i] = get_offset(cff, idx->offsize);
+    }
+
+    if (idx->offset[0] != 1)
+      CFF_ERROR("cff_get_index(): invalid index data");
+
+    idx->data = NULL;
+  } else {
+    idx->offsize = 0;
+    idx->offset = NULL;
+    idx->data = NULL;
+  }
+
+  return idx;
+}
+
+
+
+cff_index *
+cff_get_index (cff_font *cff)
+{
+  cff_index *idx;
+  card16     i, count;
+  long       length;
+
+  idx = xcalloc(1,sizeof(cff_index));
+
+  idx->count = count = get_card16(cff);
+  if (count > 0) {
+    idx->offsize = get_card8(cff);
+    if (idx->offsize < 1 || idx->offsize > 4)
+      CFF_ERROR("invalid offsize data");
+
+    idx->offset = xcalloc((count + 1),sizeof(l_offset));
+    for (i = 0 ; i < count + 1; i++) {
+      idx->offset[i] = get_offset(cff, idx->offsize);
+    }
+
+    if (idx->offset[0] != 1)
+      CFF_ERROR("Invalid CFF Index offset data");
+
+    length = idx->offset[count] - idx->offset[0];
+
+    idx->data = xcalloc(length,sizeof(card8));
+    memcpy(idx->data,&cff->stream[cff->offset],length);
+    cff->offset += length;
+
+  } else {
+    idx->offsize = 0;
+    idx->offset  = NULL;
+    idx->data    = NULL;
+  }
+  return idx;
+}
+
+
+long
+cff_pack_index (cff_index *idx, card8 *dest, long destlen)
+{
+  long    len = 0;
+  unsigned long    datalen;
+  card16  i;
+
+  if (idx->count < 1) {
+    if (destlen < 2)
+      CFF_ERROR("Not enough space available...");
+    memset(dest, 0, 2);
+    return 2;
+  }
+
+  len     = cff_index_size(idx);
+  datalen = idx->offset[idx->count] - 1;
+
+  if (destlen < len)
+    CFF_ERROR("Not enough space available...");
+
+  *(dest++) = (idx->count >> 8) & 0xff;
+  *(dest++) = idx->count & 0xff;
+
+  if (datalen < 0xffUL) {
+    idx->offsize = 1;
+    *(dest++)    = 1;
+    for (i = 0; i <= idx->count; i++) {
+      *(dest++) = (card8) (idx->offset[i] & 0xff);
+    }
+  } else if (datalen < 0xffffUL) {
+    idx->offsize = 2;
+    *(dest++)    = 2;
+    for (i = 0; i <= idx->count; i++) {
+      *(dest++) = (card8) ((idx->offset[i] >> 8) & 0xff);
+      *(dest++) = (card8) ( idx->offset[i] & 0xff);
+    }
+  } else if (datalen < 0xffffffUL) {
+    idx->offsize = 3;
+    *(dest++)    = 3;
+    for (i = 0; i <= idx->count; i++) {
+      *(dest++) = (card8)((idx->offset[i] >> 16) & 0xff);
+      *(dest++) = (card8)((idx->offset[i] >> 8) & 0xff);
+      *(dest++) = (card8)(idx->offset[i] & 0xff);
+    }
+  } else {
+    idx->offsize = 4;
+    *(dest++)    = 4;
+    for (i = 0; i <= idx->count; i++) {
+      *(dest++) = (card8)((idx->offset[i] >> 24) & 0xff);
+      *(dest++) = (card8)((idx->offset[i] >> 16) & 0xff);
+      *(dest++) = (card8)((idx->offset[i] >> 8) & 0xff);
+      *(dest++) = (card8)(idx->offset[i] & 0xff);
+    }
+  }
+
+  memmove(dest, idx->data, idx->offset[idx->count] - 1);
+
+  return len;
+}
+
+long
+cff_index_size (cff_index *idx)
+{
+  if (idx->count > 0) {
+    l_offset datalen;
+
+    datalen = idx->offset[idx->count] - 1;
+    if (datalen < 0xffUL) {
+      idx->offsize = 1;
+    } else if (datalen < 0xffffUL) {
+      idx->offsize = 2;
+    } else if (datalen < 0xffffffUL) {
+      idx->offsize = 3;
+    } else {
+      idx->offsize = 4;
+    }
+    return (3 + (idx->offsize)*(idx->count + 1) + datalen);
+  } else {
+    return 2;
+  }
+}
+
+cff_index *cff_new_index (card16 count)
+{
+  cff_index *idx;
+
+  idx = xcalloc(1, sizeof(cff_index));
+  idx->count = count;
+  idx->offsize = 0;
+
+  if (count > 0) {
+    idx->offset = xcalloc(count + 1, sizeof(l_offset));
+    (idx->offset)[0] = 1;
+  } else {
+    idx->offset = NULL;
+  }
+  idx->data = NULL;
+
+  return idx;
+}
+
+
+void cff_release_index (cff_index *idx)
+{
+  if (idx) {
+    xfree(idx->data);
+    xfree(idx->offset);
+    xfree(idx);
+  }
+}
+
+void cff_release_dict (cff_dict *dict)
+{
+  if (dict) {
+    if (dict->entries) {
+      int i;
+      for (i=0;i<dict->count;i++) {
+	xfree((dict->entries)[i].values);
+      }
+      xfree(dict->entries);
+    }
+    xfree(dict);
+  }
+}
+
+
+void cff_release_encoding (cff_encoding *encoding)
+{
+  if (encoding) {
+    switch (encoding->format & (~0x80)) {
+    case 0: xfree(encoding->data.codes);      break;
+    case 1: xfree(encoding->data.range1);     break;
+    default:  CFF_ERROR("Unknown Encoding format.");
+    }
+    if (encoding->format & 0x80) 
+      xfree(encoding->supp);
+    xfree(encoding);
+  }
+}
+
+void
+cff_release_charsets (cff_charsets *charset)
+{
+  if (charset) {
+    switch (charset->format) {
+    case 0: xfree(charset->data.glyphs);   break;
+    case 1: xfree(charset->data.range1);   break;
+    case 2: xfree(charset->data.range2);   break;
+    default:    break;
+    }
+    xfree(charset);
+  }
+}
+
+void cff_release_fdselect (cff_fdselect *fdselect)
+{
+  if (fdselect) {
+    if (fdselect->format == 0) {         xfree(fdselect->data.fds); }
+    else if (fdselect->format == 3) {    xfree(fdselect->data.ranges); }
+    xfree(fdselect);
+  }
+}
+
+
+void
+cff_close (cff_font *cff)
+{
+  card16 i;
+
+  if (cff) {
+    if (cff->fontname) xfree(cff->fontname);
+    if (cff->name) cff_release_index(cff->name);
+    if (cff->topdict) cff_release_dict(cff->topdict);
+    if (cff->string) cff_release_index(cff->string);
+    if (cff->gsubr) cff_release_index(cff->gsubr);
+    if (cff->encoding) cff_release_encoding(cff->encoding);
+    if (cff->charsets) cff_release_charsets(cff->charsets);
+    if (cff->fdselect) cff_release_fdselect(cff->fdselect);
+    if (cff->cstrings) cff_release_index(cff->cstrings);
+    if (cff->fdarray) {
+      for (i=0;i<cff->num_fds;i++) {
+	if (cff->fdarray[i]) cff_release_dict(cff->fdarray[i]);
+      }
+      xfree(cff->fdarray);
+    }
+    if (cff->private) {
+      for (i=0;i<cff->num_fds;i++) {
+	if (cff->private[i]) cff_release_dict(cff->private[i]);
+      }
+      xfree(cff->private);
+    }
+    if (cff->subrs) {
+      for (i=0;i<cff->num_fds;i++) {
+	if (cff->subrs[i]) cff_release_index(cff->subrs[i]);
+      }
+      xfree(cff->subrs);
+    }
+    if (cff->_string)
+      cff_release_index(cff->_string);
+    xfree(cff);
+  }
+
+  return;
+}
+
+char *
+cff_get_name (cff_font *cff)
+{
+  char      *fontname;
+  l_offset   len;
+  cff_index *idx;
+
+  idx = cff->name;
+  len = idx->offset[cff->index + 1] - idx->offset[cff->index];
+  fontname = xmalloc((len + 1)*sizeof(char));
+  memcpy(fontname, idx->data + idx->offset[cff->index] - 1, len);
+  fontname[len] = '\0';
+
+  return fontname;
+}
+
+
+long
+cff_set_name (cff_font *cff, char *name)
+{
+  cff_index *idx;
+
+  if (strlen(name) > 127)
+    CFF_ERROR("FontName string length too large...");
+
+  if (cff->name)
+    cff_release_index(cff->name);
+
+  cff->name = idx = xcalloc(1, sizeof(cff_index));
+  idx->count   = 1;
+  idx->offsize = 1;
+  idx->offset  = xmalloc(2*sizeof(l_offset));
+  (idx->offset)[0] = 1;
+  (idx->offset)[1] = strlen(name) + 1;
+  idx->data = xcalloc(strlen(name), sizeof(card8));
+  memmove(idx->data, name, strlen(name)); /* no trailing '\0' */
+
+  return 5 + strlen(name);
+}
+
+long
+cff_put_header (cff_font *cff, card8 *dest, long destlen)
+{
+  if (destlen < 4)
+    CFF_ERROR("Not enough space available...");
+
+  *(dest++) = cff->header_major;
+  *(dest++) = cff->header_minor;
+  *(dest++) = 4; /* Additional data in between header and
+		  * Name INDEX ignored.
+		  */
+  /* We will set all offset (0) to four-byte integer. */
+  *(dest++) = 4;
+  cff->header_offsize = 4;
+
+  return 4;
+}
+
+#define CFF_PARSE_OK                0
+#define CFF_CFF_ERROR_PARSE_CFF_ERROR      -1
+#define CFF_CFF_ERROR_STACK_OVERFLOW   -2
+#define CFF_CFF_ERROR_STACK_UNDERFLOW  -3
+#define CFF_CFF_ERROR_STACK_RANGECHECK -4
+
+#define DICT_ENTRY_MAX 16
+
+cff_dict *cff_new_dict (void)
+{
+  cff_dict *dict;
+
+  dict = xcalloc(1, sizeof(cff_dict));
+  dict->max     = DICT_ENTRY_MAX;
+  dict->count   = 0;
+  dict->entries = xcalloc(dict->max, sizeof(cff_dict_entry));
+  return dict;
+}
+
+/*
+ * Operand stack:
+ *  only numbers are stored (as double)
+ *
+ * Operand types:
+ *
+ * number : double (integer or real)
+ * boolean: stored as a number
+ * SID    : stored as a number
+ * array  : array of numbers
+ * delta  : array of numbers
+ */
+
+#define CFF_DICT_STACK_LIMIT 64
+static int    stack_top = 0;
+static double arg_stack[CFF_DICT_STACK_LIMIT];
+
+/*
+ * CFF DICT encoding:
+ * TODO: default values
+ */
+
+#define CFF_LAST_DICT_OP1 22
+#define CFF_LAST_DICT_OP2 39
+#define CFF_LAST_DICT_OP (CFF_LAST_DICT_OP1 + CFF_LAST_DICT_OP2)
+
+static struct {
+  const char *opname;
+  int   argtype;
+} dict_operator[CFF_LAST_DICT_OP] = {
+  {"version",     CFF_TYPE_SID},
+  {"Notice",      CFF_TYPE_SID},
+  {"FullName",    CFF_TYPE_SID},
+  {"FamilyName",  CFF_TYPE_SID},
+  {"Weight",      CFF_TYPE_SID},
+  {"FontBBox",    CFF_TYPE_ARRAY},
+  {"BlueValues",       CFF_TYPE_DELTA},
+  {"OtherBlues",       CFF_TYPE_DELTA},
+  {"FamilyBlues",      CFF_TYPE_DELTA},
+  {"FamilyOtherBlues", CFF_TYPE_DELTA},
+  {"StdHW",            CFF_TYPE_NUMBER},
+  {"StdVW",            CFF_TYPE_NUMBER},
+  {NULL, -1},  /* first byte of two-byte operator */
+  /* Top */
+  {"UniqueID",    CFF_TYPE_NUMBER},
+  {"XUID",        CFF_TYPE_ARRAY},
+  {"charset",     CFF_TYPE_OFFSET},
+  {"Encoding",    CFF_TYPE_OFFSET},
+  {"CharStrings", CFF_TYPE_OFFSET},
+  {"Private",     CFF_TYPE_SZOFF}, /* two numbers (size and offset) */
+  /* Private */
+  {"Subrs",         CFF_TYPE_OFFSET},
+  {"defaultWidthX", CFF_TYPE_NUMBER},
+  {"nominalWidthX", CFF_TYPE_NUMBER},
+  /* Operator 2 */
+  {"Copyright",          CFF_TYPE_SID},
+  {"IsFixedPitch",       CFF_TYPE_BOOLEAN},
+  {"ItalicAngle",        CFF_TYPE_NUMBER},
+  {"UnderlinePosition",  CFF_TYPE_NUMBER},
+  {"UnderlineThickness", CFF_TYPE_NUMBER},
+  {"PaintType",      CFF_TYPE_NUMBER},
+  {"CharstringType", CFF_TYPE_NUMBER},
+  {"FontMatrix",     CFF_TYPE_ARRAY},
+  {"StrokeWidth",    CFF_TYPE_NUMBER},
+  {"BlueScale", CFF_TYPE_NUMBER},
+  {"BlueShift", CFF_TYPE_NUMBER},
+  {"BlueFuzz",  CFF_TYPE_NUMBER},
+  {"StemSnapH", CFF_TYPE_DELTA},
+  {"StemSnapV", CFF_TYPE_DELTA},
+  {"ForceBold", CFF_TYPE_BOOLEAN},
+  {NULL, -1},
+  {NULL, -1},
+  {"LanguageGroup",     CFF_TYPE_NUMBER},
+  {"ExpansionFactor",   CFF_TYPE_NUMBER},
+  {"InitialRandomSeed", CFF_TYPE_NUMBER},
+  {"SyntheticBase", CFF_TYPE_NUMBER},
+  {"PostScript",    CFF_TYPE_SID},
+  {"BaseFontName",  CFF_TYPE_SID},
+  {"BaseFontBlend", CFF_TYPE_DELTA}, /* MMaster ? */
+  {NULL, -1},
+  {NULL, -1},
+  {NULL, -1},
+  {NULL, -1},
+  {NULL, -1},
+  {NULL, -1},
+  /* CID-Keyed font */
+  {"ROS",             CFF_TYPE_ROS}, /* SID SID number */
+  {"CIDFontVersion",  CFF_TYPE_NUMBER},
+  {"CIDFontRevision", CFF_TYPE_NUMBER},
+  {"CIDFontType",     CFF_TYPE_NUMBER},
+  {"CIDCount",        CFF_TYPE_NUMBER},
+  {"UIDBase",         CFF_TYPE_NUMBER},
+  {"FDArray",         CFF_TYPE_OFFSET},
+  {"FDSelect",        CFF_TYPE_OFFSET},
+  {"FontName",        CFF_TYPE_SID},
+};
+
+/* Parse DICT data */
+static double get_integer (card8 **data, card8 *endptr, int *status)
+{
+  long result = 0;
+  card8 b0, b1, b2;
+
+  b0 = *(*data)++;
+  if (b0 == 28 && *data < endptr - 2) { /* shortint */
+    b1 = *(*data)++;
+    b2 = *(*data)++;
+    result = b1*256+b2;
+    if (result > 0x7fffL)
+      result -= 0x10000L;
+  } else if (b0 == 29 && *data < endptr - 4) { /* longint */
+    int i;
+    result = *(*data)++;
+    if (result > 0x7f)
+      result -= 0x100;
+    for (i=0;i<3;i++) {
+      result = result*256+(**data);
+      *data += 1;
+    }
+  } else if (b0 >= 32 && b0 <= 246) { /* int (1) */
+    result = b0 - 139;
+  } else if (b0 >= 247 && b0 <= 250) { /* int (2) */
+    b1 = *(*data)++;
+    result = (b0-247)*256+b1+108;
+  } else if (b0 >= 251 && b0 <= 254) {
+    b1 = *(*data)++;
+    result = -(b0-251)*256-b1-108;
+  } else {
+    *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+  }
+
+  return (double) result;
+}
+
+/* Simply uses strtod */
+static double get_real(card8 **data, card8 *endptr, int *status)
+{
+  double result = 0.0;
+  int nibble = 0, pos = 0;
+  int len = 0, fail = 0;
+
+  if (**data != 30 || *data >= endptr -1) {
+    *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+    return 0.0;
+  }
+
+  *data += 1; /* skip first byte (30) */
+
+  pos = 0;
+  while ((! fail) && len < WORK_BUFFER_SIZE - 2 && *data < endptr) {
+    /* get nibble */
+    if (pos % 2) {
+      nibble = **data & 0x0f;
+      *data += 1;
+    } else {
+      nibble = (**data >> 4) & 0x0f;
+    }
+    if (nibble >= 0x00 && nibble <= 0x09) {
+      work_buffer[len++] = nibble + '0';
+    } else if (nibble == 0x0a) { /* . */
+      work_buffer[len++] = '.';
+    } else if (nibble == 0x0b || nibble == 0x0c) { /* E, E- */
+      work_buffer[len++] = 'e';
+      if (nibble == 0x0c)
+	work_buffer[len++] = '-';
+    } else if (nibble == 0x0e) { /* `-' */
+      work_buffer[len++] = '-';
+    } else if (nibble == 0x0d) { /* skip */
+      /* do nothing */
+    } else if (nibble == 0x0f) { /* end */
+      work_buffer[len++] = '\0';
+      if (((pos % 2) == 0) && (**data != 0xff)) {
+	fail = 1;
+      }
+      break;
+    } else { /* invalid */
+      fail = 1;
+    }
+    pos++;
+  }
+
+  /* returned values */
+  if (fail || nibble != 0x0f) {
+    *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+  } else {
+    char *s;
+    result = strtod(work_buffer, &s);
+    if (*s != 0 || errno == ERANGE) {
+      *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+    }
+  }
+
+  return result;
+}
+
+/* operators */
+static void add_dict (cff_dict *dict,
+		      card8 **data, card8 *endptr, int *status)
+{
+  int id, argtype;
+
+  id = **data;
+  if (id == 0x0c) {
+    *data += 1;
+    if (*data >= endptr ||
+	(id = **data + CFF_LAST_DICT_OP1) >= CFF_LAST_DICT_OP) {
+      *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+      return;
+    }
+  } else if (id >= CFF_LAST_DICT_OP1) {
+    *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+    return;
+  }
+
+  argtype = dict_operator[id].argtype;
+  if (dict_operator[id].opname == NULL || argtype < 0) {
+    *status = CFF_CFF_ERROR_PARSE_CFF_ERROR;
+    return;
+  } else if (stack_top < 1) {
+    *status = CFF_CFF_ERROR_STACK_UNDERFLOW;
+    return;
+  }
+
+  if (dict->count >= dict->max) {
+    dict->max += DICT_ENTRY_MAX;
+    /* not zeroed! */
+    dict->entries = xrealloc(dict->entries, dict->max*sizeof(cff_dict_entry));
+  }
+
+  (dict->entries)[dict->count].id = id;
+  (dict->entries)[dict->count].key = (char *) dict_operator[id].opname;
+  if (argtype == CFF_TYPE_NUMBER ||
+      argtype == CFF_TYPE_BOOLEAN ||
+      argtype == CFF_TYPE_SID ||
+      argtype == CFF_TYPE_OFFSET) {
+    stack_top--;
+    (dict->entries)[dict->count].count  = 1;
+    (dict->entries)[dict->count].values = xcalloc(1, sizeof(double));
+    (dict->entries)[dict->count].values[0] = arg_stack[stack_top];
+  } else {
+    (dict->entries)[dict->count].count  = stack_top;
+    (dict->entries)[dict->count].values = xcalloc(stack_top, sizeof(double));
+    while (stack_top > 0) {
+      stack_top--;
+      (dict->entries)[dict->count].values[stack_top] = arg_stack[stack_top];
+    }
+  }
+
+  dict->count += 1;
+  *data += 1;
+
+  return;
+}
+
+/*
+ * All operands are treated as number or array of numbers.
+ *  Private: two numbers, size and offset
+ *  ROS    : three numbers, SID, SID, and a number
+ */
+cff_dict *cff_dict_unpack (card8 *data, card8 *endptr)
+{
+  cff_dict *dict;
+  int status = CFF_PARSE_OK;
+
+  stack_top = 0;
+
+  dict = cff_new_dict();
+  while (data < endptr && status == CFF_PARSE_OK) {
+    if (*data < 22) { /* operator */
+      add_dict(dict, &data, endptr, &status);
+    } else if (*data == 30) { /* real - First byte of a sequence (variable) */
+      if (stack_top < CFF_DICT_STACK_LIMIT) {
+	arg_stack[stack_top] = get_real(&data, endptr, &status);
+	stack_top++;
+      } else {
+	status = CFF_CFF_ERROR_STACK_OVERFLOW;
+      }
+    } else if (*data == 255 || (*data >= 22 && *data <= 27)) { /* reserved */
+      data++;
+    } else { /* everything else are integer */
+      if (stack_top < CFF_DICT_STACK_LIMIT) {
+	arg_stack[stack_top] = get_integer(&data, endptr, &status);
+	stack_top++;
+      } else {
+	status = CFF_CFF_ERROR_STACK_OVERFLOW;
+      }
+    }
+  }
+
+  if (status != CFF_PARSE_OK) {
+    pdftex_fail("Parsing CFF DICT failed. (error=%d)", status);
+  } else if (stack_top != 0) {
+    WARN("Garbage in CFF DICT data.");
+    stack_top = 0;
+  }
+
+  return dict;
+}
+
+
+int cff_dict_known (cff_dict *dict, const char *key)
+{
+  int i;
+
+  for (i = 0; i < dict->count; i++) {
+    if (key && strcmp(key, (dict->entries)[i].key) == 0
+	&& (dict->entries)[i].count > 0)
+      return 1;
+  }
+
+  return 0;
+}
+
+double cff_dict_get (cff_dict *dict, const char *key, int idx)
+{
+  double value = 0.0;
+  int    i;
+
+  assert(key && dict);
+
+  for (i = 0; i < dict->count; i++) {
+    if (strcmp(key, (dict->entries)[i].key) == 0) {
+      if ((dict->entries)[i].count > idx)
+	value = (dict->entries)[i].values[idx];
+      else
+	pdftex_fail("Invalid index number.");
+      break;
+    }
+  }
+
+  if (i == dict->count)
+    pdftex_fail("DICT entry \"%s\" not found.", key);
+
+  return value;
+}
+
+card8 cff_fdselect_lookup (cff_font *cff, card16 gid)
+{
+  card8 fd = 0xff;
+  cff_fdselect *fdsel;
+
+  if (cff->fdselect == NULL)
+    CFF_ERROR("in cff_fdselect_lookup(): FDSelect not available");
+
+  fdsel = cff->fdselect;
+
+  if (gid >= cff->num_glyphs)
+    CFF_ERROR("in cff_fdselect_lookup(): Invalid glyph index");
+
+  switch (fdsel->format) {
+  case 0:
+    fd = fdsel->data.fds[gid];
+    break;
+  case 3:
+    {
+      if (gid == 0) {
+	fd = (fdsel->data).ranges[0].fd;
+      } else {
+	card16 i;
+	for (i=1;i<(fdsel->num_entries);i++) {
+	  if (gid < (fdsel->data).ranges[i].first)
+	    break;
+	}
+	fd = (fdsel->data).ranges[i-1].fd;
+      }
+    }
+    break;
+  default:
+    CFF_ERROR("in cff_fdselect_lookup(): Invalid FDSelect format");
+    break;
+  }
+
+  if (fd >= cff->num_fds)
+    CFF_ERROR("in cff_fdselect_lookup(): Invalid Font DICT index");
+
+  return fd;
+}
+
+long cff_read_subrs (cff_font *cff)
+{
+  long len = 0;
+  long offset;
+  int i;
+
+  
+  if ((cff->flag & FONTTYPE_CIDFONT) && cff->fdselect == NULL) {
+    cff_read_fdselect(cff);
+  }
+  
+  if ((cff->flag & FONTTYPE_CIDFONT) && cff->fdarray == NULL) {
+    cff_read_fdarray(cff);
+  }
+
+  if (cff->private == NULL)
+    cff_read_private(cff);
+
+  if (cff->gsubr == NULL) {
+    cff->offset = cff->gsubr_offset;
+    cff->gsubr = cff_get_index(cff);
+  }
+    
+  cff->subrs = xcalloc(cff->num_fds, sizeof(cff_index *));
+  if (cff->flag & FONTTYPE_CIDFONT) {
+    for (i=0;i<cff->num_fds;i++) {
+      if (cff->private[i] == NULL ||
+	  !cff_dict_known(cff->private[i], "Subrs")) {
+	(cff->subrs)[i] = NULL;
+      } else {
+	offset = (long) cff_dict_get(cff->fdarray[i], "Private", 1);
+	offset += (long) cff_dict_get(cff->private[i], "Subrs", 0);
+	cff->offset = offset;
+	(cff->subrs)[i] = cff_get_index(cff);
+	len += cff_index_size((cff->subrs)[i]);
+      }
+    }
+  } else {
+    if (cff->private[0] == NULL ||
+	!cff_dict_known(cff->private[0], "Subrs")) {
+      (cff->subrs)[0] = NULL;
+    } else {
+      offset = (long) cff_dict_get(cff->topdict, "Private", 1);
+      offset += (long) cff_dict_get(cff->private[0], "Subrs", 0);
+      cff->offset = offset;
+      (cff->subrs)[0] = cff_get_index(cff);
+      len += cff_index_size((cff->subrs)[0]);
+    }
+  }
+
+  return len;
+}
+
+
+long cff_read_fdarray (cff_font *cff)
+{
+  long len = 0;
+  cff_index *idx;
+  long offset, size;
+  card16 i;
+
+  if (cff->topdict == NULL)
+    CFF_ERROR("in cff_read_fdarray(): Top DICT not found");
+
+  if (!(cff->flag & FONTTYPE_CIDFONT))
+    return 0;
+
+  /* must exist */
+  offset = (long) cff_dict_get(cff->topdict, "FDArray", 0);
+  cff->offset = offset;
+  idx = cff_get_index(cff);
+  cff->num_fds = (card8)idx->count;
+  cff->fdarray = xcalloc(idx->count, sizeof(cff_dict *));
+  for (i=0;i<idx->count;i++) {
+    card8 *data = idx->data + (idx->offset)[i] - 1;
+    size = (idx->offset)[i+1] - (idx->offset)[i];
+    if (size > 0) {
+      (cff->fdarray)[i] = cff_dict_unpack(data, data+size);
+    } else {
+      (cff->fdarray)[i] = NULL;
+    }
+  }
+  len = cff_index_size(idx);
+  cff_release_index(idx);
+
+  return len;
+}
+
+
+long cff_read_private (cff_font *cff)
+{
+  long len = 0;
+  card8 *data;
+  long offset, size;
+
+  if (cff->flag & FONTTYPE_CIDFONT) {
+    int i;
+
+    if (cff->fdarray == NULL)
+      cff_read_fdarray(cff);
+
+    cff->private = xcalloc(cff->num_fds, sizeof(cff_dict *));
+    for (i=0;i<cff->num_fds;i++) {
+      if (cff->fdarray[i] != NULL &&
+	  cff_dict_known(cff->fdarray[i], "Private") &&
+	  (size = (long) cff_dict_get(cff->fdarray[i], "Private", 0))
+	  > 0) {
+	offset = (long) cff_dict_get(cff->fdarray[i], "Private", 1);
+	cff->offset = offset;
+	data = xcalloc(size, sizeof(card8));
+	memcpy(data,&cff->stream[cff->offset],size);
+	cff->offset = size;
+	(cff->private)[i] = cff_dict_unpack(data, data+size);
+	xfree(data);
+	len += size;
+      } else {
+	(cff->private)[i] = NULL;
+      }
+    }
+  } else {
+    cff->num_fds = 1;
+    cff->private = xcalloc(1, sizeof(cff_dict *));
+    if (cff_dict_known(cff->topdict, "Private") &&
+	(size = (long) cff_dict_get(cff->topdict, "Private", 0)) > 0) {
+      offset = (long) cff_dict_get(cff->topdict, "Private", 1);
+      cff->offset = offset;
+      data = xcalloc(size, sizeof(card8));
+      memcpy(data,&cff->stream[cff->offset],size);
+      cff->offset = size;
+      cff->private[0] = cff_dict_unpack(data, data+size);
+      xfree(data);
+      len += size;
+    } else {
+      (cff->private)[0] = NULL;
+      len = 0;
+    }
+  }
+
+  return len;
+}
+
+
+cff_font *read_cff (unsigned char *buf,long buflength, int n) 
+{
+  cff_font *cff;
+  cff_index *idx;
+  long offset ;
+
+
+  cff = xcalloc(1,sizeof(cff_font));
+
+  cff->stream      = buf;
+  cff->stream_size = buflength;
+  cff->index       = n;
+
+  cff->header_major    = get_card8(cff);
+  cff->header_minor    = get_card8(cff);
+  cff->header_hdr_size = get_card8(cff);
+  cff->header_offsize  = get_card8(cff);
+  if (cff->header_offsize < 1 || cff->header_offsize > 4) {
+    WARN("invalid offsize data");
+    cff_close(cff);
+    return NULL;
+  }
+  if (cff->header_major > 1) {
+    pdftex_warn("CFF major version %u not supported.",cff->header_major);
+    cff_close(cff);
+    return NULL;
+  }
+  cff->offset = cff->header_hdr_size;
+
+  /* Name INDEX */
+  idx = cff_get_index(cff);
+  if (n > idx->count - 1) {
+    pdftex_warn("Invalid CFF fontset index number.");
+    cff_close(cff);
+    return NULL;
+  }
+
+  cff->name = idx;
+
+  cff->fontname = cff_get_name(cff);
+
+  /* Top DICT INDEX */
+  idx = cff_get_index(cff);
+  if (n > idx->count - 1) {
+    WARN("CFF Top DICT not exist...");
+    cff_close(cff);
+    return NULL;
+  }
+  cff->topdict = cff_dict_unpack(idx->data + idx->offset[n] - 1,
+				 idx->data + idx->offset[n + 1] - 1);
+  if (!cff->topdict) {
+    WARN("Parsing CFF Top DICT data failed...");
+    cff_close(cff);
+    return NULL;
+  }
+  cff_release_index(idx);
+
+  if (cff_dict_known(cff->topdict, "CharstringType") &&
+      cff_dict_get(cff->topdict, "CharstringType", 0) != 2) {
+    WARN("Only Type 2 Charstrings supported...");
+    cff_close(cff);
+    return NULL;
+  }
+
+  if (cff_dict_known(cff->topdict, "SyntheticBase")) {
+    WARN("CFF Synthetic font not supported.");
+    cff_close(cff);
+    return NULL;
+  }
+
+  /* String INDEX */
+  cff->string = cff_get_index(cff);
+
+  /* offset to GSubr */
+  cff->gsubr_offset = cff->offset;
+
+  /* Number of glyphs */
+  offset = (long) cff_dict_get(cff->topdict, "CharStrings", 0);
+  cff->offset = offset;
+  cff->num_glyphs = get_card16(cff);
+
+  /* Check for font type */
+  if (cff_dict_known(cff->topdict, "ROS")) {
+    cff->flag |= FONTTYPE_CIDFONT;
+  } else {
+    cff->flag |= FONTTYPE_FONT;
+  }
+
+  /* Check for encoding */
+  if (cff_dict_known(cff->topdict, "Encoding")) {
+    offset = (long) cff_dict_get(cff->topdict, "Encoding", 0);
+    if (offset == 0) { /* predefined */
+      cff->flag |= ENCODING_STANDARD;
+    } else if (offset == 1) {
+      cff->flag |= ENCODING_EXPERT;
+    }
+  } else {
+    cff->flag |= ENCODING_STANDARD;
+  }
+
+  cff->offset = cff->gsubr_offset; /* seek back to GSubr */
+
+  return cff;
+}
+
+/* write a cff for opentype */
+
+
+
+/* Pack DICT data */
+static long pack_integer (card8 *dest, long destlen, long value)
+{
+  long len = 0;
+
+  if (value >= -107 && value <= 107) {
+    if (destlen < 1)
+      CFF_ERROR("Buffer overflow.");
+    dest[0] = (value + 139) & 0xff;
+    len = 1;
+  } else if (value >= 108 && value <= 1131) {
+    if (destlen < 2)
+      CFF_ERROR("Buffer overflow.");
+    value = 0xf700u + value - 108;
+    dest[0] = (value >> 8) & 0xff;
+    dest[1] = value & 0xff;
+    len = 2;
+  } else if (value >= -1131 && value <= -108) {
+    if (destlen < 2)
+      CFF_ERROR("Buffer overflow.");
+    value = 0xfb00u - value - 108;
+    dest[0] = (value >> 8) & 0xff;
+    dest[1] = value & 0xff;
+    len = 2;
+  } else if (value >= -32768 && value <= 32767) { /* shortint */
+    if (destlen < 3)
+      CFF_ERROR("Buffer overflow.");
+    dest[0] = 28;
+    dest[1] = (value >> 8) & 0xff;
+    dest[2] = value & 0xff;
+    len = 3;
+  } else { /* longint */
+    if (destlen < 5)
+      CFF_ERROR("Buffer overflow.");
+    dest[0] = 29;
+    dest[1] = (value >> 24) & 0xff;
+    dest[2] = (value >> 16) & 0xff;
+    dest[3] = (value >> 8) & 0xff;
+    dest[4] = value & 0xff;
+    len = 5;
+  }
+  return len;
+}
+
+static long pack_real (card8 *dest, long destlen, double value)
+{
+  long e;
+  int i = 0, pos = 2;
+#define CFF_REAL_MAX_LEN 17
+
+  if (destlen < 2)
+    CFF_ERROR("Buffer overflow.");
+
+  dest[0] = 30;
+
+  if (value == 0.0) {
+    dest[1] = 0x0f;
+    return 2;
+  }
+
+  if (value < 0.0) {
+    dest[1] = 0xe0;
+    value *= -1.0;
+    pos++;
+  }
+
+  e = 0;
+  if (value >= 10.0) {
+    while (value >= 10.0) {
+      value /= 10.0;
+      e++;
+    }
+  } else if (value < 1.0) {
+    while (value < 1.0) {
+      value *= 10.0;
+      e--;
+    }
+  }
+
+  sprintf(work_buffer, "%1.14g", value);
+  for (i=0;i<CFF_REAL_MAX_LEN;i++) {
+    unsigned char ch = 0;
+    if (work_buffer[i] == '\0') {
+      break;
+    } else if (work_buffer[i] == '.') {
+      ch = 0x0a;
+    } else if (work_buffer[i] >= '0' && work_buffer[i] <= '9') {
+      ch = work_buffer[i] - '0';
+    } else {
+      CFF_ERROR("Invalid character.");
+    }
+
+    if (destlen < pos/2 + 1)
+      CFF_ERROR("Buffer overflow.");
+
+    if (pos % 2) {
+      dest[pos/2] += ch;
+    } else {
+      dest[pos/2] = (ch << 4);
+    }
+    pos++;
+  }
+
+  if (e > 0) {
+    if (pos % 2) {
+      dest[pos/2] += 0x0b;
+    } else {
+      if (destlen < pos/2 + 1)
+	CFF_ERROR("Buffer overflow.");
+      dest[pos/2] = 0xb0;
+    }
+    pos++;
+  } else if (e < 0) {
+    if (pos % 2) {
+      dest[pos/2] += 0x0c;
+    } else {
+      if (destlen < pos/2 + 1)
+	CFF_ERROR("Buffer overflow.");
+      dest[pos/2] = 0xc0;
+    }
+    e *= -1;
+    pos++;
+  }
+
+  if (e != 0) {
+    sprintf(work_buffer, "%ld", e);
+    for (i=0;i<CFF_REAL_MAX_LEN;i++) {
+      unsigned char ch = 0;
+      if (work_buffer[i] == '\0') {
+	break;
+      } else if (work_buffer[i] == '.') {
+	ch = 0x0a;
+      } else if (work_buffer[i] >= '0' && work_buffer[i] <= '9') {
+	ch = work_buffer[i] - '0';
+      } else {
+	CFF_ERROR("Invalid character.");
+      }
+
+      if (destlen < pos/2 + 1)
+	CFF_ERROR("Buffer overflow.");
+
+      if (pos % 2) {
+	dest[pos/2] += ch;
+      } else {
+	dest[pos/2] = (ch << 4);
+      }
+      pos++;
+    }
+  }
+
+  if (pos % 2) {
+    dest[pos/2] += 0x0f;
+    pos++;
+  } else {
+    if (destlen < pos/2 + 1)
+      CFF_ERROR("Buffer overflow.");
+    dest[pos/2] = 0xff;
+    pos += 2;
+  }
+
+  return pos/2;
+}
+
+static long cff_dict_put_number (double value,
+				 card8 *dest, long destlen,
+				 int type)
+{
+  long   len = 0;
+  double nearint;
+
+  nearint = floor(value+0.5);
+  /* set offset to longint */
+  if (type == CFF_TYPE_OFFSET) {
+    long lvalue;
+
+    lvalue = (long) value;
+    if (destlen < 5)
+      CFF_ERROR("Buffer overflow.");
+    dest[0] = 29;
+    dest[1] = (lvalue >> 24) & 0xff;
+    dest[2] = (lvalue >> 16) & 0xff;
+    dest[3] = (lvalue >>  8) & 0xff;
+    dest[4] = lvalue         & 0xff;
+    len = 5;
+  } else if (value > CFF_INT_MAX || value < CFF_INT_MIN ||
+	     (fabs(value - nearint) > 1.0e-5)) { /* real */
+    len = pack_real(dest, destlen, value);
+  } else { /* integer */
+    len = pack_integer(dest, destlen, (long) nearint);
+  }
+
+  return len;
+}
+
+static long
+put_dict_entry (cff_dict_entry *de,
+		card8 *dest, long destlen)
+{
+  long len = 0;
+  int  i, type, id;
+
+  if (de->count > 0) {
+    id = de->id;
+    if (dict_operator[id].argtype == CFF_TYPE_OFFSET ||
+	dict_operator[id].argtype == CFF_TYPE_SZOFF) {
+      type = CFF_TYPE_OFFSET;
+    } else {
+      type = CFF_TYPE_NUMBER;
+    }
+    for (i = 0; i < de->count; i++) {
+      len += cff_dict_put_number(de->values[i],
+				 dest+len,
+				 destlen-len, type);
+    }
+    if (id >= 0 && id < CFF_LAST_DICT_OP1) {
+      if (len + 1 > destlen)
+	CFF_ERROR("Buffer overflow.");
+      dest[len++] = id;
+    } else if (id >= 0 && id < CFF_LAST_DICT_OP) {
+      if (len + 2 > destlen)
+	CFF_ERROR("in cff_dict_pack(): Buffer overflow");
+      dest[len++] = 12;
+      dest[len++] = id - CFF_LAST_DICT_OP1;
+    } else {
+      CFF_ERROR("Invalid CFF DICT operator ID.");
+    }
+  }
+
+  return len;
+}
+
+long cff_dict_pack (cff_dict *dict, card8 *dest, long destlen)
+{
+  long len = 0;
+  int  i;
+
+  for (i = 0; i < dict->count; i++) {
+    if (!strcmp(dict->entries[i].key, "ROS")) {
+      len += put_dict_entry(&dict->entries[i], dest, destlen);
+      break;
+    }
+  }
+  for (i = 0; i < dict->count; i++) {
+    if (strcmp(dict->entries[i].key, "ROS")) {
+      len += put_dict_entry(&dict->entries[i], dest+len, destlen-len);
+    }
+  }
+
+  return len;
+}
+
+
+void cff_dict_add (cff_dict *dict, const char *key, int count)
+{
+  int id, i;
+
+  for (id=0;id<CFF_LAST_DICT_OP;id++) {
+    if (key && dict_operator[id].opname &&
+	strcmp(dict_operator[id].opname, key) == 0)
+      break;
+  }
+
+  if (id == CFF_LAST_DICT_OP)
+    CFF_ERROR("Unknown CFF DICT operator.");
+
+  for (i=0;i<dict->count;i++) {
+    if ((dict->entries)[i].id == id) {
+      if ((dict->entries)[i].count != count)
+	CFF_ERROR("Inconsistent DICT argument number.");
+      return;
+    }
+  }
+
+  if (dict->count + 1 >= dict->max) {
+    dict->max += 8;
+    dict->entries = xrealloc(dict->entries, (dict->max)*sizeof(cff_dict_entry));
+  }
+
+  (dict->entries)[dict->count].id    = id;
+  (dict->entries)[dict->count].key   = (char *) dict_operator[id].opname;
+  (dict->entries)[dict->count].count = count;
+  if (count > 0) {
+    (dict->entries)[dict->count].values = xcalloc(count, sizeof(double));
+    memset((dict->entries)[dict->count].values,
+	   0, sizeof(double)*count);
+  } else {
+    (dict->entries)[dict->count].values = NULL;
+  }
+  dict->count += 1;
+
+  return;
+}
+
+
+void cff_dict_remove (cff_dict *dict, const char *key)
+{
+  int i;
+  for (i = 0; i < dict->count; i++) {
+    if (key && strcmp(key, (dict->entries)[i].key) == 0) {
+      (dict->entries)[i].count = 0;
+      if ((dict->entries)[i].values)
+	xfree((dict->entries)[i].values);
+      (dict->entries)[i].values = NULL;
+    }
+  }
+}
+
+void cff_dict_set (cff_dict *dict, const char *key, int idx, double value)
+{
+  int i;
+
+  assert(dict && key);
+
+  for (i = 0 ; i < dict->count; i++) {
+    if (strcmp(key, (dict->entries)[i].key) == 0) {
+      if ((dict->entries)[i].count > idx)
+	(dict->entries)[i].values[idx] = value;
+      else
+	CFF_ERROR("Invalid index number.");
+      break;
+    }
+  }
+
+  if (i == dict->count)
+    pdftex_fail("DICT entry \"%s\" not found.", key);
+}
+
+
+/* Strings */
+char *cff_get_string (cff_font *cff, s_SID id)
+{
+  char *result = NULL;
+  long len;
+
+  if (id < CFF_STDSTR_MAX) {
+    len = strlen(cff_stdstr[id]);
+    result = xcalloc(len+1, sizeof(char));
+    memcpy(result, cff_stdstr[id], len);
+    result[len] = '\0';
+  } else if (cff && cff->string) {
+    cff_index *strings = cff->string;
+    id -= CFF_STDSTR_MAX;
+    if (id < strings->count) {
+      len = (strings->offset)[id+1] - (strings->offset)[id];
+      result = xcalloc(len + 1, sizeof(char));
+      memmove(result, strings->data + (strings->offset)[id] - 1, len);
+      result[len] = '\0';
+    }
+  }
+
+  return result;
+}
+
+long cff_get_sid (cff_font *cff, char *str)
+{
+  card16 i;
+
+  if (!cff || !str)
+    return -1;
+
+  /* I search String INDEX first. */
+  if (cff && cff->string) {
+    cff_index *idx = cff->string;
+    for (i = 0; i < idx->count; i++) {
+      if (strlen(str) == (idx->offset)[i+1] - (idx->offset)[i] &&
+	  !memcmp(str, (idx->data)+(idx->offset)[i]-1, strlen(str)))
+	return (i + CFF_STDSTR_MAX);
+    }
+  }
+
+  for (i = 0; i < CFF_STDSTR_MAX; i++) {
+    if (!strcmp(str, cff_stdstr[i]))
+      return i;
+  }
+
+  return -1;
+}
+
+
+void cff_update_string (cff_font *cff)
+{
+  if (cff == NULL)
+    CFF_ERROR("CFF font not opened.");
+  
+  if (cff->string)
+    cff_release_index(cff->string);
+  cff->string  = cff->_string;
+  cff->_string = NULL;
+}
+
+
+s_SID cff_add_string (cff_font *cff, char *str)
+{
+  card16 idx;
+  cff_index *strings;
+  l_offset offset, size;
+
+  if (cff == NULL)
+    CFF_ERROR("CFF font not opened.");
+
+  if (cff->_string == NULL)
+    cff->_string = cff_new_index(0);
+  strings = cff->_string;
+
+  for (idx = 0; idx < strings->count; idx++) {
+    size   = strings->offset[idx+1] - strings->offset[idx];
+    offset = strings->offset[idx];
+    if (size == strlen(str) &&
+	!memcmp(strings->data+offset-1, str, strlen(str)))
+      return (idx + CFF_STDSTR_MAX);
+  }
+
+  for (idx = 0; idx < CFF_STDSTR_MAX; idx++) {
+    if (cff_stdstr[idx] &&
+	!strcmp(cff_stdstr[idx], str))
+      return idx;
+  }
+  offset = (strings->count > 0) ? strings->offset[strings->count] : 1;
+  strings->offset = xrealloc(strings->offset, (strings->count+2)*sizeof(l_offset));
+  if (strings->count == 0)
+    strings->offset[0] = 1;
+  idx = strings->count;
+  strings->count += 1;
+  strings->offset[strings->count] = offset + strlen(str);
+  strings->data = xrealloc(strings->data, (offset+strlen(str)-1)*sizeof(card8));
+  memcpy(strings->data+offset-1, str, strlen(str));
+
+  return (idx + CFF_STDSTR_MAX);
+}
+
+
+void cff_dict_update (cff_dict *dict, cff_font *cff)
+{
+  int i;
+
+  for (i = 0;i < dict->count; i++) {
+    if ((dict->entries)[i].count > 0) {
+      char *str;
+      int   id;
+
+      id = (dict->entries)[i].id;
+	  
+      if (dict_operator[id].argtype == CFF_TYPE_SID) {
+		str = cff_get_string(cff, (dict->entries)[i].values[0]);
+		(dict->entries)[i].values[0] = cff_add_string(cff, str);
+		xfree(str);
+      } else if (dict_operator[id].argtype == CFF_TYPE_ROS) {
+		str = cff_get_string(cff, (dict->entries)[i].values[0]);
+		(dict->entries)[i].values[0] = cff_add_string(cff, str);
+		xfree(str);
+		str = cff_get_string(cff, (dict->entries)[i].values[1]);
+		(dict->entries)[i].values[1] = cff_add_string(cff, str);
+		xfree(str);
+      }
+	  
+    }
+  }
+}
+
+/* charsets */
+
+long cff_read_charsets (cff_font *cff)
+{
+  cff_charsets *charset;
+  long offset, length;
+  card16 count, i;
+
+  if (cff->topdict == NULL)
+    CFF_ERROR("Top DICT not available");
+
+  if (!cff_dict_known(cff->topdict, "charset")) {
+    cff->flag |= CHARSETS_ISOADOBE;
+    cff->charsets = NULL;
+    return 0;
+  }
+
+  offset = (long) cff_dict_get(cff->topdict, "charset", 0);
+
+  if (offset == 0) { /* predefined */
+    cff->flag |= CHARSETS_ISOADOBE;
+    cff->charsets = NULL;
+    return 0;
+  } else if (offset == 1) {
+    cff->flag |= CHARSETS_EXPERT;
+    cff->charsets = NULL;
+    return 0;
+  } else if (offset == 2) {
+    cff->flag |= CHARSETS_EXPSUB;
+    cff->charsets = NULL;
+    return 0;
+  }
+
+  cff->offset = offset;
+  cff->charsets = charset = xcalloc(1, sizeof(cff_charsets));
+  charset->format = get_card8(cff);
+  charset->num_entries = 0;
+
+  count = cff->num_glyphs - 1;
+  length = 1;
+
+  /* Not sure. Not well documented. */
+  switch (charset->format) {
+  case 0:
+    charset->num_entries = cff->num_glyphs - 1; /* no .notdef */
+    charset->data.glyphs = xcalloc(charset->num_entries, sizeof(s_SID));
+    length += (charset->num_entries) * 2;
+    for (i=0;i<(charset->num_entries);i++) {
+      charset->data.glyphs[i] = get_card16(cff);
+    }
+    count = 0;
+    break;
+  case 1:
+    {
+      cff_range1 *ranges = NULL;
+      while (count > 0 && charset->num_entries < cff->num_glyphs) {
+	ranges = xrealloc(ranges, (charset->num_entries + 1)*sizeof(cff_range1));
+	ranges[charset->num_entries].first = get_card16(cff);
+	ranges[charset->num_entries].n_left = get_card8(cff);
+	count -= ranges[charset->num_entries].n_left + 1; /* no-overrap */
+	charset->num_entries += 1;
+	charset->data.range1 = ranges;
+      }
+      length += (charset->num_entries) * 3;
+    }
+    break;
+  case 2:
+    {
+      cff_range2 *ranges = NULL;
+      while (count > 0 && charset->num_entries < cff->num_glyphs) {
+	ranges = xrealloc(ranges, (charset->num_entries + 1)*sizeof(cff_range2));
+	ranges[charset->num_entries].first = get_card16(cff);
+	ranges[charset->num_entries].n_left = get_card16(cff);
+	count -= ranges[charset->num_entries].n_left + 1; /* non-overrapping */
+	charset->num_entries += 1;
+      }
+      charset->data.range2 = ranges;
+      length += (charset->num_entries) * 4;
+    }
+    break;
+  default:
+    xfree(charset);
+    CFF_ERROR("Unknown Charset format");
+    break;
+  }
+
+  if (count > 0)
+    CFF_ERROR("Charset data possibly broken");
+
+  return length;
+}
+
+long cff_pack_charsets (cff_font *cff, card8 *dest, long destlen)
+{
+  long len = 0;
+  card16 i;
+  cff_charsets *charset;
+
+  if (cff->flag & HAVE_STANDARD_CHARSETS || cff->charsets == NULL)
+    return 0;
+
+  if (destlen < 1)
+    CFF_ERROR("in cff_pack_charsets(): Buffer overflow");
+
+  charset = cff->charsets;
+
+  dest[len++] = charset->format;
+  switch (charset->format) {
+  case 0:
+    if (destlen < len + (charset->num_entries)*2)
+      CFF_ERROR("in cff_pack_charsets(): Buffer overflow");
+    for (i=0;i<(charset->num_entries);i++) {
+      s_SID sid = (charset->data).glyphs[i]; /* or CID */
+      dest[len++] = (sid >> 8) & 0xff;
+      dest[len++] = sid & 0xff;
+    }
+    break;
+  case 1:
+    {
+      if (destlen < len + (charset->num_entries)*3)
+	CFF_ERROR("in cff_pack_charsets(): Buffer overflow");
+      for (i=0;i<(charset->num_entries);i++) {
+	dest[len++] = ((charset->data).range1[i].first >> 8) & 0xff;
+	dest[len++] = (charset->data).range1[i].first & 0xff;
+	dest[len++] = (charset->data).range1[i].n_left;
+      }
+    }
+    break;
+  case 2:
+    {
+      if (destlen < len + (charset->num_entries)*4)
+	CFF_ERROR("in cff_pack_charsets(): Buffer overflow");
+      for (i=0;i<(charset->num_entries);i++) {
+	dest[len++] = ((charset->data).range2[i].first >> 8) & 0xff;
+	dest[len++] = (charset->data).range2[i].first & 0xff;
+	dest[len++] = ((charset->data).range2[i].n_left >> 8) & 0xff;
+	dest[len++] = (charset->data).range2[i].n_left & 0xff;
+      }
+    }
+    break;
+  default:
+    CFF_ERROR("Unknown Charset format");
+    break;
+  }
+
+  return len;
+}
+
+
+
+/*
+ * Type 2 Charstring support:
+ *  Decode and encode Type 2 charstring
+ *
+ * All local/global subroutine calls in a given charstring is replace by the
+ * content of subroutine charstrings. We do this because some PostScript RIP
+ * may have problems with sparse subroutine array. Workaround for this is to
+ * re-order subroutine array so that no gap appears in the subroutine array,
+ * or put dummy charstrings that contains only `return' in the gap. However,
+ * re-ordering of subroutine is rather difficult for Type 2 charstrings due
+ * to the bias which depends on the total number of subroutines. Replacing
+ * callgsubr/callsubr calls with the content of the corresponding subroutine
+ * charstring may be more efficient than putting dummy subroutines in the
+ * case of subsetted font. Adobe distiller seems doing same thing.
+ *
+ * And also note that subroutine numbers within subroutines can depend on the
+ * content of operand stack as follows:
+ *
+ *   ... l m callsubr << subr #(m+bias): n add callsubr >> ...
+ *
+ * I've not implemented the `random' operator which generates a pseudo-random
+ * number in the range (0, 1] and push them into argument stack.
+ * How pseudo-random sequences are generated is not documented in the Type 2
+ * charstring spec..
+ */
+
+
+#define CS_TYPE2_DEBUG_STR "Type2 Charstring Parser"
+#define CS_TYPE2_DEBUG     5
+
+/* decoder/encoder status codes */
+#define CS_BUFFER_CFF_ERROR -3
+#define CS_STACK_CFF_ERROR  -2
+#define CS_PARSE_CFF_ERROR  -1
+#define CS_PARSE_OK      0
+#define CS_PARSE_END     1
+#define CS_SUBR_RETURN   2
+#define CS_CHAR_END      3
+
+static int status = CS_PARSE_CFF_ERROR;
+
+#define DST_NEED(a,b) {if ((a) < (b)) { status = CS_BUFFER_CFF_ERROR ; return ; }}
+#define SRC_NEED(a,b) {if ((a) < (b)) { status = CS_PARSE_CFF_ERROR  ; return ; }}
+#define NEED(a,b)     {if ((a) < (b)) { status = CS_STACK_CFF_ERROR  ; return ; }}
+
+/* hintmask and cntrmask need number of stem zones */
+static int num_stems = 0;
+static int phase     = 0;
+
+/* subroutine nesting */
+static int cs2_nest      = 0;
+
+/* advance width */
+static int    have_width = 0;
+static double width      = 0.0;
+
+/*
+ * Standard Encoding Accented Characters:
+ *  Optional four arguments for endchar. See, CFF spec., p.35.
+ *  This is obsolete feature and is no longer supported.
+ */
+#if 0
+/* adx ady bchar achar endchar */
+static double seac[4] = {0.0, 0.0, 0.0, 0.0};
+#endif
+
+/* Operand stack and Transient array */
+static int    cs2_stack_top = 0;
+static double cs2_arg_stack[CS_ARG_STACK_MAX];
+static double trn_array[CS_TRANS_ARRAY_MAX];
+
+/*
+ * Type 2 CharString encoding
+ */
+
+/*
+ * 1-byte CharString operaotrs:
+ *  cs_escape is first byte of two-byte operator
+ */
+
+/*      RESERVED      0 */
+#define cs_hstem      1
+/*      RESERVED      2 */
+#define cs_vstem      3
+#define cs_vmoveto    4
+#define cs_rlineto    5
+#define cs_hlineto    6
+#define cs_vlineto    7
+#define cs_rrcurveto  8
+/*      cs_closepath  9  : TYPE1 */
+#define cs_callsubr   10
+#define cs_return     11
+#define cs_escape     12
+/*      cs_hsbw       13 : TYPE1 */
+#define cs_endchar    14
+/*      RESERVED      15 */
+/*      RESERVED      16 */
+/*      RESERVED      17 */
+#define cs_hstemhm    18
+#define cs_hintmask   19
+#define cs_cntrmask   20
+#define cs_rmoveto    21
+#define cs_hmoveto    22
+#define cs_vstemhm    23
+#define cs_rcurveline 24
+#define cs_rlinecurve 25
+#define cs_vvcurveto  26
+#define cs_hhcurveto  27
+/*      SHORTINT      28 : first byte of shortint*/
+#define cs_callgsubr  29
+#define cs_vhcurveto  30
+#define cs_hvcurveto  31
+
+/*
+ * 2-byte CharString operaotrs:
+ *  "dotsection" is obsoleted in Type 2 charstring.
+ */
+
+#define cs_dotsection 0
+/*      cs_vstem3     1 : TYPE1 */
+/*      cs_hstem3     2 : TYPE1 */
+#define cs_and        3
+#define cs_or         4
+#define cs_not        5
+/*      cs_seac       6 : TYPE1 */
+/*      cs_sbw        7 : TYPE1 */
+/*      RESERVED      8  */
+#define cs_abs        9
+#define cs_add        10
+#define cs_sub        11
+#define cs_div        12
+/*      RESERVED      13 */
+#define cs_neg        14
+#define cs_eq         15
+/*      cs_callothersubr 16 : TYPE1 */
+/*      cs_pop           17 : TYPE1 */
+#define cs_drop       18
+/*      RESERVED      19 */
+#define cs_put        20
+#define cs_get        21
+#define cs_ifelse     22 
+#define cs_random     23
+#define cs_mul        24
+/*      RESERVED      25 */
+#define cs_sqrt       26
+#define cs_dup        27
+#define cs_exch       28
+#define cs_index      29
+#define cs_roll       30
+/*      cs_setcurrentpoint 31 : TYPE1 */
+/*      RESERVED      32 */
+/*      RESERVED      33 */
+#define cs_hflex      34
+#define cs_flex       35
+#define cs_hflex1     36
+#define cs_flex1      37
+
+/*
+ * clear_stack() put all operands sotred in operand stack to dest.
+ */
+static void
+clear_stack (card8 **dest, card8 *limit)
+{
+  int i;
+
+  for (i = 0; i < cs2_stack_top; i++) {
+    double value;
+    long   ivalue;
+    value  = cs2_arg_stack[i];
+    /* Nearest integer value */
+    ivalue = (long) floor(value+0.5);
+    if (value >= 0x8000L || value <= (-0x8000L - 1)) {
+      /*
+       * This number cannot be represented as a single operand.
+       * We must use `a b mul ...' or `a c div' to represent large values.
+       */
+      CFF_ERROR("Argument value too large. (This is bug)");
+    } else if (fabs(value - ivalue) > 3.0e-5) {
+      /* 16.16-bit signed fixed value  */
+      DST_NEED(limit, *dest + 5);
+      *(*dest)++ = 255;
+      ivalue = (long) floor(value); /* mantissa */
+      *(*dest)++ = (ivalue >> 8) & 0xff;
+      *(*dest)++ = ivalue & 0xff;
+      ivalue = (long)((value - ivalue) * 0x10000l); /* fraction */
+      *(*dest)++ = (ivalue >> 8) & 0xff;
+      *(*dest)++ = ivalue & 0xff;
+      /* Everything else are integers. */
+    } else if (ivalue >= -107 && ivalue <= 107) {
+      DST_NEED(limit, *dest + 1);
+      *(*dest)++ = ivalue + 139;
+    } else if (ivalue >= 108 && ivalue <= 1131) {
+      DST_NEED(limit, *dest + 2);
+      ivalue = 0xf700u + ivalue - 108;
+      *(*dest)++ = (ivalue >> 8) & 0xff;
+      *(*dest)++ = ivalue & 0xff;
+    } else if (ivalue >= -1131 && ivalue <= -108) {
+      DST_NEED(limit, *dest + 2);
+      ivalue = 0xfb00u - ivalue - 108;
+      *(*dest)++ = (ivalue >> 8) & 0xff;
+      *(*dest)++ = ivalue & 0xff;
+    } else if (ivalue >= -32768 && ivalue <= 32767) { /* shortint */
+      DST_NEED(limit, *dest + 3);
+      *(*dest)++ = 28;
+      *(*dest)++ = (ivalue >> 8) & 0xff;
+      *(*dest)++ = (ivalue) & 0xff;
+    } else { /* Shouldn't come here */
+      CFF_ERROR("Unexpected error.");
+    }
+  }
+
+  cs2_stack_top = 0; /* clear stack */
+
+  return;
+}
+
+/*
+ * Single byte operators:
+ *  Path construction, Operator for finishing a path, Hint operators.
+ *
+ * phase:
+ *  0: inital state
+ *  1: hint declaration, first stack-clearing operator appeared
+ *  2: in path construction
+ */
+
+static void
+do_operator1 (card8 **dest, card8 *limit, card8 **data, card8 *endptr)
+{
+  card8 op = **data;
+
+  *data += 1;
+
+  switch (op) {
+  case cs_hstemhm:
+  case cs_vstemhm:
+  /* charstring may have hintmask if above operator have seen */
+  case cs_hstem:
+  case cs_vstem:
+    if (phase == 0 && (cs2_stack_top % 2)) {
+      have_width = 1;
+      width = cs2_arg_stack[0];
+    }
+    num_stems += cs2_stack_top/2;
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    phase = 1;
+    break;
+  case cs_hintmask:
+  case cs_cntrmask:
+    if (phase < 2) {
+      if (phase == 0 && (cs2_stack_top % 2)) {
+	have_width = 1;
+	width = cs2_arg_stack[0];
+      }
+      num_stems += cs2_stack_top/2;
+    }
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    if (num_stems > 0) {
+      int masklen = (num_stems + 7) / 8;
+      DST_NEED(limit, *dest + masklen);
+      SRC_NEED(endptr, *data + masklen);
+      memmove(*dest, *data, masklen);
+      *data += masklen;
+      *dest += masklen;
+    }
+    phase = 2;
+    break;
+  case cs_rmoveto:
+    if (phase == 0 && (cs2_stack_top % 2)) {
+      have_width = 1;
+      width = cs2_arg_stack[0];
+    }
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    phase = 2;
+    break;
+  case cs_hmoveto:
+  case cs_vmoveto:
+    if (phase == 0 && (cs2_stack_top % 2) == 0) {
+      have_width = 1;
+      width = cs2_arg_stack[0];
+    }
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    phase = 2;
+    break;
+  case cs_endchar:
+    if (cs2_stack_top == 1) {
+      have_width = 1;
+      width = cs2_arg_stack[0];
+      clear_stack(dest, limit);
+    } else if (cs2_stack_top == 4 || cs2_stack_top == 5) {
+      WARN("\"seac\" character deprecated in Type 2 charstring.");
+      status = CS_PARSE_CFF_ERROR;
+      return;
+    } else if (cs2_stack_top > 0) {
+      WARN("Operand stack not empty.");
+    }
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    status = CS_CHAR_END;
+    break;
+  /* above oprators are candidate for first stack-clearing operator */
+  case cs_rlineto:
+  case cs_hlineto:
+  case cs_vlineto:
+  case cs_rrcurveto:
+  case cs_rcurveline:
+  case cs_rlinecurve:
+  case cs_vvcurveto:
+  case cs_hhcurveto:
+  case cs_vhcurveto:
+  case cs_hvcurveto:
+    if (phase < 2) {
+      WARN("Broken Type 2 charstring.");
+      status = CS_PARSE_CFF_ERROR;
+      return;
+    }
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 1);
+    *(*dest)++ = op;
+    break;
+  /* all operotors above are stack-clearing operator */
+  /* no output */
+  case cs_return:
+  case cs_callgsubr:
+  case cs_callsubr:
+    CFF_ERROR("Unexpected call(g)subr/return");
+    break;
+  default:
+    /* no-op ? */
+    WARN("%s: Unknown charstring operator: 0x%02x", CS_TYPE2_DEBUG_STR, op);
+    status = CS_PARSE_CFF_ERROR;
+    break;
+  }
+
+  return;
+}
+
+/*
+ * Double byte operators:
+ *  Flex, arithmetic, conditional, and storage operators.
+ *
+ * Following operators are not supported:
+ *  random: How random ?
+ */
+static void
+do_operator2 (card8 **dest, card8 *limit, card8 **data, card8 *endptr)
+{
+  card8 op;
+
+  *data += 1;
+
+  SRC_NEED(endptr, *data + 1);
+
+  op = **data;
+  *data += 1;
+
+  switch(op) {
+  case cs_dotsection: /* deprecated */
+    WARN("Operator \"dotsection\" deprecated in Type 2 charstring.");
+    status = CS_PARSE_CFF_ERROR;
+    return;
+    break;
+  case cs_hflex:
+  case cs_flex:
+  case cs_hflex1:
+  case cs_flex1:
+    if (phase < 2) {
+      WARN("%s: Broken Type 2 charstring.", CS_TYPE2_DEBUG_STR);
+      status = CS_PARSE_CFF_ERROR;
+      return;
+    }
+    clear_stack(dest, limit);
+    DST_NEED(limit, *dest + 2);
+    *(*dest)++ = cs_escape;
+    *(*dest)++ = op;
+    break;
+  /* all operator above are stack-clearing */
+  /* no output */
+  case cs_and:
+    NEED(cs2_stack_top, 2);
+    cs2_stack_top--;
+    if (cs2_arg_stack[cs2_stack_top] && cs2_arg_stack[cs2_stack_top-1]) {
+      cs2_arg_stack[cs2_stack_top-1] = 1.0;
+    } else {
+      cs2_arg_stack[cs2_stack_top-1] = 0.0;
+    }
+    break;
+  case cs_or:
+    NEED(cs2_stack_top, 2);
+    cs2_stack_top--;
+    if (cs2_arg_stack[cs2_stack_top] || cs2_arg_stack[cs2_stack_top-1]) {
+      cs2_arg_stack[cs2_stack_top-1] = 1.0;
+    } else {
+      cs2_arg_stack[cs2_stack_top-1] = 0.0;
+    }
+    break;
+  case cs_not:
+    NEED(cs2_stack_top, 1);
+    if (cs2_arg_stack[cs2_stack_top-1]) {
+      cs2_arg_stack[cs2_stack_top-1] = 0.0;
+    } else {
+      cs2_arg_stack[cs2_stack_top-1] = 1.0;
+    }
+    break;
+  case cs_abs:
+    NEED(cs2_stack_top, 1);
+    cs2_arg_stack[cs2_stack_top-1] = fabs(cs2_arg_stack[cs2_stack_top-1]);
+    break;
+  case cs_add:
+    NEED(cs2_stack_top, 2);
+    cs2_arg_stack[cs2_stack_top-2] += cs2_arg_stack[cs2_stack_top-1];
+    cs2_stack_top--;
+    break;
+  case cs_sub:
+    NEED(cs2_stack_top, 2);
+    cs2_arg_stack[cs2_stack_top-2] -= cs2_arg_stack[cs2_stack_top-1];
+    cs2_stack_top--;
+    break;
+  case cs_div: /* doesn't check overflow */
+    NEED(cs2_stack_top, 2);
+    cs2_arg_stack[cs2_stack_top-2] /= cs2_arg_stack[cs2_stack_top-1];
+    cs2_stack_top--;
+    break;
+  case cs_neg:
+    NEED(cs2_stack_top, 1);
+    cs2_arg_stack[cs2_stack_top-1] *= -1.0;
+    break;
+  case cs_eq:
+    NEED(cs2_stack_top, 2);
+    cs2_stack_top--;
+    if (cs2_arg_stack[cs2_stack_top] == cs2_arg_stack[cs2_stack_top-1]) {
+      cs2_arg_stack[cs2_stack_top-1] = 1.0;
+    } else {
+      cs2_arg_stack[cs2_stack_top-1] = 0.0;
+    }
+    break;
+  case cs_drop:
+    NEED(cs2_stack_top, 1);
+    cs2_stack_top--;
+    break;
+  case cs_put:
+    NEED(cs2_stack_top, 2);
+    {
+      int idx = (int)cs2_arg_stack[--cs2_stack_top];
+      NEED(CS_TRANS_ARRAY_MAX, idx);
+      trn_array[idx] = cs2_arg_stack[--cs2_stack_top];
+    }
+    break;
+  case cs_get:
+    NEED(cs2_stack_top, 1);
+    {
+      int idx = (int)cs2_arg_stack[cs2_stack_top-1];
+      NEED(CS_TRANS_ARRAY_MAX, idx);
+      cs2_arg_stack[cs2_stack_top-1] = trn_array[idx];
+    }
+    break;
+  case cs_ifelse:
+    NEED(cs2_stack_top, 4);
+    cs2_stack_top -= 3;
+    if (cs2_arg_stack[cs2_stack_top+1] > cs2_arg_stack[cs2_stack_top+2]) {
+      cs2_arg_stack[cs2_stack_top-1] = cs2_arg_stack[cs2_stack_top];
+    }
+    break;
+  case cs_mul:
+    NEED(cs2_stack_top, 2);
+    cs2_arg_stack[cs2_stack_top-2] = cs2_arg_stack[cs2_stack_top-2] * cs2_arg_stack[cs2_stack_top-1];
+    cs2_stack_top--;
+    break;
+  case cs_sqrt:
+    NEED(cs2_stack_top, 1);
+    cs2_arg_stack[cs2_stack_top-1] = sqrt(cs2_arg_stack[cs2_stack_top-1]);
+    break;
+  case cs_dup:
+    NEED(cs2_stack_top, 1);
+    NEED(CS_ARG_STACK_MAX, cs2_stack_top+1);
+    cs2_arg_stack[cs2_stack_top] = cs2_arg_stack[cs2_stack_top-1];
+    cs2_stack_top++;
+    break;
+  case cs_exch:
+    NEED(cs2_stack_top, 2);
+    {
+      double save = cs2_arg_stack[cs2_stack_top-2];
+      cs2_arg_stack[cs2_stack_top-2] = cs2_arg_stack[cs2_stack_top-1];
+      cs2_arg_stack[cs2_stack_top-1] = save;
+    }
+    break;
+  case cs_index:
+    NEED(cs2_stack_top, 2); /* need two arguments at least */
+    {
+      int idx = (int)cs2_arg_stack[cs2_stack_top-1];
+      if (idx < 0) {
+	cs2_arg_stack[cs2_stack_top-1] = cs2_arg_stack[cs2_stack_top-2];
+      } else {
+	NEED(cs2_stack_top, idx+2);
+	cs2_arg_stack[cs2_stack_top-1] = cs2_arg_stack[cs2_stack_top-idx-2];
+      }
+    }
+    break;
+  case cs_roll:
+    NEED(cs2_stack_top, 2);
+    {
+      int N, J;
+      J = (int)cs2_arg_stack[--cs2_stack_top];
+      N = (int)cs2_arg_stack[--cs2_stack_top];
+      NEED(cs2_stack_top, N);
+      if (J > 0) {
+	J = J % N;
+	while (J-- > 0) {
+	  double save = cs2_arg_stack[cs2_stack_top-1];
+	  int i = cs2_stack_top - 1;
+	  while (i > cs2_stack_top-N) {
+	    cs2_arg_stack[i] = cs2_arg_stack[i-1];
+	    i--;
+	  }
+	  cs2_arg_stack[i] = save;
+	}
+      } else {
+	J = (-J) % N;
+	while (J-- > 0) {
+	  double save = cs2_arg_stack[cs2_stack_top-N];
+	  int i = cs2_stack_top - N;
+	  while (i < cs2_stack_top-1) {
+	    cs2_arg_stack[i] = cs2_arg_stack[i+1];
+	    i++;
+	  }
+	  cs2_arg_stack[i] = save;
+	}
+      }
+    }
+    break;
+  case cs_random:
+    WARN("%s: Charstring operator \"random\" found.", CS_TYPE2_DEBUG_STR);
+    NEED(CS_ARG_STACK_MAX, cs2_stack_top+1);
+    cs2_arg_stack[cs2_stack_top++] = 1.0;
+    break;
+  default:
+    /* no-op ? */
+    WARN("%s: Unknown charstring operator: 0x0c%02x", CS_TYPE2_DEBUG_STR, op);
+    status = CS_PARSE_CFF_ERROR;
+    break;
+  }
+
+  return;
+}
+
+/*
+ * integer:
+ *  exactly the same as the DICT encoding (except 29)
+ */
+static void
+cs2_get_integer (card8 **data, card8 *endptr)
+{
+  long result = 0;
+  card8 b0 = **data, b1, b2;
+
+  *data += 1;
+
+  if (b0 == 28) { /* shortint */
+    SRC_NEED(endptr, *data + 2);
+    b1 = **data;
+    b2 = *(*data+1);
+    result = b1*256+b2;
+    if (result > 0x7fff)
+      result -= 0x10000L;
+    *data += 2;
+  } else if (b0 >= 32 && b0 <= 246) { /* int (1) */
+    result = b0 - 139;
+  } else if (b0 >= 247 && b0 <= 250) { /* int (2) */
+    SRC_NEED(endptr, *data + 1);
+    b1 = **data;
+    result = (b0-247)*256+b1+108;
+    *data += 1;
+  } else if (b0 >= 251 && b0 <= 254) {
+    SRC_NEED(endptr, *data + 1);
+    b1 = **data;
+    result = -(b0-251)*256-b1-108;
+    *data += 1;
+  } else {
+    status = CS_PARSE_CFF_ERROR;
+    return;
+  }
+
+  NEED(CS_ARG_STACK_MAX, cs2_stack_top+1);
+  cs2_arg_stack[cs2_stack_top++] = (double) result;
+
+  return;
+}
+
+/*
+ * Signed 16.16-bits fixed number for Type 2 charstring encoding
+ */
+static void
+get_fixed (card8 **data, card8 *endptr)
+{
+  long ivalue;
+  double rvalue;
+
+  *data += 1;
+
+  SRC_NEED(endptr, *data + 4);
+
+  ivalue = *(*data) * 0x100 + *(*data+1);
+  rvalue = (ivalue > 0x7fffL) ? (ivalue - 0x10000L) : ivalue;
+  ivalue = *(*data+2) * 0x100 + *(*data+3);
+  rvalue += ((double) ivalue) / 0x10000L;
+
+  NEED(CS_ARG_STACK_MAX, cs2_stack_top+1);
+  cs2_arg_stack[cs2_stack_top++] = rvalue;
+  *data += 4;
+
+  return;
+}
+
+/*
+ * Subroutines:
+ *  The bias for subroutine number is introduced in type 2 charstrings.
+ *
+ * subr:     set to a pointer to the subroutine charstring.
+ * len:      set to the length of subroutine charstring.
+ * subr_idx: CFF INDEX data that contains subroutines.
+ * id:       biased subroutine number.
+ */
+static void
+get_subr (card8 **subr, long *len, cff_index *subr_idx, long id)
+{
+  card16 count;
+
+  if (subr_idx == NULL)
+    CFF_ERROR("%s: Subroutine called but no subroutine found.", CS_TYPE2_DEBUG_STR);
+
+  count = subr_idx->count;
+
+  /* Adding bias number */
+  if (count < 1240) {
+    id += 107;
+  } else if (count < 33900) {
+    id += 1131;
+  } else {
+    id += 32768;
+  }
+
+  if (id > count)
+    CFF_ERROR("%s: Invalid Subr index: %ld (max=%u)", CS_TYPE2_DEBUG_STR, id, count);
+
+  *len = (subr_idx->offset)[id + 1] - (subr_idx->offset)[id];
+  *subr = subr_idx->data + (subr_idx->offset)[id] - 1;
+
+  return;
+}
+
+/*
+ * NOTE:
+ *  The Type 2 interpretation of a number encoded in five-bytes (those with
+ *  an initial byte value of 255) differs from how it is interpreted in the
+ *  Type 1 format.
+ */
+
+static void
+do_charstring (card8 **dest, card8 *limit,
+	       card8 **data, card8 *endptr,
+	       cff_index *gsubr_idx, cff_index *subr_idx)
+{
+  card8 b0 = 0, *subr;
+  long  len;
+
+  if (cs2_nest > CS_SUBR_NEST_MAX)
+    CFF_ERROR("%s: Subroutine nested too deeply.", CS_TYPE2_DEBUG_STR);
+
+  cs2_nest++;
+
+  while (*data < endptr && status == CS_PARSE_OK) {
+    b0 = **data;
+    if (b0 == 255) { /* 16-bit.16-bit fixed signed number */
+      get_fixed(data, endptr);
+    } else if (b0 == cs_return) {
+      status = CS_SUBR_RETURN;
+    } else if (b0 == cs_callgsubr) {
+      if (cs2_stack_top < 1) {
+	status = CS_STACK_CFF_ERROR;
+      } else {
+	cs2_stack_top--;
+	get_subr(&subr, &len, gsubr_idx, (long) cs2_arg_stack[cs2_stack_top]);
+	if (*dest + len > limit)
+	  CFF_ERROR("%s: Possible buffer overflow.", CS_TYPE2_DEBUG_STR);
+	do_charstring(dest, limit, &subr, subr + len,
+		      gsubr_idx, subr_idx);
+	*data += 1;
+      }
+    } else if (b0 == cs_callsubr) {
+      if (cs2_stack_top < 1) {
+	status = CS_STACK_CFF_ERROR;
+      } else {
+	cs2_stack_top--;
+	get_subr(&subr, &len, subr_idx, (long) cs2_arg_stack[cs2_stack_top]);
+	if (limit < *dest + len)
+	  CFF_ERROR("%s: Possible buffer overflow.", CS_TYPE2_DEBUG_STR);
+	do_charstring(dest, limit, &subr, subr + len,
+		      gsubr_idx, subr_idx);
+	*data += 1;
+      }
+    } else if (b0 == cs_escape) {
+      do_operator2(dest, limit, data, endptr);
+    } else if (b0 < 32 && b0 != 28) { /* 19, 20 need mask */
+      do_operator1(dest, limit, data, endptr);
+    } else if ((b0 <= 22 && b0 >= 27) || b0 == 31) { /* reserved */
+      status = CS_PARSE_CFF_ERROR; /* not an error ? */
+    } else { /* integer */
+      cs2_get_integer(data, endptr);
+    }
+  }
+
+  if (status == CS_SUBR_RETURN) {
+    status = CS_PARSE_OK;
+  } else if (status == CS_CHAR_END && *data < endptr) {
+    WARN("%s: Garbage after endchar.", CS_TYPE2_DEBUG_STR);
+  } else if (status < CS_PARSE_OK) { /* error */
+    CFF_ERROR("%s: Parsing charstring failed: (status=%d, stack=%d)",
+	  CS_TYPE2_DEBUG_STR, status, cs2_stack_top);
+  }
+
+  cs2_nest--;
+
+  return;
+}
+
+static void
+cs_parse_init (void)
+{
+  status = CS_PARSE_OK;
+  cs2_nest   = 0;
+  phase  = 0;
+  num_stems = 0;
+  cs2_stack_top = 0;
+}
+
+/*
+ * Not just copying...
+ */
+long
+cs_copy_charstring (card8 *dst, long dstlen,
+		    card8 *src, long srclen,
+		    cff_index *gsubr, cff_index *subr,
+		    double default_width, double nominal_width, cs_ginfo *ginfo)
+{
+  card8 *save = dst;
+
+  cs_parse_init();
+
+  width = 0.0;
+  have_width = 0;
+
+  /* expand call(g)subrs */
+  do_charstring(&dst, dst + dstlen, &src, src + srclen, gsubr, subr);
+
+  if (ginfo) {
+    ginfo->flags = 0; /* not used */
+    if (have_width) {
+      ginfo->wx = nominal_width + width;
+    } else {
+      ginfo->wx = default_width;
+    }
+  }
+
+  return (long)(dst - save);
+}
+
+/* encodings */
+
+/*
+ * Encoding and Charset
+ *
+ *  Encoding and Charset arrays always begin with GID = 1.
+ */
+long cff_read_encoding (cff_font *cff)
+{
+  cff_encoding *encoding;
+  long offset, length;
+  card8 i;
+
+  if (cff->topdict == NULL) {
+    CFF_ERROR("Top DICT data not found");
+  }
+
+  if (!cff_dict_known(cff->topdict, "Encoding")) {
+    cff->flag |= ENCODING_STANDARD;
+    cff->encoding = NULL;
+    return 0;
+  }
+
+  offset = (long) cff_dict_get(cff->topdict, "Encoding", 0);
+  if (offset == 0) { /* predefined */
+    cff->flag |= ENCODING_STANDARD;
+    cff->encoding = NULL;
+    return 0;
+  } else if (offset == 1) {
+    cff->flag |= ENCODING_EXPERT;
+    cff->encoding = NULL;
+    return 0;
+  }
+
+  cff->offset= offset;
+  cff->encoding = encoding = xcalloc(1, sizeof(cff_encoding));
+  encoding->format = get_card8(cff);
+  length = 1;
+
+  switch (encoding->format & (~0x80)) {
+  case 0:
+    encoding->num_entries = get_card8(cff);
+    (encoding->data).codes = xcalloc(encoding->num_entries, sizeof(card8));
+    for (i=0;i<(encoding->num_entries);i++) {
+      (encoding->data).codes[i] = get_card8(cff);
+    }
+    length += encoding->num_entries + 1;
+    break;
+  case 1:
+    {
+      cff_range1 *ranges;
+      encoding->num_entries = get_card8(cff);
+      encoding->data.range1 = ranges
+	= xcalloc(encoding->num_entries, sizeof(cff_range1));
+      for (i=0;i<(encoding->num_entries);i++) {
+	ranges[i].first = get_card8(cff);
+	ranges[i].n_left = get_card8(cff);
+      }
+      length += (encoding->num_entries) * 2 + 1;
+    }
+    break;
+  default:
+    xfree(encoding);
+    CFF_ERROR("Unknown Encoding format");
+    break;
+  }
+
+  /* Supplementary data */
+  if ((encoding->format) & 0x80) {
+    cff_map *map;
+    encoding->num_supps = get_card8(cff);
+    encoding->supp = map = xcalloc(encoding->num_supps, sizeof(cff_map));
+    for (i=0;i<(encoding->num_supps);i++) {
+      map[i].code = get_card8(cff);
+      map[i].glyph = get_card16(cff); /* SID */
+    }
+    length += (encoding->num_supps) * 3 + 1;
+  } else {
+    encoding->num_supps = 0;
+    encoding->supp = NULL;
+  }
+
+  return length;
+}
+
+long cff_pack_encoding (cff_font *cff, card8 *dest, long destlen)
+{
+  long len = 0;
+  cff_encoding *encoding;
+  card16 i;
+
+  if (cff->flag & HAVE_STANDARD_ENCODING || cff->encoding == NULL)
+    return 0;
+
+  if (destlen < 2)
+    CFF_ERROR("in cff_pack_encoding(): Buffer overflow");
+
+  encoding = cff->encoding;
+
+  dest[len++] = encoding->format;
+  dest[len++] = encoding->num_entries;
+  switch (encoding->format & (~0x80)) {
+  case 0:
+    if (destlen < len + encoding->num_entries)
+      CFF_ERROR("in cff_pack_encoding(): Buffer overflow");
+    for (i=0;i<(encoding->num_entries);i++) {
+      dest[len++] = (encoding->data).codes[i];
+    }
+    break;
+  case 1:
+    {
+      if (destlen < len + (encoding->num_entries)*2)
+	CFF_ERROR("in cff_pack_encoding(): Buffer overflow");
+      for (i=0;i<(encoding->num_entries);i++) {
+	dest[len++] = (encoding->data).range1[i].first & 0xff;
+	dest[len++] = (encoding->data).range1[i].n_left;
+      }
+    }
+    break;
+  default:
+    CFF_ERROR("Unknown Encoding format");
+    break;
+  }
+
+  if ((encoding->format) & 0x80) {
+    if (destlen < len + (encoding->num_supps)*3 + 1)
+      CFF_ERROR("in cff_pack_encoding(): Buffer overflow");
+    dest[len++] = encoding->num_supps;
+    for (i=0;i<(encoding->num_supps);i++) {
+      dest[len++] = (encoding->supp)[i].code;
+      dest[len++] = ((encoding->supp)[i].glyph >> 8) & 0xff;
+      dest[len++] = (encoding->supp)[i].glyph & 0xff;
+    }
+  }
+
+  return len;
+}
+
+/* CID-Keyed font specific */
+long cff_read_fdselect (cff_font *cff)
+{
+  cff_fdselect *fdsel;
+  long offset, length;
+  card16 i;
+
+  if (cff->topdict == NULL)
+    CFF_ERROR("Top DICT not available");
+
+  if (!(cff->flag & FONTTYPE_CIDFONT))
+    return 0;
+
+  offset = (long) cff_dict_get(cff->topdict, "FDSelect", 0);
+  cff->offset = offset;
+  cff->fdselect = fdsel = xcalloc(1, sizeof(cff_fdselect));
+  fdsel->format = get_card8(cff);
+
+  length = 1;
+
+  switch (fdsel->format) {
+  case 0:
+    fdsel->num_entries = cff->num_glyphs;
+    (fdsel->data).fds = xcalloc(fdsel->num_entries, sizeof(card8));
+    for (i=0;i<(fdsel->num_entries);i++) {
+      (fdsel->data).fds[i] = get_card8(cff);
+    }
+    length += fdsel->num_entries;
+    break;
+  case 3:
+    {
+      cff_range3 *ranges;
+      fdsel->num_entries = get_card16(cff);
+      fdsel->data.ranges = ranges = xcalloc(fdsel->num_entries, sizeof(cff_range3));
+      for (i=0;i<(fdsel->num_entries);i++) {
+	ranges[i].first = get_card16(cff);
+	ranges[i].fd = get_card8(cff);
+      }
+      if (ranges[0].first != 0)
+	CFF_ERROR("Range not starting with 0.");
+      if (cff->num_glyphs != get_card16(cff))
+	CFF_ERROR("Sentinel value mismatched with number of glyphs.");
+      length += (fdsel->num_entries) * 3 + 4;
+    }
+    break;
+  default:
+    xfree(fdsel);
+    CFF_ERROR("Unknown FDSelect format.");
+    break;
+  }
+
+  return length;
+}
+
+
+long cff_pack_fdselect (cff_font *cff, card8 *dest, long destlen)
+{
+  cff_fdselect *fdsel;
+  long len = 0;
+  card16 i;
+
+  if (cff->fdselect == NULL)
+    return 0;
+
+  if (destlen < 1)
+    CFF_ERROR("in cff_pack_fdselect(): Buffur overflow");
+
+  fdsel = cff->fdselect;
+
+  dest[len++] = fdsel->format;
+  switch (fdsel->format) {
+  case 0:
+    if (fdsel->num_entries != cff->num_glyphs)
+      CFF_ERROR("in cff_pack_fdselect(): Invalid data");
+    if (destlen < len + fdsel->num_entries)
+      CFF_ERROR("in cff_pack_fdselect(): Buffer overflow");
+    for (i=0;i<fdsel->num_entries;i++) {
+      dest[len++] = (fdsel->data).fds[i];
+    }
+    break;
+  case 3:
+    {
+      if (destlen < len + 2)
+	CFF_ERROR("in cff_pack_fdselect(): Buffer overflow");
+      len += 2;
+      for (i=0;i<(fdsel->num_entries);i++) {
+	if (destlen < len + 3)
+	  CFF_ERROR("in cff_pack_fdselect(): Buffer overflow");
+	dest[len++] = ((fdsel->data).ranges[i].first >> 8) & 0xff;
+	dest[len++] = (fdsel->data).ranges[i].first & 0xff;
+	dest[len++] = (fdsel->data).ranges[i].fd;
+      }
+      if (destlen < len + 2)
+	CFF_ERROR("in cff_pack_fdselect(): Buffer overflow");
+      dest[len++]  = (cff->num_glyphs >> 8) & 0xff;
+      dest[len++]  = cff->num_glyphs & 0xff;
+      dest[1] = ((len/3 - 1) >> 8) & 0xff;
+      dest[2] = (len/3 - 1) & 0xff;
+    }
+    break;
+  default:
+    CFF_ERROR("Unknown FDSelect format.");
+    break;
+  }
+
+  return len;
+}
+
+
+
+/*
+ * Create an instance of embeddable font.
+ */
+static void
+write_fontfile (cff_font *cffont, char *fullname)
+{
+  cff_index *topdict, *fdarray, *private;
+  unsigned char *dest;
+  long destlen = 0, i, size;
+  long offset, topdict_offset, fdarray_offset;
+
+  /*  DICT sizes (offset set to long int) */
+  topdict = cff_new_index(1);
+  fdarray = cff_new_index(cffont->num_fds);
+  private = cff_new_index(cffont->num_fds);
+
+  cff_dict_remove(cffont->topdict, "UniqueID");
+  cff_dict_remove(cffont->topdict, "XUID");
+  cff_dict_remove(cffont->topdict, "Private");  /* some bad font may have */
+  cff_dict_remove(cffont->topdict, "Encoding"); /* some bad font may have */
+
+  topdict->offset[1] = cff_dict_pack(cffont->topdict,
+				     (card8 *) work_buffer,
+				     WORK_BUFFER_SIZE) + 1;
+  for (i = 0;i < cffont->num_fds; i++) {
+    size = 0;
+    if (cffont->private && cffont->private[i]) {
+      size = cff_dict_pack(cffont->private[i],
+						   (card8 *) work_buffer, WORK_BUFFER_SIZE);
+      if (size < 1) { /* Private had contained only Subr */
+		cff_dict_remove(cffont->fdarray[i], "Private");
+      }
+    }
+    (private->offset)[i+1] = (private->offset)[i] + size;
+    (fdarray->offset)[i+1] = (fdarray->offset)[i] +
+      cff_dict_pack(cffont->fdarray[i],
+					(card8 *) work_buffer, WORK_BUFFER_SIZE);
+  }
+
+  destlen = 4; /* header size */
+  destlen += cff_set_name(cffont, fullname);
+  destlen += cff_index_size(topdict);
+  destlen += cff_index_size(cffont->string);
+  destlen += cff_index_size(cffont->gsubr);
+  destlen += (cffont->charsets->num_entries) * 2 + 1;  /* charset format 0 */
+  destlen += (cffont->fdselect->num_entries) * 3 + 5; /* fdselect format 3 */
+  destlen += cff_index_size(cffont->cstrings);
+  destlen += cff_index_size(fdarray);
+  destlen += private->offset[private->count] - 1; /* Private is not INDEX */
+
+  dest = xcalloc(destlen, sizeof(card8));
+
+  offset = 0;
+  /* Header */
+  offset += cff_put_header(cffont, dest + offset, destlen - offset);
+  /* Name */
+  offset += cff_pack_index(cffont->name, dest + offset, destlen - offset);
+  /* Top DICT */
+  topdict_offset = offset;
+  offset += cff_index_size(topdict);
+  /* Strings */
+  offset += cff_pack_index(cffont->string, dest + offset, destlen - offset);
+  /* Global Subrs */
+  offset += cff_pack_index(cffont->gsubr, dest + offset, destlen - offset);
+
+  /* charset */
+  cff_dict_set(cffont->topdict, "charset", 0, offset);
+  offset += cff_pack_charsets(cffont, dest + offset, destlen - offset);
+
+  /* FDSelect */
+  cff_dict_set(cffont->topdict, "FDSelect", 0, offset);
+  offset += cff_pack_fdselect(cffont, dest + offset, destlen - offset);
+
+  /* CharStrings */
+  cff_dict_set(cffont->topdict, "CharStrings", 0, offset);
+  offset += cff_pack_index(cffont->cstrings,
+			   dest + offset, cff_index_size(cffont->cstrings));
+  cff_release_index(cffont->cstrings);
+  cffont->cstrings = NULL; /* Charstrings cosumes huge memory */
+
+  /* FDArray and Private */
+  cff_dict_set(cffont->topdict, "FDArray", 0, offset);
+  fdarray_offset = offset;
+  offset += cff_index_size(fdarray);
+
+  fdarray->data = xcalloc(fdarray->offset[fdarray->count] - 1, sizeof(card8));
+  for (i = 0; i < cffont->num_fds; i++) {
+    size = private->offset[i+1] - private->offset[i];
+    if (cffont->private[i] && size > 0) {
+      cff_dict_pack(cffont->private[i], dest + offset, size);
+      cff_dict_set(cffont->fdarray[i], "Private", 0, size);
+      cff_dict_set(cffont->fdarray[i], "Private", 1, offset);
+    }
+    cff_dict_pack(cffont->fdarray[i],
+		  fdarray->data + (fdarray->offset)[i] - 1,
+		  fdarray->offset[fdarray->count] - 1);
+    offset += size;
+  }
+
+  cff_pack_index(fdarray, dest + fdarray_offset, cff_index_size(fdarray));
+  cff_release_index(fdarray);
+  cff_release_index(private);
+
+  /* Finally Top DICT */
+  topdict->data = xcalloc(topdict->offset[topdict->count] - 1, sizeof(card8));
+  cff_dict_pack(cffont->topdict,
+		topdict->data, topdict->offset[topdict->count] - 1);
+  cff_pack_index(topdict, dest + topdict_offset, cff_index_size(topdict));
+  cff_release_index(topdict);
+
+  for (i = 0; i < offset; i++)
+    fb_putchar (dest[i]);
+
+  /*fprintf(stdout," (%i/%i)",offset,cffont->stream_size);*/
+  xfree(dest);
+  return ;
+}
+
+
+/* if the CFF data was converted from an old type1 font, then the .notdef 
+   glyph may not be at id 0, so in that case |uglytype1fix| is nonzero */
+
+void write_cff(cff_font *cffont, fd_entry *fd, int uglytype1fix) {
+  cff_index    *charstrings, *cs_idx;
+
+  long          charstring_len, max_len;
+  long          size, offset = 0;
+
+  card8         *data;
+  card16        num_glyphs, cs_count, code, gid, last_cid;
+
+  double        nominal_width, default_width;
+
+  char         *fullname;
+
+  glw_entry *glyph, *found;
+  struct avl_traverser t;
+
+
+
+  
+  fullname = xcalloc(8+strlen(fd->fontname),1);
+  sprintf(fullname,"%s+%s",fd->subset_tag,fd->fontname);
+
+  /* finish parsing the CFF */
+  cff_read_private(cffont);
+  cff_read_subrs  (cffont); 
+
+  /*
+   * Widths
+   */
+  if (cffont->private[0] &&
+      cff_dict_known(cffont->private[0], "defaultWidthX")) {
+    default_width = (double) cff_dict_get(cffont->private[0], "defaultWidthX", 0);
+  } else {
+    default_width = CFF_DEFAULTWIDTHX_DEFAULT;
+  }
+  if (cffont->private[0] &&
+      cff_dict_known(cffont->private[0], "nominalWidthX")) {
+    nominal_width = (double) cff_dict_get(cffont->private[0], "nominalWidthX", 0);
+  } else {
+    nominal_width = CFF_NOMINALWIDTHX_DEFAULT;
+  }
+
+  num_glyphs = 0; 
+  last_cid = 0;  
+  glyph = xtalloc(1,glw_entry);
+
+  /* insert notdef */   
+  glyph->id = uglytype1fix;
+  if (avl_find(fd->gl_tree, glyph)==NULL) {
+	/*fprintf(stderr,"seeding .notdef at %i\n",uglytype1fix);*/
+    avl_insert(fd->gl_tree, glyph);
+    glyph = xtalloc(1,glw_entry);
+  }
+
+
+  avl_t_init(&t, fd->gl_tree);
+  for (found = (glw_entry *) avl_t_first(&t, fd->gl_tree); 
+       found != NULL; 
+       found = (glw_entry *) avl_t_next(&t)) {
+    if (found->id > last_cid)
+      last_cid = found->id;
+    num_glyphs++;
+  }
+
+  {
+    cff_fdselect *fdselect;
+
+    fdselect = xcalloc(1, sizeof(cff_fdselect));
+    fdselect->format = 3;
+    fdselect->num_entries = 1;
+    fdselect->data.ranges = xcalloc(1, sizeof(cff_range3));
+    fdselect->data.ranges[0].first = 0;
+    fdselect->data.ranges[0].fd    = 0;
+    cffont->fdselect = fdselect;
+  }
+
+  {
+    cff_charsets *charset;
+
+    charset  = xcalloc(1, sizeof(cff_charsets));
+    charset->format = 0;
+    charset->num_entries = num_glyphs-1;
+    charset->data.glyphs = xcalloc(num_glyphs, sizeof(s_SID));
+
+    gid = 0;
+
+    avl_t_init(&t, fd->gl_tree);
+    for (found = (glw_entry *) avl_t_first(&t, fd->gl_tree); 
+	 found != NULL; 
+	 found = (glw_entry *) avl_t_next(&t)) {      
+	  if(found->id!=0) { 
+		charset->data.glyphs[gid] = found->id;
+		gid++;
+      }
+    }
+    cffont->charsets = charset;
+  }
+
+  cff_dict_add(cffont->topdict, "CIDCount", 1);
+  cff_dict_set(cffont->topdict, "CIDCount", 0, last_cid + 1);
+
+  cffont->fdarray    = xcalloc(1, sizeof(cff_dict *));
+  cffont->fdarray[0] = cff_new_dict();
+  cff_dict_add(cffont->fdarray[0], "FontName", 1);
+  cff_dict_set(cffont->fdarray[0], "FontName", 0,
+	       (double) cff_add_string(cffont, fullname)); /* FIXME: Skip XXXXXX+ */
+  cff_dict_add(cffont->fdarray[0], "Private", 2);
+  cff_dict_set(cffont->fdarray[0], "Private", 0, 0.0);
+  cff_dict_set(cffont->fdarray[0], "Private", 0, 0.0);
+  /* FDArray  - index offset, not known yet */
+  cff_dict_add(cffont->topdict, "FDArray", 1);
+  cff_dict_set(cffont->topdict, "FDArray", 0, 0.0);
+  /* FDSelect - offset, not known yet */
+  cff_dict_add(cffont->topdict, "FDSelect", 1);
+  cff_dict_set(cffont->topdict, "FDSelect", 0, 0.0);
+
+  cff_dict_remove(cffont->topdict, "UniqueID");
+  cff_dict_remove(cffont->topdict, "XUID");
+  cff_dict_remove(cffont->topdict, "Private");
+  cff_dict_remove(cffont->topdict, "Encoding");
+
+  cffont->offset = cff_dict_get(cffont->topdict, "CharStrings", 0);
+  cs_idx = cff_get_index_header(cffont);
+
+  offset   = cffont->offset;
+  cs_count = cs_idx->count;
+  if (cs_count < 2) {
+    CFF_ERROR("No valid charstring data found.");
+  }
+
+  /* build the new charstrings entry */ 
+  charstrings       = cff_new_index(cs_count+1);
+  max_len           = 2 * CS_STR_LEN_MAX;
+  charstrings->data = xcalloc(max_len, sizeof(card8));
+  charstring_len    = 0;
+
+  gid = 0;
+  data = xcalloc(CS_STR_LEN_MAX, sizeof(card8));
+
+  for (code=0; code < cs_count; code++) {
+	glyph->id = code;
+    if ((avl_find(fd->gl_tree,glyph) != NULL)) {
+      size = cs_idx->offset[code+1] - cs_idx->offset[code];
+      
+      if (size > CS_STR_LEN_MAX) {
+		pdftex_fail("Charstring too long: gid=%u, %ld bytes", code, size);
+      }
+      if (charstring_len + CS_STR_LEN_MAX >= max_len) {
+		max_len = charstring_len + 2 * CS_STR_LEN_MAX;
+		charstrings->data = xrealloc(charstrings->data, max_len*sizeof(card8));
+      }
+      (charstrings->offset)[gid] = charstring_len + 1;
+      cffont->offset= offset + (cs_idx->offset)[code] - 1;
+      memcpy(data,&cffont->stream[cffont->offset],size);
+      charstring_len += cs_copy_charstring(charstrings->data + charstring_len,
+					   max_len - charstring_len,
+					   data, size,
+					   cffont->gsubr, (cffont->subrs)[0],
+					   default_width, nominal_width, NULL);
+      gid++;
+    }
+  }
+  
+  /* this happens if the internal metrics do not agree with the actual disk font */
+  if (gid < num_glyphs) {
+    WARN("embedded subset is smaller than expected: %d instead of %d glyphs.", gid, num_glyphs);
+    num_glyphs = gid;
+  }
+  
+  xfree(data);
+  cff_release_index(cs_idx);
+  
+  (charstrings->offset)[num_glyphs] = charstring_len + 1;
+  charstrings->count = num_glyphs;
+  cffont->num_glyphs = num_glyphs;
+  cffont->cstrings      = charstrings;
+
+  /*
+   * We don't use subroutines at all.
+   */
+  if (cffont->gsubr)
+    cff_release_index(cffont->gsubr);
+  cffont->gsubr = cff_new_index(0);
+
+  if (cffont->subrs && cffont->subrs[0])
+    cff_release_index(cffont->subrs[0]);
+  cffont->subrs[0] = NULL;
+
+  if (cffont->private && (cffont->private)[0]) {
+    cff_dict_remove((cffont->private)[0], "Subrs"); /* no Subrs */
+  }
+
+  cff_add_string(cffont, (char *)"Adobe");
+  cff_add_string(cffont, (char *)"Identity");
+
+  cff_dict_update(cffont->topdict, cffont);
+  cff_dict_update(cffont->private[0], cffont);
+  cff_update_string(cffont);
+
+  /* CFF code need to be rewrote... */
+  cff_dict_add(cffont->topdict, "ROS", 3);
+  cff_dict_set(cffont->topdict, "ROS", 0,
+	       (double) cff_get_sid(cffont, (char *)"Adobe"));
+  cff_dict_set(cffont->topdict, "ROS", 1,
+	       (double) cff_get_sid(cffont, (char *)"Identity"));
+  cff_dict_set(cffont->topdict, "ROS", 2, 0.0);
+
+  write_fontfile(cffont,fullname);
+  xfree(fullname);
+  cff_close (cffont);
+
+}
+
+#define ERROR(a) { perror(a); return 0; }
+
+/* Input : SID or CID (16-bit unsigned int)
+ * Output: glyph index
+ */
+card16
+cff_charsets_lookup (cff_font *cff, card16 cid)
+{
+  card16        gid = 0;
+  cff_charsets *charset;
+  card16        i;
+
+  if (cff->flag & (CHARSETS_ISOADOBE|CHARSETS_EXPERT|CHARSETS_EXPSUB)) {
+    ERROR("Predefined CFF charsets not supported yet");
+  } else if (cff->charsets == NULL) {
+    ERROR("Charsets data not available");
+  }
+
+  if (cid == 0) {
+    return 0; /* GID 0 (.notdef) */
+  }
+
+  charset = cff->charsets;
+
+  gid = 0;
+  switch (charset->format) {
+  case 0:
+    for (i = 0; i <charset->num_entries; i++) {
+      if (cid == charset->data.glyphs[i]) {
+	gid = i + 1;
+	return gid;
+      }
+    }
+    break;
+  case 1:
+    for (i = 0; i < charset->num_entries; i++) {
+      if (cid >= charset->data.range1[i].first &&
+	  cid <= charset->data.range1[i].first + charset->data.range1[i].n_left) {
+        gid += cid - charset->data.range1[i].first + 1;
+	return gid;
+      }
+      gid += charset->data.range1[i].n_left + 1;
+    }
+    break;
+  case 2:
+    for (i = 0; i < charset->num_entries; i++) {
+      if (cid >= charset->data.range2[i].first &&
+	  cid <= charset->data.range2[i].first + charset->data.range2[i].n_left) {
+        gid += cid - charset->data.range2[i].first + 1;
+	return gid;
+      }
+      gid += charset->data.range2[i].n_left + 1;
+    }
+    break;
+  default:
+    ERROR("Unknown Charset format");
+  }
+
+  return 0; /* not found */
+}
+
+
+#define is_cidfont(a) ((a)->flag & FONTTYPE_CIDFONT)
+#define CID_MAX 65535
+
+void write_cid_cff(cff_font *cffont, fd_entry *fd, int uglytype1fix) {
+  cff_index    *charstrings, *cs_idx;
+
+  long          charstring_len, max_len;
+  long          size, offset = 0;
+
+  card8        *data;
+  card16        num_glyphs, cs_count, gid, last_cid;
+
+
+  int          fdsel, prev_fd, cid_count, cid;
+  char         *fullname;
+
+  glw_entry    *glyph;
+
+  unsigned char *CIDToGIDMap = NULL;
+
+  cff_fdselect *fdselect = NULL;
+  cff_charsets *charset  = NULL;
+
+
+  if (!is_cidfont(cffont)) {
+	perror("Not a CIDfont.");
+	return;
+  }
+
+  fullname = xcalloc(8+strlen(fd->fontname),1);
+  sprintf(fullname,"%s+%s",fd->subset_tag,fd->fontname);
+
+  /* finish parsing the CFF */
+
+  if (cff_dict_known(cffont->topdict, "CIDCount")) {
+    cid_count = (card16) cff_dict_get(cffont->topdict, "CIDCount", 0);
+  } else {
+    cid_count = CFF_CIDCOUNT_DEFAULT;
+  }
+  cff_read_charsets(cffont);
+  CIDToGIDMap = xmalloc((2*cid_count) * sizeof(unsigned char));
+  memset(CIDToGIDMap, 0, 2*cid_count);
+
+
+  glyph = xtalloc(1,glw_entry);
+  /* insert notdef */   
+  glyph->id = uglytype1fix;
+  if (avl_find(fd->gl_tree, glyph)==NULL) {
+    avl_insert(fd->gl_tree, glyph);
+    glyph = xtalloc(1,glw_entry);
+  }
+
+  cid = 0; last_cid = 0; num_glyphs = 0;
+  for (cid = 0; cid <= CID_MAX; cid++) {
+	glyph->id = cid;
+    if (avl_find(fd->gl_tree,glyph) != NULL) {
+	  gid = cff_charsets_lookup(cffont, cid);
+	  CIDToGIDMap[2*cid]   = (gid >> 8) & 0xff;
+	  CIDToGIDMap[2*cid+1] = gid & 0xff;
+	  last_cid = cid;
+	  num_glyphs++;
+    }
+  }
+
+  cff_read_fdselect(cffont);
+  cff_read_fdarray(cffont);
+  cff_read_private(cffont);
+   
+  cff_read_subrs  (cffont);
+
+
+  cffont->offset = cff_dict_get(cffont->topdict, "CharStrings", 0);
+  cs_idx = cff_get_index_header(cffont);
+
+  offset   = cffont->offset;
+  cs_count = cs_idx->count;
+  if (cs_count < 2) {
+    CFF_ERROR("No valid charstring data found.");
+  }
+
+  charset  = xcalloc(1, sizeof(cff_charsets));
+  charset->format = 0;
+  charset->num_entries = 0;
+  charset->data.glyphs = xcalloc(num_glyphs, sizeof(s_SID));
+
+  fdselect = xcalloc(1, sizeof(cff_fdselect));
+  fdselect->format = 3;
+  fdselect->num_entries = 0;
+  fdselect->data.ranges = xcalloc(num_glyphs, sizeof(cff_range3));
+
+  charstrings       = cff_new_index(cs_count+1);
+  max_len           = 2 * CS_STR_LEN_MAX;
+  charstrings->data = xcalloc(max_len, sizeof(card8));
+  charstring_len    = 0;
+
+  prev_fd = -1; gid = 0;
+  data = xcalloc(CS_STR_LEN_MAX, sizeof(card8));
+  for (cid=0; cid <= last_cid; cid++) {
+    unsigned short gid_org;
+
+	glyph->id = cid;
+	if (avl_find(fd->gl_tree,glyph) == NULL)
+	  continue;
+
+	gid_org = (CIDToGIDMap[2*cid] << 8)|(CIDToGIDMap[2*cid+1]);
+	size = cs_idx->offset[gid_org+1] - cs_idx->offset[gid_org];
+	if (size > CS_STR_LEN_MAX) {
+	  pdftex_fail("Charstring too long: gid=%u, %ld bytes", cid, size);
+	}
+	if (charstring_len + CS_STR_LEN_MAX >= max_len) {
+	  max_len = charstring_len + 2 * CS_STR_LEN_MAX;
+	  charstrings->data = xrealloc(charstrings->data, max_len*sizeof(card8));
+	}
+	(charstrings->offset)[gid] = charstring_len + 1;
+	cffont->offset= offset + (cs_idx->offset)[gid_org] - 1;
+	memcpy(data,&cffont->stream[cffont->offset],size);
+	fdsel = cff_fdselect_lookup(cffont, gid_org);
+	charstring_len += cs_copy_charstring(charstrings->data + charstring_len,
+					  max_len - charstring_len,
+					  data, size,
+					  cffont->gsubr, (cffont->subrs)[fdsel],
+					  0, 0, NULL);
+
+	if (cid>0 && gid_org > 0) {
+	  charset->data.glyphs[charset->num_entries] = cid;
+	  charset->num_entries += 1;
+	}
+	if (fdsel != prev_fd) {
+	  fdselect->data.ranges[fdselect->num_entries].first = gid;
+	  fdselect->data.ranges[fdselect->num_entries].fd    = fdsel;
+	  fdselect->num_entries += 1;
+	  prev_fd = fdsel;
+	}
+	gid++;
+  }
+  
+  if (gid != num_glyphs)
+    CFF_ERROR("Unexpected error: %i != %i", gid, num_glyphs);
+  xfree(data);
+  cff_release_index(cs_idx);
+
+  xfree(CIDToGIDMap);
+
+  (charstrings->offset)[num_glyphs] = charstring_len + 1;
+  charstrings->count = num_glyphs;
+  cffont->num_glyphs = num_glyphs;
+  cffont->cstrings      = charstrings;
+
+  cff_release_charsets(cffont->charsets);
+  cffont->charsets = charset;
+  cff_release_fdselect(cffont->fdselect);
+  cffont->fdselect = fdselect;
+
+  /*
+   * We don't use subroutines at all.
+   */
+  if (cffont->gsubr)
+    cff_release_index(cffont->gsubr);
+  cffont->gsubr = cff_new_index(0);
+
+  for (fdsel = 0; fdsel < cffont->num_fds; fdsel++) {
+    if (cffont->subrs && cffont->subrs[fdsel]) {
+      cff_release_index(cffont->subrs[fdsel]);
+      cffont->subrs[fdsel] = NULL;
+    }
+    if (cffont->private && (cffont->private)[fdsel]) {
+      cff_dict_remove((cffont->private)[fdsel], "Subrs"); /* no Subrs */
+    }
+  }
+
+  write_fontfile(cffont,fullname);
+  xfree(fullname);
+  cff_close (cffont);
+
+}
+
+
+/* here is a sneaky trick: fontforge knows how to convert Type1 to CFF, so 
+ * I have defined a utility function in luafflib.c that does exactly that.
+ * If it works out ok, I will clean up this code.
+ */
+
+extern int ff_createcff (char *, unsigned char **, integer *);
+
+void writetype1w (fd_entry *fd) { 
+  cff_font *cff;
+  int i;
+  FILE *fp;
+  ff_entry *ff;
+  unsigned char *tfm_buffer = NULL;
+  integer tfm_size = 0;
+  int notdefpos = 0;
+
+  ff = check_ff_exist(fd->fm->ff_name, 0);
+    
+  fp = fopen (ff->ff_path, "rb");
+  cur_file_name = ff->ff_path;
+
+  if (!fp) {
+    fprintf(stderr,"Type1: Could not open Type1 font: %s", cur_file_name);
+    uexit(1);
+  }
+  fclose(fp);
+
+  if (tracefilenames) {
+    if (is_subsetted(fd->fm))
+      tex_printf ("<%s", cur_file_name);
+    else
+      tex_printf ("<<%s", cur_file_name);
+  }
+
+  notdefpos = ff_createcff(ff->ff_path,&tfm_buffer,&tfm_size);
+
+  if (tfm_size>0) {
+    cff = read_cff(tfm_buffer,tfm_size,0);
+    if (cff != NULL) {
+      write_cff(cff,fd,notdefpos);
+    } else {
+      for (i = 0; i < tfm_size ; i++)
+	fb_putchar (tfm_buffer[i]);
+    }
+    fd->ff_found = 1;
+  } else {
+    fprintf(stderr,"Type1: Could not understand Type1 font: %s", cur_file_name);
+    uexit(1);
+  }
+  if (tracefilenames) {
+	if (is_subsetted (fd->fm))
+      tex_printf (">");
+    else 
+      tex_printf (">>");
+  }
+  cur_file_name = NULL;
+}
+
+
diff --git a/Build/source/texk/web2c/luatexdir/font/writecff.h b/Build/source/texk/web2c/luatexdir/font/writecff.h
new file mode 100644
index 00000000000..8cb93024f7a
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writecff.h
@@ -0,0 +1,349 @@
+/*  $Header: /home/cvsroot/dvipdfmx/src/cff_limits.h,v 1.3 2002/10/30 02:27:05 chofchof Exp $
+    
+    This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+    Copyright (C) 2002 by Jin-Hwan Cho and Shunsaku Hirata,
+    the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+    
+    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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.
+*/
+
+#ifndef _CFF_LIMITS_H_
+#define _CFF_LIMITS_H_
+
+#include <limits.h>
+
+#define CFF_INT_MAX 0x7fffffff
+#define CFF_INT_MIN (-0x7fffffff - 1)
+
+#if (LONG_MAX < CFF_INT_MAX || LONG_MIN > CFF_INT_MIN)
+#error "CFF support won't work on this system."
+#endif
+
+#define CFF_SID_MAX    64999
+#define CFF_STDSTR_MAX 391
+
+/* Type 2 Charstring */
+#define CS_NUM_SUBR_MAX    65536
+#define CS_STR_LEN_MAX     65536
+#define CS_STEM_ZONE_MAX   96
+#define CS_ARG_STACK_MAX   48
+#define CS_TRANS_ARRAY_MAX 32
+#define CS_SUBR_NEST_MAX   10
+
+#endif /* _CFF_LIMITS_H_ */
+
+#ifndef _CFF_TYPES_H_
+#define _CFF_TYPES_H_
+
+/* CFF Data Types */
+
+#define CFF_TYPE_UNKNOWN 0
+#define CFF_TYPE_INTEGER (1 << 0)
+#define CFF_TYPE_REAL    (1 << 1)
+#define CFF_TYPE_NUMBER  (CFF_TYPE_INTEGER|CFF_TYPE_REAL)
+#define CFF_TYPE_BOOLEAN (1 << 2)
+#define CFF_TYPE_SID     (1 << 3)
+#define CFF_TYPE_ARRAY   (1 << 4)
+#define CFF_TYPE_DELTA   (1 << 5)
+
+/* SID SID number */
+#define CFF_TYPE_ROS     (1 << 6)
+/* offset(0) */
+#define CFF_TYPE_OFFSET  (1 << 7)
+/* size offset(0) */
+#define CFF_TYPE_SZOFF   (1 << 8)
+
+typedef unsigned char  card8;     /* 1-byte unsigned number */
+typedef unsigned short card16;    /* 2-byte unsigned number */
+typedef unsigned char  c_offsize; /* 1-byte unsigned number specifies the size
+				     of an Offset field or fields, range 1-4 */
+typedef unsigned long  l_offset;  /* 1, 2, 3, or 4-byte offset */
+typedef unsigned short s_SID;       /* 2-byte string identifier  */
+
+typedef unsigned long  l_size;
+
+typedef struct {
+  card16    count;   /* number of objects stored in INDEX */
+  c_offsize offsize; /* Offset array element size, 1-4    */
+  l_offset  *offset; /* Offset array, count + 1 offsets   */
+  card8     *data;   /* Object data                       */
+} cff_index;
+
+
+/* Dictionary */
+typedef struct {
+  int     id;     /* encoded data value (as card8 or card16) */
+  char   *key;    /* opname                                  */
+  int     count;  /* number of values                        */
+  double *values; /* values                                  */
+} cff_dict_entry;
+
+typedef struct {
+  int    max;
+  int    count;
+  cff_dict_entry *entries;
+} cff_dict;
+
+/* Encoding, Charset and FDSelect */
+typedef struct
+{
+  s_SID   first;  /* SID or CID, or card8 for Encoding  */
+  card8 n_left; /* no. of remaining gids/codes in this range */
+} cff_range1;
+
+typedef struct
+{
+  s_SID    first;  /* SID or CID (card16)      */
+  card16 n_left; /* card16-version of range1 */
+} cff_range2;
+
+typedef struct
+{
+  card8 code;
+  s_SID   glyph;
+} cff_map;
+
+typedef struct
+{
+  card8 format;       /* if (format & 0x80) then have supplement */
+  card8 num_entries;  /* number of entries */
+  union {
+    card8 *codes;       /* format 0 */
+    cff_range1 *range1; /* format 1 */
+  } data;
+  card8 num_supps; /* number of supplementary data */
+  cff_map *supp;   /* supplement */
+} cff_encoding;
+
+typedef struct
+{
+  card8 format;
+  card16 num_entries;
+  union {
+    s_SID *glyphs;        /* format 0 */
+    cff_range1 *range1; /* format 1 */
+    cff_range2 *range2; /* format 2 */
+  } data;
+} cff_charsets;
+
+/* CID-Keyed font specific */
+typedef struct
+{
+  card16 first;
+  card8  fd;
+} cff_range3;
+
+typedef struct
+{
+  card8 format;
+  card16 num_entries; /* number of glyphs/ranges */
+  union {
+    card8      *fds;    /* format 0 */
+    cff_range3 *ranges; /* format 3 */
+  } data;
+  /* card16 sentinel; */ /* format 3 only, must be equals to num_glyphs */
+} cff_fdselect;
+
+#endif /* _CFF_TYPES_H_ */
+
+#ifndef _CFF_STDSTR_H_
+#define _CFF_STDSTR_H_
+
+#define CFF_STDSTR_MAX 391
+
+extern const char *const cff_stdstr[];
+#endif /* _CFF_STDSTR_H_ */
+
+#ifndef _CFF_H_
+#define _CFF_H_
+
+/*#include "mfileio.h"*/
+
+/* Flag */
+#define FONTTYPE_CIDFONT  (1 << 0)
+#define FONTTYPE_FONT     (1 << 1)
+#define FONTTYPE_MMASTER  (1 << 2)
+
+#define ENCODING_STANDARD (1 << 3)
+#define ENCODING_EXPERT   (1 << 4)
+
+#define CHARSETS_ISOADOBE (1 << 5)
+#define CHARSETS_EXPERT   (1 << 6)
+#define CHARSETS_EXPSUB   (1 << 7)
+
+#define HAVE_STANDARD_ENCODING (ENCODING_STANDARD|ENCODING_EXPERT)
+#define HAVE_STANDARD_CHARSETS \
+  (CHARSETS_ISOADOBE|CHARSETS_EXPERT|CHARSETS_EXPSUB)
+
+#define CFF_STRING_NOTDEF 65535
+
+typedef struct
+{
+  char         *fontname; /* FontName */
+
+  /* - CFF structure - */
+
+  card8         header_major; /* major version                  */
+  card8         header_minor; /* minor version                  */
+  card8         header_hdr_size; /* Header size (bytes)                  */
+  c_offsize     header_offsize;  /* Absolute offset (0) size             */
+
+  cff_index    *name;     /* Name INDEX */
+  cff_dict     *topdict;  /* Top DICT (single) */
+  cff_index    *string;   /* String INDEX */
+  cff_index    *gsubr;    /* Global Subr INDEX */
+  cff_encoding *encoding; /* Encodings */
+  cff_charsets *charsets; /* Charsets  */
+  cff_fdselect *fdselect; /* FDSelect, CIDFont only */
+  cff_index    *cstrings; /* CharStrings */
+  cff_dict    **fdarray;  /* CIDFont only */
+  cff_dict    **private;  /* per-Font DICT */
+  cff_index   **subrs;    /* Local Subr INDEX, per-Private DICT */
+
+  /* -- extra data -- */
+  l_offset    gsubr_offset;
+  card16      num_glyphs; /* number of glyphs (CharString INDEX count) */
+  card8       num_fds;    /* number of Font DICT */
+
+  /* Updated String INDEX.
+   * Please fix this. We should separate input and output.
+   */
+  cff_index  *_string;
+
+  unsigned char *stream;
+  l_offset    offset;   
+  l_offset    stream_size; 
+
+  int           index;    /* CFF fontset index */
+  int           flag;     /* Flag: see above */
+} cff_font;
+
+extern cff_font *cff_open(unsigned char *stream, long stream_size, int n);
+extern void      cff_close (cff_font *cff);
+
+#define cff_seek_set(c, p) seek_absolute (((c)->stream), ((c)->offset) + (p));
+
+/* CFF Header */
+extern long cff_put_header (cff_font *cff, card8 *dest, long destlen);
+
+/* CFF INDEX */
+extern cff_index *cff_get_index        (cff_font *cff);
+extern cff_index *cff_get_index_header (cff_font *cff);
+extern void       cff_release_index    (cff_index *idx);
+extern cff_index *cff_new_index        (card16 count);
+extern long       cff_index_size       (cff_index *idx);
+extern long       cff_pack_index       (cff_index *idx, card8 *dest, long destlen);
+
+/* Name INDEX */
+extern char *cff_get_name (cff_font *cff);
+extern long  cff_set_name (cff_font *cff, char *name);
+
+/* Global and Local Subrs INDEX */
+extern long  cff_read_subrs (cff_font *cff);
+
+/* Encoding */
+extern long   cff_read_encoding    (cff_font *cff);
+extern long   cff_pack_encoding    (cff_font *cff, card8 *dest, long destlen);
+extern card16 cff_encoding_lookup  (cff_font *cff, card8 code);
+extern void   cff_release_encoding (cff_encoding *encoding);
+
+/* Charsets */
+extern long   cff_read_charsets    (cff_font *cff);
+extern long   cff_pack_charsets    (cff_font *cff, card8 *dest, long destlen);
+
+/* Returns GID of PS name "glyph" */
+extern card16 cff_glyph_lookup     (cff_font *cff, const char *glyph);
+/* Returns GID of glyph with SID/CID "cid" */
+extern card16 cff_charsets_lookup  (cff_font *cff, card16 cid);
+extern void   cff_release_charsets (cff_charsets *charset);
+/* Returns SID or CID */
+extern card16 cff_charsets_lookup_inverse (cff_font *cff, card16 gid);
+
+/* FDSelect */
+extern long  cff_read_fdselect    (cff_font *cff);
+extern long  cff_pack_fdselect    (cff_font *cff, card8 *dest, long destlen);
+extern card8 cff_fdselect_lookup  (cff_font *cff, card16 gid);
+extern void  cff_release_fdselect (cff_fdselect *fdselect);
+
+/* Font DICT(s) */
+extern long  cff_read_fdarray (cff_font *cff);
+
+/* Private DICT(s) */
+extern long  cff_read_private (cff_font *cff);
+
+/* String */
+extern int   cff_match_string  (cff_font *cff, const char *str, s_SID sid);
+extern char *cff_get_string    (cff_font *cff, s_SID id);
+extern long  cff_get_sid       (cff_font *cff, char *str);
+extern s_SID cff_add_string    (cff_font *cff, char *str);
+extern void  cff_update_string (cff_font *cff);
+
+#define cff_is_stdstr(s) (cff_get_sid(NULL, (s)) >= 0)
+
+#endif /* _CFF_H_ */
+
+#ifndef _CFF_DICT_H_
+#define _CFF_DICT_H_
+
+#define CFF_CIDCOUNT_DEFAULT      8720
+#define CFF_NOMINALWIDTHX_DEFAULT 0.0
+#define CFF_DEFAULTWIDTHX_DEFAULT 0.0
+
+extern cff_dict *cff_new_dict (void);
+extern void      cff_release_dict (cff_dict *dict);
+
+extern void   cff_dict_set (cff_dict *dict, const char *key, int idx, double value);
+extern double cff_dict_get (cff_dict *dict, const char *key, int idx);
+extern void   cff_dict_add (cff_dict *dict, const char *key, int count);
+extern void   cff_dict_remove (cff_dict *dict, const char *key);
+extern int    cff_dict_known  (cff_dict *dict, const char *key);
+
+/* decode/encode DICT */
+extern cff_dict *cff_dict_unpack (card8 *data, card8 *endptr);
+extern long      cff_dict_pack (cff_dict *dict, card8 *dest, long destlen);
+
+extern void      cff_dict_update (cff_dict *dict, cff_font *cff);
+
+#endif /* _CFF_DICT_H_ */
+
+#ifndef _CS_TYPE2_H_
+#define _CS_TYPE2_H_
+
+typedef struct {
+  int flags; /* unused in Type 2 charstring */
+  double wx, wy;
+  struct {
+    double llx, lly, urx, ury;
+  } bbox;
+  struct {
+    double asb, adx, ady;
+    card8  bchar, achar;
+  } seac;   /* unused in Type 2 charstring */
+} cs_ginfo;
+
+extern long cs_copy_charstring (card8 *dest, long destlen,
+                                card8 *src, long srclen,
+                                cff_index *gsubr, cff_index *subr,
+                                double default_width, double nominal_width, cs_ginfo *ginfo);
+#endif /* _CS_TYPE2_H_ */
+
+#define cff_is_cidfont(a) (a->flag & FONTTYPE_CIDFONT)
+#define cff_understandable(a) (a->header_major==1)
+
+extern cff_font *read_cff(unsigned char *buf,long buflength, int subf);
+
+extern void write_cff(cff_font *cff, fd_entry *fd, int hack);
+extern void write_cid_cff(cff_font *cffont, fd_entry *fd, int uglytype1fix) ;
diff --git a/Build/source/texk/web2c/luatexdir/font/writeenc.c b/Build/source/texk/web2c/luatexdir/font/writeenc.c
new file mode 100644
index 00000000000..feaf1407d1e
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writeenc.c
@@ -0,0 +1,183 @@
+/*
+Copyright (c) 1996-2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writeenc.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+/**********************************************************************/
+/* All encoding entries go into AVL tree for fast search by name. */
+
+struct avl_table *fe_tree = NULL;
+
+/* AVL sort fe_entry into fe_tree by name */
+
+static int comp_fe_entry(const void *pa, const void *pb, void *p)
+{
+    return strcmp(((const fe_entry *) pa)->name, ((const fe_entry *) pb)->name);
+}
+
+fe_entry *new_fe_entry()
+{
+    fe_entry *fe;
+    fe = xtalloc(1, fe_entry);
+    fe->name = NULL;
+    fe->fe_objnum = 0;
+    fe->glyph_names = NULL;     /* encoding file not yet read in */
+    fe->tx_tree = NULL;
+    return fe;
+}
+
+fe_entry *lookup_fe_entry(char *s)
+{
+    fe_entry fe;
+    assert(s != NULL);
+    fe.name = s;
+    if (fe_tree == NULL) {
+        fe_tree = avl_create(comp_fe_entry, NULL, &avl_xallocator);
+        assert(fe_tree != NULL);
+    }
+    return (fe_entry *) avl_find(fe_tree, &fe);
+}
+
+void register_fe_entry(fe_entry * fe)
+{
+    void **aa;
+    if (fe_tree == NULL) {
+        fe_tree = avl_create(comp_fe_entry, NULL, &avl_xallocator);
+        assert(fe_tree != NULL);
+    }
+    assert(fe != NULL);
+    assert(fe->name != NULL);
+    assert(lookup_fe_entry(fe->name) == NULL);  /* encoding not yet registered */
+    aa = avl_probe(fe_tree, fe);
+    assert(aa != NULL);
+}
+
+fe_entry *get_fe_entry(char *s)
+{
+    fe_entry *fe;
+    char **gl;
+    if ((fe = lookup_fe_entry(s)) == NULL && (gl = load_enc_file(s)) != NULL) {
+        fe = new_fe_entry();
+        fe->name = s;
+        fe->glyph_names = gl;
+        register_fe_entry(fe);
+    }
+    return fe;
+}
+
+/**********************************************************************/
+
+void epdf_write_enc(char **glyph_names, integer fe_objnum)
+{
+    int i, i_old;
+    assert(glyph_names != NULL);
+    assert(fe_objnum != 0);
+    pdf_begin_dict(fe_objnum, 1);
+    pdf_puts("/Type /Encoding\n");
+    pdf_printf("/Differences [");
+    for (i = 0, i_old = -2; i < 256; i++)
+        if (glyph_names[i] != notdef) {
+            if (i == i_old + 1) /* no gap */
+                pdf_printf("/%s", glyph_names[i]);
+            else {
+                if (i_old == -2)
+                    pdf_printf("%i/%s", i, glyph_names[i]);
+                else
+                    pdf_printf(" %i/%s", i, glyph_names[i]);
+            }
+            i_old = i;
+        }
+    pdf_puts("]\n");
+    pdf_end_dict();
+}
+
+void write_enc(char **glyph_names, struct avl_table *tx_tree, integer fe_objnum)
+{
+    int i_old, *p;
+    struct avl_traverser t;
+    assert(glyph_names != NULL);
+    assert(tx_tree != NULL);
+    assert(fe_objnum != 0);
+    pdf_begin_dict(fe_objnum, 1);
+    pdf_puts("/Type /Encoding\n");
+    pdf_printf("/Differences [");
+    avl_t_init(&t, tx_tree);
+    for (i_old = -2, p = (int *) avl_t_first(&t, tx_tree); p != NULL;
+         p = (int *) avl_t_next(&t)) {
+        if (*p == i_old + 1)    /* no gap */
+            pdf_printf("/%s", glyph_names[*p]);
+        else {
+            if (i_old == -2)
+                pdf_printf("%i/%s", *p, glyph_names[*p]);
+            else
+                pdf_printf(" %i/%s", *p, glyph_names[*p]);
+        }
+        i_old = *p;
+    }
+    pdf_puts("]\n");
+    pdf_end_dict();
+}
+
+void write_fontencoding(fe_entry * fe)
+{
+    assert(fe != NULL);
+    write_enc(fe->glyph_names, fe->tx_tree, fe->fe_objnum);
+}
+
+void write_fontencodings()
+{
+    fe_entry *fe;
+    struct avl_traverser t;
+    if (fe_tree == NULL)
+        return;
+    avl_t_init(&t, fe_tree);
+    for (fe = (fe_entry *) avl_t_first(&t, fe_tree); fe != NULL;
+         fe = (fe_entry *) avl_t_next(&t))
+        if (fe->fe_objnum != 0)
+            write_fontencoding(fe);
+}
+
+/**********************************************************************/
+/* cleaning up... */
+
+static void destroy_fe_entry(void *pa, void *pb)
+{
+    fe_entry *p;
+    int i;
+    p = (fe_entry *) pa;
+    xfree(p->name);
+    if (p->glyph_names != NULL)
+        for (i = 0; i < 256; i++)
+            if (p->glyph_names[i] != notdef)
+                xfree(p->glyph_names[i]);
+    xfree(p->glyph_names);
+    xfree(p);
+}
+
+void enc_free()
+{
+    if (fe_tree != NULL)
+        avl_destroy(fe_tree, destroy_fe_entry);
+    fe_tree = NULL;
+}
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/luatexdir/font/writefont.c b/Build/source/texk/web2c/luatexdir/font/writefont.c
new file mode 100644
index 00000000000..05257746889
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writefont.c
@@ -0,0 +1,885 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writefont.c 1112 2008-03-20 14:46:32Z taco $
+*/
+
+#include "ptexlib.h"
+
+extern void writetype0 (fd_entry * fd) ;
+extern void writetype2 (fd_entry * fd) ;
+extern unsigned long cidtogid_obj;
+
+#ifdef DO_TYPE1C
+extern void writet1c(fd_entry * fd); /* in writecff.c */
+#endif
+
+extern void writet1w   (fd_entry * fd); /* in writecff.c */
+extern void writetype1w (fd_entry * fd);
+extern integer write_cid_tounicode(fo_entry * fo, internalfontnumber f); /* in tounicode.c */
+
+
+void write_cid_fontdictionary(fo_entry * fo, internalfontnumber f);
+void create_cid_fontdictionary(fm_entry * fm, integer font_objnum, internalfontnumber f);
+
+/**********************************************************************/
+
+struct avl_table *fo_tree = NULL;       /* tree of font dictionaries */
+struct avl_table *fd_tree = NULL;       /* tree of font descriptor objects */
+
+static int comp_fo_entry(const void *pa, const void *pb, void *p)
+{
+    return strcmp(((const fo_entry *) pa)->fm->tfm_name,
+                  ((const fo_entry *) pb)->fm->tfm_name);
+}
+
+static int comp_fd_entry(const void *pa, const void *pb, void *p)
+{
+    int i;
+    const fd_entry *p1 = (const fd_entry *) pa, *p2 = (const fd_entry *) pb;
+    assert(p1->fm != NULL && is_fontfile(p1->fm) &&
+           p2->fm != NULL && is_fontfile(p2->fm));
+    if ((i = strcmp(p1->fm->ff_name, p2->fm->ff_name)) != 0)
+        return i;
+    cmp_return(p1->fm->slant, p2->fm->slant);
+    cmp_return(p1->fm->extend, p2->fm->extend);
+    return 0;
+}
+
+/**********************************************************************/
+/* initialize data structure for /Type /Font */
+
+fo_entry *new_fo_entry(void)
+{
+    fo_entry *fo;
+    fo = xtalloc(1, fo_entry);
+    fo->fo_objnum = 0;
+    fo->tex_font = 0;
+    fo->fm = NULL;
+    fo->fd = NULL;
+    fo->fe = NULL;
+    fo->cw_objnum = 0;
+    fo->first_char = 1;
+    fo->last_char = 0;
+    fo->tx_tree = NULL;
+    fo->tounicode_objnum = 0;
+    return fo;
+}
+
+/* initialize data structure for /Type /FontDescriptor */
+
+fd_entry *new_fd_entry(void)
+{
+    fd_entry *fd;
+    int i;
+    fd = xtalloc(1, fd_entry);
+    fd->fd_objnum = 0;
+    fd->fontname = NULL;
+    fd->subset_tag = NULL;
+    fd->ff_found = false;
+    fd->ff_objnum = 0;
+    fd->fn_objnum = 0;
+    fd->all_glyphs = false;
+    fd->write_ttf_glyph_names = false;
+    for (i = 0; i < INT_KEYS_NUM; i++) {
+        fd->font_dim[i].val = 0;
+        fd->font_dim[i].set = false;
+    }
+    fd->fe = NULL;
+    fd->builtin_glyph_names = NULL;
+    fd->fm = NULL;
+    fd->tx_tree = NULL;
+    fd->gl_tree = NULL;
+    return fd;
+}
+
+/**********************************************************************/
+/*
+ * Only fallback values of font metrics are taken from the TFM info
+ * of f by preset_fontmetrics(). During reading of the font file,
+ * these values are replaced by metrics from the font, if available.
+ */
+
+static void preset_fontmetrics(fd_entry * fd, internalfontnumber f)
+{
+    int i;
+    fd->font_dim[ITALIC_ANGLE_CODE].val =
+        divide_scaled(-atan(get_slant(f) / 65536.0) * (180 / M_PI),
+					  pdf_font_size(f), 3);
+    fd->font_dim[ASCENT_CODE].val =
+	  divide_scaled(char_height(f, 'h'), pdf_font_size(f), 3);
+    fd->font_dim[CAPHEIGHT_CODE].val =
+	  divide_scaled(char_height(f, 'H'), pdf_font_size(f), 3);
+    i = -divide_scaled(char_depth(f, 'y'), pdf_font_size(f), 3);
+    fd->font_dim[DESCENT_CODE].val = i < 0 ? i : 0;
+    fd->font_dim[STEMV_CODE].val =
+	  divide_scaled(char_width(f, '.') / 3, pdf_font_size(f), 3);
+    fd->font_dim[XHEIGHT_CODE].val =
+	  divide_scaled(get_x_height(f), pdf_font_size(f), 3);
+    fd->font_dim[FONTBBOX1_CODE].val = 0;
+    fd->font_dim[FONTBBOX2_CODE].val = fd->font_dim[DESCENT_CODE].val;
+    fd->font_dim[FONTBBOX3_CODE].val =
+	  divide_scaled(get_quad(f), pdf_font_size(f), 3);
+    fd->font_dim[FONTBBOX4_CODE].val =
+        fd->font_dim[CAPHEIGHT_CODE].val > fd->font_dim[ASCENT_CODE].val ?
+        fd->font_dim[CAPHEIGHT_CODE].val : fd->font_dim[ASCENT_CODE].val;
+    for (i = 0; i < INT_KEYS_NUM; i++)
+        fd->font_dim[i].set = true;
+}
+
+static void write_fontmetrics(fd_entry * fd)
+{
+    int i;
+    if (fd->font_dim[FONTBBOX1_CODE].set && fd->font_dim[FONTBBOX2_CODE].set
+        && fd->font_dim[FONTBBOX3_CODE].set && fd->font_dim[FONTBBOX4_CODE].set)
+        pdf_printf("/%s [%i %i %i %i]\n", font_key[FONTBBOX1_CODE].pdfname,
+                   (int) fd->font_dim[FONTBBOX1_CODE].val,
+                   (int) fd->font_dim[FONTBBOX2_CODE].val,
+                   (int) fd->font_dim[FONTBBOX3_CODE].val,
+                   (int) fd->font_dim[FONTBBOX4_CODE].val);
+    for (i = 0; i < GEN_KEY_NUM; i++)
+        if (fd->font_dim[i].set)
+            pdf_printf("/%s %i\n", font_key[i].pdfname, fd->font_dim[i].val);
+}
+
+/**********************************************************************/
+
+static void preset_fontname(fo_entry * fo)
+{
+    if (fo->fm->ps_name != NULL)
+        fo->fd->fontname = xstrdup(fo->fm->ps_name);    /* just fallback */
+    else
+        fo->fd->fontname = xstrdup(fo->fm->tfm_name);
+}
+
+static void write_fontname(fd_entry * fd, char *key)
+{
+    assert(fd->fontname != NULL);
+    pdf_puts("/");
+    if (key != NULL)
+        pdf_printf("%s /", key);
+    if (fd->subset_tag != NULL)
+        pdf_printf("%s+", fd->subset_tag);
+    pdf_printf("%s\n", fd->fontname);
+}
+
+static void write_fontname_object(fd_entry * fd)
+{
+    assert(fd->fn_objnum != 0);
+    pdf_begin_obj(fd->fn_objnum, 1);
+    write_fontname(fd, NULL);
+    pdf_end_obj();
+}
+
+/**********************************************************************/
+
+fd_entry *lookup_fd_entry(char *s, integer slant, integer extend)
+{
+    fd_entry fd;
+    fm_entry fm;
+    assert(s != NULL);
+    fm.ff_name = s;
+    fm.slant = slant;
+    fm.extend = extend;
+    fd.fm = &fm;
+    if (fd_tree == NULL) {
+        fd_tree = avl_create(comp_fd_entry, NULL, &avl_xallocator);
+        assert(fd_tree != NULL);
+    }
+    return (fd_entry *) avl_find(fd_tree, &fd);
+}
+
+fd_entry *lookup_fontdescriptor(fo_entry * fo)
+{
+    assert(fo != NULL);
+    assert(fo->fm != NULL);
+    assert(is_fontfile(fo->fm));
+    return lookup_fd_entry(fo->fm->ff_name, fo->fm->slant, fo->fm->extend);
+}
+
+void register_fd_entry(fd_entry * fd)
+{
+    void **aa;
+    if (fd_tree == NULL) {
+        fd_tree = avl_create(comp_fd_entry, NULL, &avl_xallocator);
+        assert(fd_tree != NULL);
+    }
+    assert(fd != NULL && fd->fm != NULL && is_fontfile(fd->fm));
+    assert(lookup_fd_entry(fd->fm->ff_name, fd->fm->slant, fd->fm->extend) == NULL);    /* font descriptor not yet registered */
+    aa = avl_probe(fd_tree, fd);
+    assert(aa != NULL);
+}
+
+void create_fontdescriptor(fo_entry * fo, internalfontnumber f)
+{
+    assert(fo != NULL);
+    assert(fo->fm != NULL);
+    assert(fo->fd == NULL);
+    fo->fd = new_fd_entry();
+    preset_fontname(fo);
+    preset_fontmetrics(fo->fd, f);
+    fo->fd->fe = fo->fe;        /* encoding needed by TrueType writing */
+    fo->fd->fm = fo->fm;        /* map entry needed by TrueType writing */
+    fo->fd->gl_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
+    assert(fo->fd->gl_tree != NULL);
+}
+
+/**********************************************************************/
+/*
+ * For all used characters of TeX font f, get corresponding glyph names
+ * from external reencoding (.enc) file and collect these in the glyph
+ * tree gl_tree of font descriptor fd referenced by font dictionary fo.
+ */
+
+void mark_reenc_glyphs(fo_entry * fo, internalfontnumber f)
+{
+    int i;
+    char **g;
+    void **aa;
+    assert(fo->fe != NULL);
+    if (is_subsetted(fo->fm)) {
+        assert(is_included(fo->fm));
+        /* mark glyphs from TeX (externally reencoded characters) */
+        g = fo->fe->glyph_names;
+        for (i = fo->first_char; i <= fo->last_char; i++) {
+            if (pdf_char_marked(f, i) && g[i] != notdef
+                && (char *) avl_find(fo->fd->gl_tree, g[i]) == NULL) {
+                aa = avl_probe(fo->fd->gl_tree, xstrdup(g[i]));
+                assert(aa != NULL);
+            }
+        }
+    }
+}
+
+/*
+ * Function mark_chars() has 2 uses:
+ * 1. Mark characters as chars on TeX level.
+ * 2. Mark encoding pairs used by TeX to optimize encoding vector.
+ */
+
+struct avl_table *mark_chars(fo_entry * fo, struct avl_table *tx_tree,
+                             internalfontnumber f)
+{
+    int i, *j;
+    void **aa;
+    if (tx_tree == NULL) {
+        tx_tree = avl_create(comp_int_entry, NULL, &avl_xallocator);
+        assert(tx_tree != NULL);
+    }
+    for (i = fo->first_char; i <= fo->last_char; i++) {
+        if (pdf_char_marked(f, i) && (int *) avl_find(tx_tree, &i) == NULL) {
+            j = xtalloc(1, int);
+            *j = i;
+            aa = avl_probe(tx_tree, j);
+            assert(aa != NULL);
+        }
+    }
+    return tx_tree;
+}
+
+/**********************************************************************/
+
+void get_char_range(fo_entry * fo, internalfontnumber f)
+{
+    int i;
+    assert(fo != NULL);
+    for (i = font_bc(f); i <= font_ec(f); i++)    /* search for first_char and last_char */
+        if (pdf_char_marked(f, i))
+            break;
+    fo->first_char = i;
+    for (i = font_ec(f); i >= font_bc(f); i--)
+        if (pdf_char_marked(f, i))
+            break;
+    fo->last_char = i;
+    if ((fo->first_char > fo->last_char)
+        || !pdf_char_marked(f, fo->first_char)) { /* no character used from this font */
+        fo->last_char = 0;
+        fo->first_char = fo->last_char + 1;
+    }
+}
+
+static void write_charwidth_array(fo_entry * fo, internalfontnumber f)
+{
+    int i, j, *ip, *fip, width;
+    struct avl_traverser t;
+    assert(fo->tx_tree != NULL);
+    assert(fo->cw_objnum == 0);
+    fo->cw_objnum = pdf_new_objnum();
+    pdf_begin_obj(fo->cw_objnum, 1);
+    avl_t_init(&t, fo->tx_tree);
+    fip = (int *) avl_t_first(&t, fo->tx_tree);
+    assert(fip != NULL);
+    pdf_puts("[");
+    for (ip = fip, j = *ip; ip != NULL; ip = (int *) avl_t_next(&t)) {
+        if (ip != fip)
+            pdf_puts(" ");
+        i = *ip;
+        while (j < i - 1) {
+            pdf_puts("0 ");
+            j++;
+        }
+        j = i;
+        width = divide_scaled(char_width(f, i), pdf_font_size(f), 4);
+        pdf_printf("%i", (int) width / 10);     /* see adv_char_width() in pdftex.web */
+        if ((width = width % 10) != 0)
+            pdf_printf(".%i", width);
+    }
+    pdf_puts("]\n");
+    pdf_end_obj();
+}
+
+/**********************************************************************/
+/*
+ * Remark: Font objects from embedded PDF files are never registered
+ * into fo_tree; they are individually written out.
+ */
+
+fo_entry *lookup_fo_entry(char *s)
+{
+    fo_entry fo;
+    fm_entry fm;
+    assert(s != NULL);
+    fm.tfm_name = s;
+    fo.fm = &fm;
+    if (fo_tree == NULL) {
+        fo_tree = avl_create(comp_fo_entry, NULL, &avl_xallocator);
+        assert(fo_tree != NULL);
+    }
+    return (fo_entry *) avl_find(fo_tree, &fo);
+}
+
+void register_fo_entry(fo_entry * fo)
+{
+    void **aa;
+    if (fo_tree == NULL) {
+        fo_tree = avl_create(comp_fo_entry, NULL, &avl_xallocator);
+        assert(fo_tree != NULL);
+    }
+    assert(fo != NULL);
+    assert(fo->fm != NULL);
+    assert(fo->fm->tfm_name != NULL);
+	assert (lookup_fo_entry(fo->fm->tfm_name) == NULL) ;
+	aa = avl_probe(fo_tree, fo);
+	assert(aa != NULL);
+}
+
+/**********************************************************************/
+
+static void write_fontfile(fd_entry * fd)
+{
+  assert(is_included(fd->fm));
+  if (is_cidkeyed(fd->fm)) {
+    if (is_opentype(fd->fm))
+      writetype0(fd);
+    else if (is_truetype(fd->fm))
+      writetype2(fd);
+    else if (is_type1(fd->fm))
+      writetype1w(fd);
+    else 
+      assert(0);
+  } else {
+    if (is_type1(fd->fm))
+#ifdef DO_TYPE1C
+      writet1c(fd);
+#else
+    writet1(fd);
+#endif
+    else if (is_truetype(fd->fm))
+      writettf(fd);
+    else if (is_opentype(fd->fm))
+      writeotf(fd);
+    else
+      assert(0);
+  }
+  if (!fd->ff_found)
+    return;
+  assert(fd->ff_objnum == 0);
+  fd->ff_objnum = pdf_new_objnum();
+  pdf_begin_dict(fd->ff_objnum, 0);     /* font file stream */
+  if (is_cidkeyed(fd->fm)) {
+    /* No subtype is used for TrueType-based OpenType fonts */
+    if (is_opentype(fd->fm) || is_type1(fd->fm))
+      pdf_puts("/Subtype /CIDFontType0C\n");
+    /* else
+       pdf_puts("/Subtype /OpenType\n");*/
+  } else {
+    if (is_type1(fd->fm))
+      pdf_printf("/Length1 %i\n/Length2 %i\n/Length3 %i\n",
+		 (int) t1_length1, (int) t1_length2, (int) t1_length3);
+    else if (is_truetype(fd->fm))
+      pdf_printf("/Length1 %i\n", (int) ttf_length);
+    else if (is_opentype(fd->fm))
+      pdf_puts("/Subtype /Type1C\n");
+    else
+      assert(0);
+    }
+  pdf_begin_stream();
+  fb_flush();
+  pdf_end_stream();
+}
+
+/**********************************************************************/
+
+static void write_fontdescriptor(fd_entry * fd)
+{
+    char *glyph;
+    struct avl_traverser t;
+    assert(fd != NULL && fd->fm != NULL);
+
+    if (is_fontfile(fd->fm))
+        write_fontfile(fd);     /* this will set fd->ff_found if font file is found */
+    if (fd->fn_objnum != 0)
+        write_fontname_object(fd);
+    if (fd->fd_objnum == 0)
+        fd->fd_objnum = pdf_new_objnum();
+    pdf_begin_dict(fd->fd_objnum, 1);
+    pdf_puts("/Type /FontDescriptor\n");
+    write_fontname(fd, "FontName");
+    if (!fd->ff_found && fd->fm->fd_flags == 4)
+        pdf_puts("/Flags 34\n");        /* assumes a roman sans serif font */
+    else
+        pdf_printf("/Flags %i\n", (int) fd->fm->fd_flags);
+    write_fontmetrics(fd);
+    if (is_cidkeyed(fd->fm)) {
+        if (is_type1(fd->fm)) 
+            pdf_printf("/FontFile3 %i 0 R\n", (int) fd->ff_objnum);
+        else if (is_truetype(fd->fm))
+            pdf_printf("/FontFile2 %i 0 R\n", (int) fd->ff_objnum);
+        else if (is_opentype(fd->fm))
+            pdf_printf("/FontFile3 %i 0 R\n", (int) fd->ff_objnum);
+        else
+            assert(0);
+    } else {
+      if (fd->ff_found) {
+        if (is_subsetted(fd->fm) && is_type1(fd->fm)) {
+            /* /CharSet is optional; names may appear in any order */
+            assert(fd->gl_tree != NULL);
+            avl_t_init(&t, fd->gl_tree);
+            pdf_puts("/CharSet (");
+            for (glyph = (char *) avl_t_first(&t, fd->gl_tree); glyph != NULL;
+                 glyph = (char *) avl_t_next(&t))
+                pdf_printf("/%s", glyph);
+            pdf_puts(")\n");
+        }
+        if (is_type1(fd->fm)) 
+            pdf_printf("/FontFile %i 0 R\n", (int) fd->ff_objnum);
+        else if (is_truetype(fd->fm))
+            pdf_printf("/FontFile2 %i 0 R\n", (int) fd->ff_objnum);
+        else if (is_opentype(fd->fm))
+            pdf_printf("/FontFile3 %i 0 R\n", (int) fd->ff_objnum);
+        else
+            assert(0);
+      }
+    }
+    /* TODO: Optional keys for CID fonts. 
+    
+       The most interesting ones are
+          /Style << /Panose <12-byte string>>>
+       and
+          /CIDSET <stream>
+       the latter can be used in subsets, to give the included CIDs
+       as a bitmap on the whole list.
+    */
+    pdf_end_dict();
+}
+
+void write_fontdescriptors()
+{
+    fd_entry *fd;
+    struct avl_traverser t;
+    if (fd_tree == NULL)
+        return;
+    avl_t_init(&t, fd_tree);
+    for (fd = (fd_entry *) avl_t_first(&t, fd_tree); fd != NULL;
+         fd = (fd_entry *) avl_t_next(&t))
+        write_fontdescriptor(fd);
+}
+
+/**********************************************************************/
+
+void write_fontdictionary(fo_entry * fo)
+{
+    assert(fo != NULL);
+    assert(fo->fm != NULL);
+    assert(fo->fo_objnum != 0); /* reserved as pdf_font_num(f) in pdftex.web */
+
+    /* write ToUnicode entry if needed */
+    if (fixed_gen_tounicode > 0 && fo->fd != NULL) {
+        if (fo->fe != NULL) {
+            fo->tounicode_objnum =
+                write_tounicode(fo->fe->glyph_names, fo->fe->name);
+        } else if (is_type1(fo->fm)) {
+            assert(fo->fd->builtin_glyph_names != NULL);
+            fo->tounicode_objnum =
+                write_tounicode(fo->fd->builtin_glyph_names, fo->fm->tfm_name);
+        }
+    }
+
+    pdf_begin_dict(fo->fo_objnum, 1);
+    pdf_puts("/Type /Font\n");
+    pdf_puts("/Subtype /");
+    if (is_type1(fo->fm))
+#ifdef DO_TYPE1C
+        pdf_printf("%s\n", "Type1C");
+#else
+        pdf_printf("%s\n", "Type1");
+#endif
+    else if (is_truetype(fo->fm))
+        pdf_printf("%s\n", "TrueType");
+    else if (is_opentype(fo->fm))
+        pdf_printf("%s\n", "Type1");
+    else
+        assert(0);
+    assert(fo->fd != NULL && fo->fd->fd_objnum != 0);
+    write_fontname(fo->fd, "BaseFont");
+    pdf_printf("/FontDescriptor %i 0 R\n", (int) fo->fd->fd_objnum);
+    assert(fo->cw_objnum != 0);
+    pdf_printf("/FirstChar %i\n/LastChar %i\n/Widths %i 0 R\n",
+               (int) fo->first_char, (int) fo->last_char,
+               (int) fo->cw_objnum);
+    if ((is_type1(fo->fm) || is_opentype(fo->fm)) && fo->fe != NULL && fo->fe->fe_objnum != 0)
+        pdf_printf("/Encoding %i 0 R\n", (int) fo->fe->fe_objnum);
+    if (fo->tounicode_objnum != 0)
+        pdf_printf("/ToUnicode %i 0 R\n", (int) fo->tounicode_objnum);
+    if (pdf_font_attr(fo->tex_font) != get_nullstr()) {
+	    pdf_print(pdf_font_attr(fo->tex_font));
+        pdf_puts("\n");
+    }
+    pdf_end_dict();
+}
+
+void write_fontdictionaries()
+{
+    fo_entry *fo;
+    struct avl_traverser t;
+    if (fo_tree == NULL)
+        return;
+    avl_t_init(&t, fo_tree);
+    for (fo = (fo_entry *) avl_t_first(&t, fo_tree); fo != NULL;
+         fo = (fo_entry *) avl_t_next(&t))
+        write_fontdictionary(fo);
+}
+
+/**********************************************************************/
+/*
+ * Final flush of all font related stuff by call from
+ * @<Output fonts definition@>= in pdftex.web.
+ */
+
+void write_fontstuff()
+{
+    write_fontdescriptors();
+    write_fontencodings();      /* see writeenc.c */
+    write_fontdictionaries();
+}
+
+/**********************************************************************/
+
+void create_fontdictionary(fm_entry * fm, integer font_objnum,
+                           internalfontnumber f)
+{
+    fo_entry *fo = new_fo_entry();
+    get_char_range(fo, f);      /* set fo->first_char and fo->last_char from f */
+    assert(fo->last_char >= fo->first_char);
+    fo->fm = fm;
+    fo->fo_objnum = font_objnum;
+    fo->tex_font = f;
+    if (is_reencoded(fo->fm)) { /* at least the map entry tells so */
+        fo->fe = get_fe_entry(fo->fm->encname); /* returns NULL if .enc file couldn't be opened */
+        if (fo->fe != NULL && (is_type1(fo->fm) || is_opentype(fo->fm))) {
+            if (fo->fe->fe_objnum == 0)
+                fo->fe->fe_objnum = pdf_new_objnum();     /* then it will be written out */
+            /* mark encoding pairs used by TeX to optimize encoding vector */
+            fo->fe->tx_tree = mark_chars(fo, fo->fe->tx_tree, f);
+        }
+    }
+    fo->tx_tree = mark_chars(fo, fo->tx_tree, f);       /* for write_charwidth_array() */
+    write_charwidth_array(fo, f);
+    if (!is_builtin(fo->fm)) {
+      if (is_type1(fo->fm)) {
+	if ((fo->fd = lookup_fontdescriptor(fo)) == NULL) {
+	  create_fontdescriptor(fo, f);
+	  register_fd_entry(fo->fd);
+	}
+      } else
+	create_fontdescriptor(fo, f);
+      if (fo->fe != NULL) {
+	mark_reenc_glyphs(fo, f);
+	if (!is_type1(fo->fm)) {
+	  /* mark reencoded characters as chars on TeX level */
+	  assert(fo->fd->tx_tree == NULL);
+	  fo->fd->tx_tree = mark_chars(fo, fo->fd->tx_tree, f);
+	  if (is_truetype(fo->fm))
+	    fo->fd->write_ttf_glyph_names = true;
+	}
+      } else
+	/* mark non-reencoded characters as chars on TeX level */
+	fo->fd->tx_tree = mark_chars(fo, fo->fd->tx_tree, f);
+      if (!is_type1(fo->fm))
+	write_fontdescriptor(fo->fd);
+    } else {
+      /* builtin fonts still need the /Widths array and /FontDescriptor
+       * (to avoid error 'font FOO contains bad /BBox')
+       */
+      create_fontdescriptor(fo, f);
+      write_fontdescriptor(fo->fd);
+      if (!is_std_t1font(fo->fm))
+	pdftex_warn("font `%s' is not a standard font; "
+		    "I suppose it is available to your PDF viewer then",
+		    fo->fm->ps_name);
+    }
+    if (is_type1(fo->fm))
+        register_fo_entry(fo);
+    else
+        write_fontdictionary(fo);
+}
+
+/**********************************************************************/
+
+
+void do_pdf_font(integer font_objnum, internalfontnumber f)
+{
+    fm_entry *fm;
+    /* This is not 100% true: CID is actually needed whenever (and
+	 * only) there are more than 256 separate glyphs used. But for
+	 * now, just assume the user knows what he is doing;
+	 */
+    if (font_encodingbytes(f)==2) {
+      /* Create a virtual font map entry, as this is needed by the
+	   * rest of the font inclusion mechanism.
+       */
+      fm = new_fm_entry();
+      fm->tfm_name = font_name(f);          /* or whatever, not a real tfm */
+      fm->ff_name = font_filename(f);       /* the actual file */
+      fm->encname = font_encodingname(f);   /* for the CIDSystemInfo */
+      fm->ps_name = font_fullname(f);       /* the true name */
+      fm->slant = font_slant(f);            /* slant factor */
+      fm->extend = font_extend(f);          /* extension factor */
+      fm->fd_flags = 4;                     /* can perhaps be done better */
+      fm->in_use = true;
+
+	  switch (font_format(f)) {
+	  case opentype_format:  set_opentype(fm); break; 
+	  case truetype_format:  set_truetype(fm); break; 
+	  case type1_format:     set_type1(fm); break;
+      default:
+		pdftex_fail("writefont.c: The file format (%s) for font `%s' is incompatible with wide characters\n", 
+					font_format_name(f),font_name(f));
+      }
+	  /* This makes "unknown" default to subsetted inclusion */
+	  if (font_embedding(f)!=no_embedding) {
+		set_included(fm);
+		if (font_embedding(f)!=full_embedding) {
+		  set_subsetted(fm);
+		}
+	  }
+      set_cidkeyed(fm);
+      create_cid_fontdictionary(fm, font_objnum, f);
+      
+    } else {
+      fm = hasfmentry(f) ? (fm_entry *) font_map(f) : NULL;
+      if (fm == NULL || (fm->ps_name == NULL && fm->ff_name == NULL))
+		writet3(font_objnum, f);
+      else
+		create_fontdictionary(fm, font_objnum, f);
+    }
+}
+
+/**********************************************************************/
+
+
+/* 
+   The glyph width is included in |glw_entry|, because that width
+   depends on the value it has in the font where it is actually
+   typeset from, not the font that is the 'owner' of the fd entry.
+
+   TODO: It is possible that the user messes with the metric width,
+   but handling that properly would require access to the 'hmtx' table
+   at this point in the program.
+*/
+
+int comp_glw_entry(const void *pa, const void *pb, void *p)
+{
+  unsigned short i, j;
+  i = (*(glw_entry *)pa).id;
+  j = (*(glw_entry *)pb).id;
+  cmp_return(i,j);
+  return 0;
+}
+
+void create_cid_fontdescriptor(fo_entry * fo, internalfontnumber f)
+{
+    assert(fo != NULL);
+    assert(fo->fm != NULL);
+    assert(fo->fd == NULL);
+    fo->fd = new_fd_entry();
+    preset_fontname(fo);
+    preset_fontmetrics(fo->fd, f);
+    fo->fd->fe = fo->fe;        /* encoding needed by TrueType writing */
+    fo->fd->fm = fo->fm;        /* map entry needed by TrueType writing */
+    fo->fd->gl_tree = avl_create(comp_glw_entry, NULL, &avl_xallocator);
+    assert(fo->fd->gl_tree != NULL);
+}
+
+/*
+   The values |font_bc()| and |font_ec()| are potentially large 
+   character ids, but the strings that are written out use CID
+   indexes, and those are limited to 16-bit values.
+*/
+
+static void mark_cid_subset_glyphs(fo_entry *fo, internal_font_number f) 
+{
+  int i, k;
+  glw_entry *j;
+  void *aa;
+  for (k = 1; k <= max_font_id(); k++) {
+    if ( k == f || -f == pdf_font_num(k)) { 
+      for (i = font_bc(k); i <= font_ec(k); i++) {
+		if (char_exists(k,i) && char_used(k,i)) {
+		  j = xtalloc(1,glw_entry);
+		  j->id = char_index(k,i);
+		  j->wd = divide_scaled_n(char_width(k, i), pdf_font_size(k), 10000.0);
+		  if ((glw_entry *)avl_find(fo->fd->gl_tree,j) == NULL) {
+		    	aa = avl_probe(fo->fd->gl_tree, j);
+			assert(aa != NULL);
+		  }
+		}
+      }
+    }
+  }
+}
+
+/* 
+   It is possible to compress the widths array even better, by using the
+   alternate 'range' syntax and possibly even using /DW to set 
+   a default value.
+  
+   There is a some optimization here already: glyphs that are
+   not used do not appear in the widths array at all. 
+
+   We have to make sure that we do not output an (incorrect!)
+   width for a character that exists in the font, but is not used
+   in typesetting. An enormous negative width is used as sentinel value
+*/
+
+
+static void write_cid_charwidth_array(fo_entry * fo)
+{
+  int i, j;
+  glw_entry *glyph;
+  struct avl_traverser t;
+
+  assert(fo->cw_objnum == 0);
+  fo->cw_objnum = pdf_new_objnum();
+  pdf_begin_obj(fo->cw_objnum, 1);
+  avl_t_init(&t, fo->fd->gl_tree);
+  glyph = (glw_entry *) avl_t_first(&t, fo->fd->gl_tree);
+  assert(glyph != NULL);
+  i = glyph->id;
+  pdf_printf("[ %i [", i);
+  for (; glyph != NULL; glyph = (glw_entry *) avl_t_next(&t)) {
+    j = glyph->wd;
+    if (glyph->id>(i+1)) {
+      pdf_printf("] %i [", glyph->id);
+      j = glyph->wd;
+    } 
+    if (glyph->id==(i+1))
+      pdf_puts(" ");
+    pdf_printf("%i", (j/10));
+    if ((j % 10) != 0)
+      pdf_printf(".%i", (j % 10));
+    i = glyph->id;
+  }
+  pdf_puts("]]\n");
+  pdf_end_obj();
+}
+
+
+void create_cid_fontdictionary(fm_entry * fm, integer font_objnum,
+			     internalfontnumber f)
+{
+    fo_entry *fo = new_fo_entry();
+    get_char_range(fo, f);      /* set fo->first_char and fo->last_char from f */
+    assert(fo->last_char >= fo->first_char);
+    fo->fm = fm;
+    fo->fo_objnum = font_objnum;
+    fo->tex_font = f;
+    create_cid_fontdescriptor (fo, f);
+    mark_cid_subset_glyphs (fo,f);
+    if (is_subsetted(fo->fm)) {
+      /* 
+	 this is a bit sneaky. |make_subset_tag()| actually expects the glyph tree
+	 to contain strings instead of |glw_entry| items. However, all calculations
+	 are done using explicit typecasts, so it works out ok.
+      */
+      make_subset_tag(fo->fd);
+    }
+    write_cid_charwidth_array(fo);
+    write_fontdescriptor(fo->fd);
+    
+    write_cid_fontdictionary(fo,f);
+}
+
+void write_cid_fontdictionary(fo_entry * fo, internalfontnumber f)
+{
+    int i;
+
+    fo->tounicode_objnum = write_cid_tounicode(fo,f);
+
+    pdf_begin_dict(fo->fo_objnum, 1);
+    pdf_puts("/Type /Font\n");
+    pdf_puts("/Subtype /Type0\n");
+    pdf_puts("/Encoding /Identity-H\n");
+    write_fontname(fo->fd, "BaseFont");
+    i  = pdf_new_objnum();
+    pdf_printf("/DescendantFonts [%i 0 R]\n", i);
+    /* todo: the ToUnicode CMap */
+	if (fo->tounicode_objnum != 0)
+	  pdf_printf("/ToUnicode %i 0 R\n", (int) fo->tounicode_objnum);
+    
+    pdf_end_dict();
+
+    pdf_begin_dict(i, 1);
+    pdf_puts("/Type /Font\n");
+    if (is_opentype(fo->fm) || is_type1(fo->fm)) {
+      pdf_puts("/Subtype /CIDFontType0\n");
+    } else {
+      pdf_puts("/Subtype /CIDFontType2\n");
+	  pdf_printf("/CIDToGIDMap /Identity\n");
+    }
+    write_fontname(fo->fd, "BaseFont");
+    pdf_printf("/FontDescriptor %i 0 R\n", (int) fo->fd->fd_objnum);
+    pdf_printf("/W %i 0 R\n",(int) fo->cw_objnum);
+    pdf_printf("/CIDSystemInfo <<\n");
+    pdf_printf("/Registry (%s)\n", (font_cidregistry(f)? font_cidregistry(f): "Adobe"));
+    pdf_printf("/Ordering (%s)\n",(font_cidordering(f)? font_cidordering(f) : "Identity")) ;
+    pdf_printf("/Supplement %u\n",(unsigned int)font_cidsupplement(f));
+    pdf_printf(">>\n");
+
+    /* I doubt there is anything useful that could be written here */
+    /*      
+      if (pdf_font_attr(fo->tex_font) != get_nullstr()) {
+      pdf_print(pdf_font_attr(fo->tex_font));
+      pdf_puts("\n");
+      }
+    */
+    pdf_end_dict();
+
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/writet1.c b/Build/source/texk/web2c/luatexdir/font/writet1.c
new file mode 100644
index 00000000000..376135dc8be
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writet1.c
@@ -0,0 +1,1768 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+
+*/
+
+#  include "ptexlib.h"
+#  include <kpathsea/c-vararg.h>
+#  include <kpathsea/c-proto.h>
+#  include <string.h>
+#  include "luatex-api.h"
+
+#  define t1_log(s)        if(tracefilenames) tex_printf(s)
+#  define get_length1()    t1_length1 = t1_offset() - t1_save_offset
+#  define get_length2()    t1_length2 = t1_offset() - t1_save_offset
+#  define get_length3()    t1_length3 = fixedcontent? t1_offset() - t1_save_offset : 0
+#  define save_offset()    t1_save_offset = t1_offset()
+
+#  define t1_putchar          fb_putchar
+#  define t1_offset           fb_offset
+#  define out_eexec_char      t1_putchar
+
+#  define end_last_eexec_line() \
+    t1_eexec_encrypt = false
+#  define t1_char(c)          c
+#  define embed_all_glyphs(tex_font)  fm_cur->all_glyphs
+#  define extra_charset()     fm_cur->charset
+#  define update_subset_tag() \
+    strncpy(fb_array + t1_fontname_offset, fm_cur->subset_tag, 6)
+#  define fixedcontent        false
+
+integer t1_length1, t1_length2, t1_length3;
+static integer t1_save_offset;
+static integer t1_fontname_offset;
+extern char *fb_array;
+
+static unsigned char *t1_buffer = NULL;
+static integer t1_size = 0;
+static integer t1_curbyte = 0;
+
+#define t1_read_file()  \
+    readbinfile(t1_file,&t1_buffer,&t1_size)
+#define t1_close()      xfclose(t1_file,cur_file_name)
+#define t1_getchar()    t1_buffer[t1_curbyte++]
+#define t1_ungetchar(c) t1_curbyte--
+#define t1_eof()        (t1_curbyte>t1_size)
+
+#define t1_prefix(s)        str_prefix(t1_line_array, s)
+#define t1_buf_prefix(s)    str_prefix(t1_buf_array, s)
+#define t1_suffix(s)        str_suffix(t1_line_array, t1_line_ptr, s)
+#define t1_buf_suffix(s)    str_suffix(t1_buf_array, t1_buf_ptr, s)
+#define t1_charstrings()    strstr(t1_line_array, charstringname)
+#define t1_subrs()          t1_prefix("/Subrs")
+#define t1_end_eexec()      t1_suffix("mark currentfile closefile")
+#define t1_cleartomark()    t1_prefix("cleartomark")
+
+static unsigned char *enc_buffer = NULL;
+static integer enc_size = 0;
+static integer enc_curbyte = 0;
+
+#define enc_open()          \
+    open_input(&enc_file, kpse_enc_format, FOPEN_RBIN_MODE)
+#define enc_read_file()  \
+    readbinfile(enc_file,&enc_buffer,&enc_size)
+#define enc_close()       xfclose(enc_file,cur_file_name)
+#define enc_getchar()    enc_buffer[enc_curbyte++]
+#define enc_eof()        (enc_curbyte>enc_size)
+
+#define valid_code(c)   (c >= 0 && c < 256)
+#define fixedcontent     false
+
+static const char *standard_glyph_names[256] = {
+    /* 0x00 */
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    /* 0x10 */
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    /* 0x20 */
+    "space", "exclam", "quotedbl", "numbersign", "dollar", "percent",
+    "ampersand", "quoteright", "parenleft", "parenright", "asterisk",
+    "plus", "comma", "hyphen", "period", "slash",
+    /* 0x30 */
+    "zero", "one", "two", "three", "four", "five", "six", "seven", "eight",
+    "nine", "colon", "semicolon", "less", "equal", "greater", "question",
+    /* 0x40 */
+    "at", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N",
+    "O",
+    /* 0x50 */
+    "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft",
+    "backslash", "bracketright", "asciicircum", "underscore",
+    /* 0x60 */
+    "quoteleft", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l",
+    "m", "n", "o",
+    /* 0x70 */
+    "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "braceleft", "bar",
+    "braceright", "asciitilde", notdef,
+    /* 0x80 */
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    /* 0x90 */
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    /* 0xa0 */
+    notdef, "exclamdown", "cent", "sterling", "fraction", "yen", "florin",
+    "section", "currency", "quotesingle", "quotedblleft", "guillemotleft",
+    "guilsinglleft", "guilsinglright", "fi", "fl",
+    /* 0xb0 */
+    notdef, "endash", "dagger", "daggerdbl", "periodcentered", notdef,
+    "paragraph", "bullet", "quotesinglbase", "quotedblbase",
+    "quotedblright", "guillemotright", "ellipsis", "perthousand", notdef,
+    "questiondown",
+    /* 0xc0 */
+    notdef, "grave", "acute", "circumflex", "tilde", "macron", "breve",
+    "dotaccent", "dieresis", notdef,
+    "ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron",
+    /* 0xd0 */
+    "emdash", notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    /* 0xe0 */
+    notdef, "AE", notdef, "ordfeminine", notdef, notdef, notdef, notdef,
+    "Lslash", "Oslash", "OE", "ordmasculine", notdef, notdef, notdef,
+    notdef,
+    /* 0xf0 */
+    notdef, "ae", notdef, notdef, notdef, "dotlessi", notdef, notdef, "lslash",
+    "oslash", "oe", "germandbls", notdef, notdef, notdef, notdef
+};
+
+
+integer t1_length1, t1_length2, t1_length3;
+static integer t1_save_offset;
+static integer t1_fontname_offset;
+extern char *fb_array;
+static fd_entry *fd_cur;
+
+static char charstringname[] = "/CharStrings";
+
+enum { ENC_STANDARD, ENC_BUILTIN } t1_encoding;
+
+#define T1_BUF_SIZE   0x10
+#define ENC_BUF_SIZE  0x1000
+
+#define CS_HSTEM            1
+#define CS_VSTEM            3
+#define CS_VMOVETO          4
+#define CS_RLINETO          5
+#define CS_HLINETO          6
+#define CS_VLINETO          7
+#define CS_RRCURVETO        8
+#define CS_CLOSEPATH        9
+#define CS_CALLSUBR         10
+#define CS_RETURN           11
+#define CS_ESCAPE           12
+#define CS_HSBW             13
+#define CS_ENDCHAR          14
+#define CS_RMOVETO          21
+#define CS_HMOVETO          22
+#define CS_VHCURVETO        30
+#define CS_HVCURVETO        31
+#define CS_1BYTE_MAX        (CS_HVCURVETO + 1)
+
+#define CS_DOTSECTION       CS_1BYTE_MAX + 0
+#define CS_VSTEM3           CS_1BYTE_MAX + 1
+#define CS_HSTEM3           CS_1BYTE_MAX + 2
+#define CS_SEAC             CS_1BYTE_MAX + 6
+#define CS_SBW              CS_1BYTE_MAX + 7
+#define CS_DIV              CS_1BYTE_MAX + 12
+#define CS_CALLOTHERSUBR    CS_1BYTE_MAX + 16
+#define CS_POP              CS_1BYTE_MAX + 17
+#define CS_SETCURRENTPOINT  CS_1BYTE_MAX + 33
+#define CS_2BYTE_MAX        (CS_SETCURRENTPOINT + 1)
+#define CS_MAX              CS_2BYTE_MAX
+
+typedef unsigned char byte;
+
+typedef struct {
+    byte nargs;                 /* number of arguments */
+    boolean bottom;             /* take arguments from bottom of stack? */
+    boolean clear;              /* clear stack? */
+    boolean valid;
+} cc_entry;                     /* CharString Command */
+
+typedef struct {
+    char *name;                 /* glyph name (or notdef for Subrs entry) */
+    byte *data;
+    unsigned short len;         /* length of the whole string */
+    unsigned short cslen;       /* length of the encoded part of the string */
+    boolean used;
+    boolean valid;
+} cs_entry;
+
+static unsigned short t1_dr, t1_er;
+static const unsigned short t1_c1 = 52845, t1_c2 = 22719;
+static unsigned short t1_cslen;
+static short t1_lenIV;
+static char enc_line[ENC_BUF_SIZE];
+
+/* define t1_line_ptr, t1_line_array & t1_line_limit */
+typedef char t1_line_entry;
+define_array (t1_line);
+
+/* define t1_buf_ptr, t1_buf_array & t1_buf_limit */
+typedef char t1_buf_entry;
+define_array (t1_buf);
+
+static int cs_start;
+
+static cs_entry *cs_tab, *cs_ptr, *cs_notdef;
+static char *cs_dict_start, *cs_dict_end;
+static int cs_counter, cs_size, cs_size_pos;
+
+static cs_entry *subr_tab;
+static char *subr_array_start, *subr_array_end;
+static int subr_max, subr_size, subr_size_pos;
+
+/* This list contains the begin/end tokens commonly used in the */
+/* /Subrs array of a Type 1 font.                                */
+
+static const char *cs_token_pairs_list[][2] = {
+    {" RD", "NP"},
+    {" -|", "|"},
+    {" RD", "noaccess put"},
+    {" -|", "noaccess put"},
+    {NULL, NULL}
+};
+static const char **cs_token_pair;
+
+static boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic;
+static int t1_in_eexec;         /* 0 before eexec-encrypted, 1 during, 2 after */
+static long t1_block_length;
+static int last_hexbyte;
+static FILE *t1_file;
+static FILE *enc_file;
+
+static void enc_getline (void)
+{
+    char *p;
+    int c;
+  restart:
+    if (enc_eof ())
+        pdftex_fail ("unexpected end of file");
+    p = enc_line;
+    do {
+        c = enc_getchar ();
+        append_char_to_buf (c, p, enc_line, ENC_BUF_SIZE);
+    }
+    while (c != 10 && !enc_eof());
+    append_eol (p, enc_line, ENC_BUF_SIZE);
+    if (p - enc_line < 2 || *enc_line == '%')
+        goto restart;
+}
+
+/* read encoding from .enc file, return glyph_names array, or pdffail() */
+
+char **load_enc_file(char *enc_name)
+{
+    int callback_id = 0;
+    int file_opened = 0;
+	char *ftemp = NULL;
+    char buf[ENC_BUF_SIZE], *p, *r;
+    int i, names_count;
+    char **glyph_names;
+	char *tempname ;
+    set_cur_file_name (enc_name);
+	callback_id=callback_defined(find_enc_file_callback);
+	if (callback_id>0) {
+	  if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+		if(ftemp!=NULL&&strlen(ftemp)) {
+		  free(nameoffile);
+		  namelength = strlen(ftemp);
+		  nameoffile = xmalloc(namelength+2);
+		  strcpy((char *)(nameoffile+1),ftemp);
+		  free(ftemp);
+		} else {
+		  return NULL;
+		}
+	  }
+	}
+	callback_id=callback_defined(read_enc_file_callback);
+	enc_curbyte=0;
+	enc_size=0;
+	if (callback_id>0) {
+	  if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+					 &file_opened, &enc_buffer,&enc_size)) {
+	    if((!file_opened) || enc_size==0) {
+		  pdftex_warn ("cannot open encoding file for reading");
+		  cur_file_name = NULL;
+		  return NULL;
+		}
+	  }
+	} else {
+	  if (!enc_open ()) {
+        pdftex_warn ("cannot open encoding file for reading");
+        cur_file_name = NULL;
+        return NULL;
+	  }
+	  enc_read_file();
+	  enc_close();
+    }
+    glyph_names = xtalloc(256, char *);
+    for (i = 0; i < 256; i++)
+        glyph_names[i] = (char *) notdef;
+    t1_log ("{");
+	
+	tempname = xmalloc(namelength+2);
+	strcpy(tempname,(char *)(nameoffile+1));
+	set_cur_file_name (tempname);
+	t1_log (cur_file_name);
+    enc_getline ();
+    if (*enc_line != '/' || (r = strchr (enc_line, '[')) == NULL) {
+        remove_eol (r, enc_line);
+        pdftex_fail
+            ("invalid encoding vector (a name or `[' missing): `%s'", enc_line);
+    }
+    names_count = 0;
+    r++;                        /* skip '[' */
+    skip (r, ' ');
+    for (;;) {
+        while (*r == '/') {
+            for (p = buf, r++;
+                 *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++);
+            *p = 0;
+            skip (r, ' ');
+            if (names_count > 256)
+                pdftex_fail ("encoding vector contains more than 256 names");
+            if (strcmp (buf, notdef) != 0)
+                glyph_names[names_count] = xstrdup (buf);
+            names_count++;
+        }
+        if (*r != 10 && *r != '%') {
+            if (strncmp (r, "] def", strlen ("] def")) == 0)
+                goto done;
+            else {
+                remove_eol (r, enc_line);
+                pdftex_fail
+                    ("invalid encoding vector: a name or `] def' expected: `%s'",
+                     enc_line);
+            }
+        }
+        enc_getline ();
+        r = enc_line;
+    }
+  done:
+    t1_log ("}");
+    cur_file_name = NULL;
+	return glyph_names;
+}
+
+void free_glyph_names(char **glyph_names)
+{
+    int i;
+    assert(glyph_names != NULL);
+    for (i = 0; i < 256; i++)
+        if (glyph_names[i] != notdef)
+            xfree(glyph_names[i]);
+    xfree(glyph_names);
+}
+
+
+static void t1_check_pfa (void)
+{
+    const int c = t1_getchar ();
+    t1_pfa = (c != 128) ? true : false;
+    t1_ungetchar (c);
+}
+
+static int t1_getbyte (void)
+{
+    int c = t1_getchar ();
+    if (t1_pfa)
+        return c;
+    if (t1_block_length == 0) {
+        if (c != 128)
+            pdftex_fail ("invalid marker");
+        c = t1_getchar ();
+        if (c == 3) {
+            while (!t1_eof ())
+			  (void)t1_getchar ();
+            return EOF;
+        }
+        t1_block_length = t1_getchar () & 0xff;
+        t1_block_length |= (t1_getchar () & 0xff) << 8;
+        t1_block_length |= (t1_getchar () & 0xff) << 16;
+        t1_block_length |= (t1_getchar () & 0xff) << 24;
+        c = t1_getchar ();
+    }
+    t1_block_length--;
+    return c;
+}
+
+static int hexval (int c)
+{
+    if (c >= 'A' && c <= 'F')
+        return c - 'A' + 10;
+    else if (c >= 'a' && c <= 'f')
+        return c - 'a' + 10;
+    else if (c >= '0' && c <= '9')
+        return c - '0';
+    else
+        return -1;
+}
+
+static byte edecrypt (byte cipher)
+{
+    byte plain;
+    if (t1_pfa) {
+        while (cipher == 10 || cipher == 13)
+            cipher = t1_getbyte ();
+        last_hexbyte = cipher = (hexval (cipher) << 4) + hexval (t1_getbyte ());
+    }
+    plain = (cipher ^ (t1_dr >> 8));
+    t1_dr = (cipher + t1_dr) * t1_c1 + t1_c2;
+    return plain;
+}
+
+static byte cdecrypt (byte cipher, unsigned short *cr)
+{
+    const byte plain = (cipher ^ (*cr >> 8));
+    *cr = (cipher + *cr) * t1_c1 + t1_c2;
+    return plain;
+}
+
+static byte eencrypt (byte plain)
+{
+    const byte cipher = (plain ^ (t1_er >> 8));
+    t1_er = (cipher + t1_er) * t1_c1 + t1_c2;
+    return cipher;
+}
+
+static byte cencrypt (byte plain, unsigned short *cr)
+{
+    const byte cipher = (plain ^ (*cr >> 8));
+    *cr = (cipher + *cr) * t1_c1 + t1_c2;
+    return cipher;
+}
+
+static char *eol (char *s)
+{
+    char *p = strend (s);
+    if (p - s > 1 && p[-1] != 10) {
+        *p++ = 10;
+        *p = 0;
+    }
+    return p;
+}
+
+static float t1_scan_num (char *p, char **r)
+{
+    float f;
+    skip (p, ' ');
+    if (sscanf (p, "%g", &f) != 1) {
+        remove_eol (p, t1_line_array);
+        pdftex_fail ("a number expected: `%s'", t1_line_array);
+    }
+    if (r != NULL) {
+        for (; isdigit (*p) || *p == '.' ||
+             *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++);
+        *r = p;
+    }
+    return f;
+}
+
+static boolean str_suffix (const char *begin_buf, const char *end_buf,
+                           const char *s)
+{
+    const char *s1 = end_buf - 1, *s2 = strend (s) - 1;
+    if (*s1 == 10)
+        s1--;
+    while (s1 >= begin_buf && s2 >= s) {
+        if (*s1-- != *s2--)
+            return false;
+    }
+    return s2 < s;
+}
+
+static void t1_getline (void)
+{
+    int c, l, eexec_scan;
+    char *p;
+    static const char eexec_str[] = "currentfile eexec";
+    static int eexec_len = 17;  /* strlen(eexec_str) */
+  restart:
+    if (t1_eof ())
+        pdftex_fail ("unexpected end of file");
+    t1_line_ptr = t1_line_array;
+    alloc_array (t1_line, 1, T1_BUF_SIZE);
+    t1_cslen = 0;
+    eexec_scan = 0;
+    c = t1_getbyte ();
+    if (c == EOF)
+        goto exit;
+    while (!t1_eof ()) {
+        if (t1_in_eexec == 1)
+            c = edecrypt (c);
+        alloc_array (t1_line, 1, T1_BUF_SIZE);
+        append_char_to_buf (c, t1_line_ptr, t1_line_array, t1_line_limit);
+        if (t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) {
+            if (t1_line_array[eexec_scan] == eexec_str[eexec_scan])
+                eexec_scan++;
+            else
+                eexec_scan = -1;
+        }
+        if (c == 10 || (t1_pfa && eexec_scan == eexec_len && c == 32))
+            break;
+        if (t1_cs && t1_cslen == 0 && (t1_line_ptr - t1_line_array > 4) &&
+            (t1_suffix (" RD ") || t1_suffix (" -| "))) {
+            p = t1_line_ptr - 5;
+            while (*p != ' ')
+                p--;
+            t1_cslen = l = t1_scan_num (p + 1, 0);
+            cs_start = t1_line_ptr - t1_line_array;     /* cs_start is an index now */
+            alloc_array (t1_line, l, T1_BUF_SIZE);
+            while (l-- > 0)
+                *t1_line_ptr++ = edecrypt (t1_getbyte ());
+        }
+        c = t1_getbyte ();
+    }
+    alloc_array (t1_line, 2, T1_BUF_SIZE);      /* append_eol can append 2 chars */
+    append_eol (t1_line_ptr, t1_line_array, t1_line_limit);
+    if (t1_line_ptr - t1_line_array < 2)
+        goto restart;
+    if (eexec_scan == eexec_len)
+        t1_in_eexec = 1;
+  exit:
+    /* ensure that t1_buf_array has as much room as t1_line_array */
+    t1_buf_ptr = t1_buf_array;
+    alloc_array (t1_buf, t1_line_limit, t1_line_limit);
+}
+
+static void t1_putline (void)
+{
+    char *p = t1_line_array;
+    if (t1_line_ptr - t1_line_array <= 1)
+        return;
+    if (t1_eexec_encrypt) {
+        while (p < t1_line_ptr)
+            t1_putchar (eencrypt (*p++));
+    } else
+        while (p < t1_line_ptr)
+            t1_putchar (*p++);
+}
+
+static void t1_puts (const char *s)
+{
+    if (s != t1_line_array)
+        strcpy (t1_line_array, s);
+    t1_line_ptr = strend (t1_line_array);
+    t1_putline ();
+}
+
+__attribute__ ((format (printf, 1, 2)))
+static void t1_printf (const char *fmt, ...)
+{
+    va_list args;
+    va_start (args, fmt);
+    vsprintf (t1_line_array, fmt, args);
+    t1_puts (t1_line_array);
+    va_end (args);
+}
+
+static void t1_init_params (const char *open_name_prefix)
+{
+    t1_log (open_name_prefix);
+    t1_log (cur_file_name);
+    t1_lenIV = 4;
+    t1_dr = 55665;
+    t1_er = 55665;
+    t1_in_eexec = 0;
+    t1_cs = false;
+    t1_scan = true;
+    t1_synthetic = false;
+    t1_eexec_encrypt = false;
+    t1_block_length = 0;
+    t1_check_pfa ();
+}
+
+static void t1_close_font_file (const char *close_name_suffix)
+{
+    t1_log (close_name_suffix);
+    cur_file_name = NULL;
+}
+
+static void t1_check_block_len (boolean decrypt)
+{
+    int l, c;
+    if (t1_block_length == 0)
+        return;
+    c = t1_getbyte ();
+    if (decrypt)
+        c = edecrypt (c);
+    l = t1_block_length;
+    if (!(l == 0 && (c == 10 || c == 13))) {
+        pdftex_warn ("%i bytes more than expected were ignored", l + 1);
+        while (l-- > 0)
+            t1_getbyte ();
+    }
+}
+
+static void t1_start_eexec (void)
+{
+    int i;
+    assert(is_included(fd_cur->fm));
+	get_length1 ();
+	save_offset ();
+    
+    if (!t1_pfa)
+        t1_check_block_len (false);
+    for (t1_line_ptr = t1_line_array, i = 0; i < 4; i++) {
+        edecrypt (t1_getbyte ());
+        *t1_line_ptr++ = 0;
+    }
+    t1_eexec_encrypt = true;
+	t1_putline ();          /* to put the first four bytes */
+}
+
+static void t1_stop_eexec (void)
+{
+    int c;
+    assert(is_included(fd_cur->fm));
+	get_length2 ();
+	save_offset ();
+    t1_eexec_encrypt = false;
+    if (!t1_pfa)
+        t1_check_block_len (true);
+    else {
+        c = edecrypt (t1_getbyte ());
+        if (!(c == 10 || c == 13)) {
+            if (last_hexbyte == 0)
+                t1_puts ("00");
+            else
+                pdftex_warn ("unexpected data after eexec");
+        }
+    }
+    t1_cs = false;
+    t1_in_eexec = 2;
+}
+
+/* macros for various transforms; currently only slant and extend are used */
+
+#  define do_xshift(x,a) {x[4]+=a;}
+#  define do_yshift(x,a) {x[5]+=a;}
+#  define do_xscale(x,a) {x[0]*=a; x[2]*=a; x[4]*=a;}
+#  define do_yscale(x,a) {x[1]*=a; x[3]*=a; x[5]*=a;}
+#  define do_extend(x,a) {do_xscale(x,a);}
+#  define do_scale(x,a)  {do_xscale(x,a); do_yscale(x,a);}
+#  define do_slant(x,a)  {x[0]+=x[1]*(a); x[2]+=x[3]*(a); x[4]+=x[5]*(a);}
+#  define do_shear(x,a)  {x[1]+=x[0]*(a); x[3]+=x[2]*(a); x[5]+=x[4]*(a);}
+#  define do_rotate(x,a)          \
+  {float t, u=cos(a), v=sin(a); \
+  t    =x[0]*u+x[1]*-v;         \
+  x[1] =x[0]*v+x[1]* u; x[0]=t; \
+  t    =x[2]*u+x[3]*-v;         \
+  x[3] =x[2]*v+x[3]* u; x[2]=t; \
+  t    =x[4]*u+x[5]*-v;         \
+  x[5] =x[4]*v+x[5]* u; x[4]=t;}
+
+static void t1_modify_fm (void)
+{
+    /*
+     * font matrix is given as six numbers a0..a5, which stands for the matrix
+     *
+     *           a0 a1 0
+     *     M =   a2 a3 0
+     *           a4 a5 1
+     *
+     * ExtendFont is given as
+     *
+     *           e 0 0
+     *     E =   0 1 0
+     *           0 0 1
+     *
+     * SlantFont is given as
+     *
+     *           1 0 0
+     *     S =   s 1 0
+     *           0 0 1
+     *
+     * The slant transform must be done _before_ the extend transform
+     * for compatibility!
+     */
+    float a[6];
+    int i, c;
+    char *p, *q, *r;
+    if ((p = strchr (t1_line_array, '[')) == 0)
+        if ((p = strchr (t1_line_array, '{')) == 0) {
+            remove_eol (p, t1_line_array);
+            pdftex_fail ("FontMatrix: an array expected: `%s'", t1_line_array);
+        }
+    c = *p++;                   /* save the character '[' resp. '{' */
+    strncpy (t1_buf_array, t1_line_array, (size_t) (p - t1_line_array));
+    r = t1_buf_array + (p - t1_line_array);
+    for (i = 0; i < 6; i++) {
+        a[i] = t1_scan_num (p, &q);
+        p = q;
+    }
+    if (fm_slant(fd_cur->fm) != 0)
+        do_slant(a, fm_slant(fd_cur->fm) * 1E-3);
+    if (fm_extend(fd_cur->fm) != 0)
+        do_extend(a, fm_extend(fd_cur->fm) * 1E-3);
+    for (i = 0; i < 6; i++) {
+        sprintf (r, "%g ", a[i]);
+        r = strend (r);
+    }
+    if (c == '[') {
+        while (*p != ']' && *p != 0)
+            p++;
+    } else {
+        while (*p != '}' && *p != 0)
+            p++;
+    }
+    if (*p == 0) {
+        remove_eol (p, t1_line_array);
+        pdftex_fail
+            ("FontMatrix: cannot find the corresponding character to '%c': `%s'",
+             c, t1_line_array);
+    }
+    strcpy (r, p);
+    strcpy (t1_line_array, t1_buf_array);
+    t1_line_ptr = eol (t1_line_array);
+}
+
+static void t1_modify_italic (void)
+{
+    float a;
+    char *p, *r;
+    if (fm_slant(fd_cur->fm) == 0)
+        return;
+    p = strchr (t1_line_array, ' ');
+    strncpy (t1_buf_array, t1_line_array, (size_t) (p - t1_line_array + 1));
+    a = t1_scan_num (p + 1, &r);
+    a -= atan (fm_slant(fd_cur->fm) * 1E-3) * (180 / M_PI);
+    sprintf (t1_buf_array + (p - t1_line_array + 1), "%g", a);
+    strcpy (strend (t1_buf_array), r);
+    strcpy (t1_line_array, t1_buf_array);
+    t1_line_ptr = eol (t1_line_array);
+    fd_cur->font_dim[ITALIC_ANGLE_CODE].val = round(a);
+    fd_cur->font_dim[ITALIC_ANGLE_CODE].set = true;
+}
+
+static void t1_scan_keys (void)
+{
+    int i, k;
+    char *p, *q, *r;
+    key_entry *key;
+    if (fm_extend(fd_cur->fm) != 0 || fm_slant(fd_cur->fm) != 0) {
+        if (t1_prefix ("/FontMatrix")) {
+            t1_modify_fm ();
+            return;
+        }
+        if (t1_prefix ("/ItalicAngle")) {
+            t1_modify_italic ();
+            return;
+        }
+    }
+    if (t1_prefix ("/FontType")) {
+        p = t1_line_array + strlen ("FontType") + 1;
+        if ((i = t1_scan_num (p, 0)) != 1)
+            pdftex_fail ("Type%d fonts unsupported by pdfTeX", i);
+        return;
+    }
+    for (key = (key_entry *) font_key; key - font_key < FONT_KEYS_NUM; key++) {
+        if (key->t1name[0] != '\0' &&
+            str_prefix(t1_line_array + 1, key->t1name))
+            break;
+	}
+    if (key - font_key == FONT_KEYS_NUM)
+        return;
+    p = t1_line_array + strlen (key->t1name) + 1;
+    skip (p, ' ');
+    if ((k = key - font_key) == FONTNAME_CODE) {
+        if (*p != '/') {
+            remove_eol (p, t1_line_array);
+            pdftex_fail ("a name expected: `%s'", t1_line_array);
+        }
+        r = ++p;                /* skip the slash */
+        for (q = t1_buf_array; *p != ' ' && *p != 10; *q++ = *p++);
+        *q = 0;
+        if (fm_slant(fd_cur->fm) != 0) {
+            sprintf(q, "-Slant_%i", (int) fm_slant(fd_cur->fm));
+            q = strend (q);
+        }
+        if (fm_extend(fd_cur->fm) != 0) {
+            sprintf(q, "-Extend_%i", (int) fm_extend(fd_cur->fm));
+        }
+        xfree(fd_cur->fontname);
+        fd_cur->fontname = xstrdup(t1_buf_array);
+        /* at this moment we cannot call make_subset_tag() yet, as the encoding
+         * is not read; thus we mark the offset of the subset tag and write it
+         * later */
+        if (is_subsetted(fd_cur->fm)) {
+            assert(is_included(fd_cur->fm));
+            t1_fontname_offset = t1_offset () + (r - t1_line_array);
+            strcpy (t1_buf_array, p);
+            sprintf(r, "ABCDEF+%s%s", fd_cur->fontname, t1_buf_array);
+            t1_line_ptr = eol (r);
+        }
+        return;
+    }
+    if ((k == STEMV_CODE || k == FONTBBOX1_CODE)
+        && (*p == '[' || *p == '{'))
+        p++;
+    if (k == FONTBBOX1_CODE) {
+        for (i = 0; i < 4; i++, k++) {
+            fd_cur->font_dim[k].val = t1_scan_num(p, &r);
+            fd_cur->font_dim[k].set = true;
+            p = r;
+        }
+        return;
+    }
+    fd_cur->font_dim[k].val = t1_scan_num(p, 0);
+    fd_cur->font_dim[k].set = true;
+}
+
+static void t1_scan_param (void)
+{
+    static const char *lenIV = "/lenIV";
+    if (!t1_scan || *t1_line_array != '/')
+        return;
+    if (t1_prefix (lenIV)) {
+        t1_lenIV = t1_scan_num (t1_line_array + strlen (lenIV), 0);
+        return;
+    }
+    t1_scan_keys ();
+}
+
+static void copy_glyph_names (char **glyph_names, int a, int b)
+{
+    if (glyph_names[b] != notdef) {
+        xfree (glyph_names[b]);
+        glyph_names[b] = (char *) notdef;
+    }
+    if (glyph_names[a] != notdef) {
+        glyph_names[b] = xstrdup (glyph_names[a]);
+    }
+}
+
+/* read encoding from Type1 font file, return glyph_names array, or pdffail() */
+
+char **t1_builtin_enc(void)
+{
+    int i, a, b, c, counter = 0;
+    char *r, *p, **glyph_names;
+    /* At this moment "/Encoding" is the prefix of t1_line_array */
+    glyph_names = xtalloc(256, char *);
+    for (i = 0; i < 256; i++)
+        glyph_names[i] = (char *) notdef;
+    if (t1_suffix("def")) {     /* predefined encoding */
+        sscanf(t1_line_array + strlen("/Encoding"), "%256s", t1_buf_array);
+        if (strcmp(t1_buf_array, "StandardEncoding") == 0) {
+            t1_encoding = ENC_STANDARD;
+            for (i = 0; i < 256; i++) {
+                if (standard_glyph_names[i] != notdef)
+                    glyph_names[i] = xstrdup(standard_glyph_names[i]);
+            }
+            return glyph_names;
+        } else
+            pdftex_fail
+                ("cannot subset font (unknown predefined encoding `%s')",
+                 t1_buf_array);
+    }
+    /* At this moment "/Encoding" is the prefix of t1_line_array, and the encoding is
+     * not a predefined encoding.
+     *
+     * We have two possible forms of Encoding vector. The first case is
+     *
+     *     /Encoding [/a /b /c...] readonly def
+     *
+     * and the second case can look like
+     *
+     *     /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for
+     *     dup 0 /x put
+     *     dup 1 /y put
+     *     ...
+     *     readonly def
+     */
+    t1_encoding = ENC_BUILTIN;
+    if (t1_prefix("/Encoding [") || t1_prefix("/Encoding[")) {  /* the first case */
+        r = strchr(t1_line_array, '[') + 1;
+        skip(r, ' ');
+        for (;;) {
+            while (*r == '/') {
+                for (p = t1_buf_array, r++;
+                     *r != 32 && *r != 10 && *r != ']' && *r != '/';
+                     *p++ = *r++);
+                *p = 0;
+                skip(r, ' ');
+                if (counter > 255)
+                    pdftex_fail("encoding vector contains more than 256 names");
+                if (strcmp(t1_buf_array, notdef) != 0)
+                    glyph_names[counter] = xstrdup(t1_buf_array);
+                counter++;
+            }
+            if (*r != 10 && *r != '%') {
+                if (str_prefix(r, "] def")
+                    || str_prefix(r, "] readonly def"))
+                    break;
+                else {
+                    remove_eol(r, t1_line_array);
+                    pdftex_fail
+                        ("a name or `] def' or `] readonly def' expected: `%s'",
+                         t1_line_array);
+                }
+            }
+            t1_getline();
+            r = t1_line_array;
+        }
+    } else {                    /* the second case */
+        p = strchr(t1_line_array, 10);
+        for (;;) {
+            if (*p == 10) {
+                t1_getline();
+                p = t1_line_array;
+            }
+            /*
+               check for `dup <index> <glyph> put'
+             */
+            if (sscanf(p, "dup %i%256s put", &i, t1_buf_array) == 2 &&
+                *t1_buf_array == '/' && valid_code(i)) {
+                if (strcmp(t1_buf_array + 1, notdef) != 0)
+                    glyph_names[i] = xstrdup(t1_buf_array + 1);
+                p = strstr(p, " put") + strlen(" put");
+                skip(p, ' ');
+            }
+            /*
+               check for `dup dup <to> exch <from> get put'
+             */
+            else if (sscanf(p, "dup dup %i exch %i get put", &b, &a) == 2
+                     && valid_code(a) && valid_code(b)) {
+                copy_glyph_names(glyph_names, a, b);
+                p = strstr(p, " get put") + strlen(" get put");
+                skip(p, ' ');
+            }
+            /*
+               check for `dup dup <from> <size> getinterval <to> exch putinterval'
+             */
+            else if (sscanf
+                     (p, "dup dup %i %i getinterval %i exch putinterval",
+                      &a, &c, &b) == 3 && valid_code(a) && valid_code(b)
+                     && valid_code(c)) {
+                for (i = 0; i < c; i++)
+                    copy_glyph_names(glyph_names, a + i, b + i);
+                p = strstr(p, " putinterval") + strlen(" putinterval");
+                skip(p, ' ');
+            }
+            /*
+               check for `def' or `readonly def'
+             */
+            else if ((p == t1_line_array || (p > t1_line_array && p[-1] == ' '))
+                     && strcmp(p, "def\n") == 0)
+                return glyph_names;
+            /*
+               skip an unrecognizable word
+             */
+            else {
+                while (*p != ' ' && *p != 10)
+                    p++;
+                skip(p, ' ');
+            }
+        }
+    }
+    return glyph_names;
+}
+
+
+static void t1_check_end (void)
+{
+    if (t1_eof ())
+        return;
+    t1_getline ();
+    if (t1_prefix ("{restore}"))
+        t1_putline ();
+}
+
+static boolean t1_open_fontfile (const char *open_name_prefix)
+{
+    int callback_id = 0;
+    int file_opened = 0;
+	char *ftemp = NULL;
+    ff_entry *ff;
+    ff = check_ff_exist(fd_cur->fm->ff_name, is_truetype(fd_cur->fm));
+	t1_curbyte = 0;
+	t1_size = 0;
+    if (ff->ff_path != NULL) {
+	  callback_id=callback_defined(find_type1_file_callback);	  
+	  if (callback_id>0) {
+		if(run_callback(callback_id,"S->S",ff->ff_path,&ftemp)) {
+		  if(ftemp!=NULL&&strlen(ftemp)) {
+			strcpy(ff->ff_path,ftemp);
+		  }
+		}
+	  }
+	  callback_id=callback_defined(read_type1_file_callback);
+	  if (callback_id>0) {
+		if(run_callback(callback_id,"S->bSd",ff->ff_path,
+					   &file_opened, &t1_buffer,&t1_size) 
+		   && file_opened && t1_size>0) {
+		  cur_file_name = ff->ff_path;
+		} else {
+		  set_cur_file_name (fd_cur->fm->ff_name);
+		  pdftex_warn ("cannot open Type 1 font file for reading");
+		  return false;
+		}
+	  } else {
+	    t1_file = xfopen (cur_file_name = ff->ff_path, FOPEN_RBIN_MODE);
+            t1_read_file();
+	    t1_close();
+	  }
+	}
+    else {
+        set_cur_file_name (fd_cur->fm->ff_name);
+        pdftex_warn ("cannot open Type 1 font file for reading");
+        return false;
+    }
+    t1_init_params (open_name_prefix);
+    return true;
+}
+
+static void t1_include (void)
+{
+    do {
+        t1_getline ();
+        t1_scan_param ();
+        t1_putline ();
+    }
+    while (t1_in_eexec == 0);
+    t1_start_eexec ();
+    do {
+        t1_getline ();
+        t1_scan_param ();
+        t1_putline ();
+    }
+    while (!(t1_charstrings () || t1_subrs ()));
+    t1_cs = true;
+    do {
+        t1_getline ();
+        t1_putline ();
+    }
+    while (!t1_end_eexec ());
+    t1_stop_eexec ();
+    if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
+        do {
+            t1_getline ();
+            t1_putline ();
+        }
+        while (!t1_cleartomark ());
+        t1_check_end ();        /* write "{restore}if" if found */
+    }
+    get_length3 ();
+}
+
+#define check_subr(subr) \
+    if (subr >= subr_size || subr < 0) \
+        pdftex_fail("Subrs array: entry index out of range (%i)",  subr);
+
+static const char **check_cs_token_pair ()
+{
+    const char **p = (const char **) cs_token_pairs_list;
+    for (; p[0] != NULL; ++p)
+        if (t1_buf_prefix (p[0]) && t1_buf_suffix (p[1]))
+            return p;
+    return NULL;
+}
+
+static void cs_store (boolean is_subr)
+{
+    char *p;
+    cs_entry *ptr;
+    int subr;
+    for (p = t1_line_array, t1_buf_ptr = t1_buf_array; *p != ' ';
+         *t1_buf_ptr++ = *p++);
+    *t1_buf_ptr = 0;
+    if (is_subr) {
+        subr = t1_scan_num (p + 1, 0);
+        check_subr (subr);
+        ptr = subr_tab + subr;
+    } else {
+        ptr = cs_ptr++;
+        if (cs_ptr - cs_tab > cs_size)
+            pdftex_fail
+                ("CharStrings dict: more entries than dict size (%i)", cs_size);
+        if (strcmp (t1_buf_array + 1, notdef) == 0)     /* skip the slash */
+            ptr->name = (char *) notdef;
+        else
+            ptr->name = xstrdup (t1_buf_array + 1);
+    }
+    /* copy " RD " + cs data to t1_buf_array */
+    memcpy (t1_buf_array, t1_line_array + cs_start - 4,
+            (unsigned) (t1_cslen + 4));
+    /* copy the end of cs data to t1_buf_array */
+    for (p = t1_line_array + cs_start + t1_cslen, t1_buf_ptr =
+         t1_buf_array + t1_cslen + 4; *p != 10; *t1_buf_ptr++ = *p++);
+    *t1_buf_ptr++ = 10;
+    if (is_subr && cs_token_pair == NULL)
+        cs_token_pair = check_cs_token_pair ();
+    ptr->len = t1_buf_ptr - t1_buf_array;
+    ptr->cslen = t1_cslen;
+    ptr->data = xtalloc (ptr->len, byte);
+    memcpy (ptr->data, t1_buf_array, ptr->len);
+    ptr->valid = true;
+}
+
+#define store_subr()    cs_store(true)
+#define store_cs()      cs_store(false)
+
+#define CC_STACK_SIZE       24
+
+static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack;
+static cc_entry cc_tab[CS_MAX];
+static boolean is_cc_init = false;
+
+
+#define cc_pop(N)                       \
+    if (stack_ptr - cc_stack < (N))     \
+        stack_error(N);                 \
+    stack_ptr -= N
+
+#define stack_error(N) {                \
+    pdftex_warn("CharString: invalid access (%i) to stack (%i entries)", \
+                 (int) N, (int)(stack_ptr - cc_stack));                  \
+    goto cs_error;                    \
+}
+
+/*
+static integer cc_get(integer index)
+{
+    if (index <  0) {
+        if (stack_ptr + index < cc_stack )
+            stack_error(stack_ptr - cc_stack + index);
+        return *(stack_ptr + index);
+    }
+    else {
+        if (cc_stack  + index >= stack_ptr)
+            stack_error(index);
+        return cc_stack[index];
+    }
+}
+*/
+
+#define cc_get(N)   ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N)))
+
+#define cc_push(V)  *stack_ptr++ = V
+#define cc_clear()  stack_ptr = cc_stack
+
+#define set_cc(N, B, A, C) \
+    cc_tab[N].nargs = A;   \
+    cc_tab[N].bottom = B;  \
+    cc_tab[N].clear = C;   \
+    cc_tab[N].valid = true
+
+static void cc_init (void)
+{
+    int i;
+    if (is_cc_init)
+        return;
+    for (i = 0; i < CS_MAX; i++)
+        cc_tab[i].valid = false;
+    set_cc (CS_HSTEM, true, 2, true);
+    set_cc (CS_VSTEM, true, 2, true);
+    set_cc (CS_VMOVETO, true, 1, true);
+    set_cc (CS_RLINETO, true, 2, true);
+    set_cc (CS_HLINETO, true, 1, true);
+    set_cc (CS_VLINETO, true, 1, true);
+    set_cc (CS_RRCURVETO, true, 6, true);
+    set_cc (CS_CLOSEPATH, false, 0, true);
+    set_cc (CS_CALLSUBR, false, 1, false);
+    set_cc (CS_RETURN, false, 0, false);
+    /*
+       set_cc(CS_ESCAPE,          false,  0, false);
+     */
+    set_cc (CS_HSBW, true, 2, true);
+    set_cc (CS_ENDCHAR, false, 0, true);
+    set_cc (CS_RMOVETO, true, 2, true);
+    set_cc (CS_HMOVETO, true, 1, true);
+    set_cc (CS_VHCURVETO, true, 4, true);
+    set_cc (CS_HVCURVETO, true, 4, true);
+    set_cc (CS_DOTSECTION, false, 0, true);
+    set_cc (CS_VSTEM3, true, 6, true);
+    set_cc (CS_HSTEM3, true, 6, true);
+    set_cc (CS_SEAC, true, 5, true);
+    set_cc (CS_SBW, true, 4, true);
+    set_cc (CS_DIV, false, 2, false);
+    set_cc (CS_CALLOTHERSUBR, false, 0, false);
+    set_cc (CS_POP, false, 0, false);
+    set_cc (CS_SETCURRENTPOINT, true, 2, true);
+    is_cc_init = true;
+}
+
+#define cs_getchar()    cdecrypt(*data++, &cr)
+
+#define mark_subr(n)    cs_mark(0, n)
+#define mark_cs(s)      cs_mark(s, 0)
+
+__attribute__ ((format (printf, 3, 4)))
+static void cs_warn (const char *cs_name, int subr, const char *fmt, ...)
+{
+    char buf[SMALL_BUF_SIZE];
+    va_list args;
+    va_start (args, fmt);
+    vsprintf (buf, fmt, args);
+    va_end (args);
+    if (cs_name == NULL)
+        pdftex_warn ("Subr (%i): %s", (int) subr, buf);
+    else
+        pdftex_warn ("CharString (/%s): %s", cs_name, buf);
+}
+
+static void cs_mark (const char *cs_name, int subr)
+{
+    byte *data;
+    int i, b, cs_len;
+    integer a, a1, a2;
+    unsigned short cr;
+    static integer lastargOtherSubr3 = 3;       /* the argument of last call to
+                                                   OtherSubrs[3] */
+    cs_entry *ptr;
+    cc_entry *cc;
+    if (cs_name == NULL) {
+        check_subr (subr);
+        ptr = subr_tab + subr;
+        if (!ptr->valid)
+            return;
+    } else {
+        if (cs_notdef != NULL &&
+            (cs_name == notdef || strcmp (cs_name, notdef) == 0))
+            ptr = cs_notdef;
+        else {
+            for (ptr = cs_tab; ptr < cs_ptr; ptr++)
+                if (strcmp (ptr->name, cs_name) == 0)
+                    break;
+            if (ptr == cs_ptr) {
+                pdftex_warn ("glyph `%s' undefined", cs_name);
+                return;
+            }
+            if (ptr->name == notdef)
+                cs_notdef = ptr;
+        }
+    }
+    /* only marked CharString entries and invalid entries can be skipped;
+       valid marked subrs must be parsed to keep the stack in sync */
+    if (!ptr->valid || (ptr->used && cs_name != NULL))
+        return;
+    ptr->used = true;
+    cr = 4330;
+    cs_len = ptr->cslen;
+    data = ptr->data + 4;
+    for (i = 0; i < t1_lenIV; i++, cs_len--)
+        cs_getchar ();
+    while (cs_len > 0) {
+        --cs_len;
+        b = cs_getchar ();
+        if (b >= 32) {
+            if (b <= 246)
+                a = b - 139;
+            else if (b <= 250) {
+                --cs_len;
+                a = ((b - 247) << 8) + 108 + cs_getchar ();
+            } else if (b <= 254) {
+                --cs_len;
+                a = -((b - 251) << 8) - 108 - cs_getchar ();
+            } else {
+                cs_len -= 4;
+                a = (cs_getchar () & 0xff) << 24;
+                a |= (cs_getchar () & 0xff) << 16;
+                a |= (cs_getchar () & 0xff) << 8;
+                a |= (cs_getchar () & 0xff) << 0;
+                if (sizeof (integer) > 4 && (a & 0x80000000))
+                    a |= ~0x7FFFFFFF;
+            }
+            cc_push (a);
+        } else {
+            if (b == CS_ESCAPE) {
+                b = cs_getchar () + CS_1BYTE_MAX;
+                cs_len--;
+            }
+            if (b >= CS_MAX) {
+                cs_warn (cs_name, subr, "command value out of range: %i",
+                         (int) b);
+                goto cs_error;
+            }
+            cc = cc_tab + b;
+            if (!cc->valid) {
+                cs_warn (cs_name, subr, "command not valid: %i", (int) b);
+                goto cs_error;
+            }
+            if (cc->bottom) {
+                if (stack_ptr - cc_stack < cc->nargs)
+                    cs_warn (cs_name, subr,
+                             "less arguments on stack (%i) than required (%i)",
+                             (int) (stack_ptr - cc_stack), (int) cc->nargs);
+                else if (stack_ptr - cc_stack > cc->nargs)
+                    cs_warn (cs_name, subr,
+                             "more arguments on stack (%i) than required (%i)",
+                             (int) (stack_ptr - cc_stack), (int) cc->nargs);
+            }
+            switch (cc - cc_tab) {
+            case CS_CALLSUBR:
+                a1 = cc_get (-1);
+                cc_pop (1);
+                mark_subr (a1);
+                if (!subr_tab[a1].valid) {
+                    cs_warn (cs_name, subr, "cannot call subr (%i)", (int) a1);
+                    goto cs_error;
+                }
+                break;
+            case CS_DIV:
+                cc_pop (2);
+                cc_push (0);
+                break;
+            case CS_CALLOTHERSUBR:
+                if (cc_get (-1) == 3)
+                    lastargOtherSubr3 = cc_get (-3);
+                a1 = cc_get (-2) + 2;
+                cc_pop (a1);
+                break;
+            case CS_POP:
+                cc_push (lastargOtherSubr3);
+                /* the only case when we care about the value being pushed onto
+                   stack is when POP follows CALLOTHERSUBR (changing hints by
+                   OtherSubrs[3])
+                 */
+                break;
+            case CS_SEAC:
+                a1 = cc_get (3);
+                a2 = cc_get (4);
+                cc_clear ();
+                mark_cs (standard_glyph_names[a1]);
+                mark_cs (standard_glyph_names[a2]);
+                break;
+            default:
+                if (cc->clear)
+                    cc_clear ();
+            }
+        }
+    }
+    return;
+  cs_error:                    /* an error occured during parsing */
+    cc_clear ();
+    ptr->valid = false;
+    ptr->used = false;
+}
+
+/**********************************************************************/
+/* AVL search tree for glyph code by glyph name */
+
+static int comp_t1_glyphs(const void *pa, const void *pb, void *p)
+{
+    return strcmp(*((const char **) pa), *((const char **) pb));
+}
+
+struct avl_table *create_t1_glyph_tree(char **glyph_names)
+{
+    int i;
+    void **aa;
+    static struct avl_table *gl_tree;
+    gl_tree = avl_create(comp_t1_glyphs, NULL, &avl_xallocator);
+    assert(gl_tree != NULL);
+    for (i = 0; i < 256; i++) {
+        if (glyph_names[i] != notdef &&
+            (char **) avl_find(gl_tree, &glyph_names[i]) == NULL) {
+            /* no strdup here, just point to the glyph_names array members */
+            aa = avl_probe(gl_tree, &glyph_names[i]);
+            assert(aa != NULL);
+        }
+    }
+    return gl_tree;
+}
+
+void destroy_t1_glyph_tree(struct avl_table *gl_tree)
+{
+    assert(gl_tree != NULL);
+    avl_destroy(gl_tree, NULL);
+}
+
+/**********************************************************************/
+
+static void t1_subset_ascii_part(void)
+{
+    int j, *p;
+    char *glyph, **gg, **glyph_names;
+    struct avl_table *gl_tree;
+    struct avl_traverser t;
+    void **aa;
+    assert(fd_cur != NULL);
+    assert(fd_cur->gl_tree != NULL);
+    t1_getline();
+    while (!t1_prefix("/Encoding")) {
+        t1_scan_param();
+        t1_putline();
+        t1_getline();
+    }
+    glyph_names = t1_builtin_enc();
+    fd_cur->builtin_glyph_names = glyph_names;
+    if (is_subsetted(fd_cur->fm)) {
+        assert(is_included(fd_cur->fm));
+        if (fd_cur->tx_tree != NULL) {
+            /* take over collected non-reencoded characters from TeX */
+            avl_t_init(&t, fd_cur->tx_tree);
+            for (p = (int *) avl_t_first(&t, fd_cur->tx_tree); p != NULL;
+                 p = (int *) avl_t_next(&t)) {
+                if ((char *) avl_find(fd_cur->gl_tree, glyph_names[*p]) == NULL) {
+                    glyph = xstrdup(glyph_names[*p]);
+                    aa = avl_probe(fd_cur->gl_tree, glyph);
+                    assert(aa != NULL);
+                }
+            }
+        }
+        make_subset_tag(fd_cur);
+        assert(t1_fontname_offset != 0);
+        strncpy(fb_array + t1_fontname_offset, fd_cur->subset_tag, 6);
+    }
+    /* now really all glyphs needed from this font are in the fd_cur->gl_tree */
+    if (t1_encoding == ENC_STANDARD)
+        t1_puts("/Encoding StandardEncoding def\n");
+    else {
+        t1_puts
+            ("/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n");
+        gl_tree = create_t1_glyph_tree(glyph_names);
+        avl_t_init(&t, fd_cur->gl_tree);
+        j = 0;
+        for (glyph = (char *) avl_t_first(&t, fd_cur->gl_tree); glyph != NULL;
+             glyph = (char *) avl_t_next(&t)) {
+            if ((gg = (char **) avl_find(gl_tree, &glyph)) != NULL) {
+                t1_printf("dup %i /%s put\n", (int) (gg - glyph_names), *gg);
+                j++;
+            }
+        }
+        destroy_t1_glyph_tree(gl_tree);
+        if (j == 0)
+            /* We didn't mark anything for the Encoding array. */
+            /* We add "dup 0 /.notdef put" for compatibility   */
+            /* with Acrobat 5.0.                               */
+            t1_puts("dup 0 /.notdef put\n");
+        t1_puts("readonly def\n");
+    }
+    do {
+        t1_getline();
+        t1_scan_param();
+        if (!t1_prefix("/UniqueID"))    /* ignore UniqueID for subsetted fonts */
+            t1_putline();
+    }
+    while (t1_in_eexec == 0);
+}
+
+
+static void cs_init (void)
+{
+    cs_ptr = cs_tab = NULL;
+    cs_dict_start = cs_dict_end = NULL;
+    cs_counter = cs_size = cs_size_pos = 0;
+    cs_token_pair = NULL;
+    subr_tab = NULL;
+    subr_array_start = subr_array_end = NULL;
+    subr_max = subr_size = subr_size_pos = 0;
+}
+
+static void init_cs_entry (cs_entry * cs)
+{
+    cs->data = NULL;
+    cs->name = NULL;
+    cs->len = 0;
+    cs->cslen = 0;
+    cs->used = false;
+    cs->valid = false;
+}
+
+static void t1_read_subrs (void)
+{
+    int i, s;
+    cs_entry *ptr;
+    t1_getline ();
+    while (!(t1_charstrings () || t1_subrs ())) {
+        t1_scan_param ();
+        t1_putline ();
+        t1_getline ();
+    }
+  found:
+    t1_cs = true;
+    t1_scan = false;
+    if (!t1_subrs ())
+        return;
+    subr_size_pos = strlen ("/Subrs") + 1;
+    /* subr_size_pos points to the number indicating dict size after "/Subrs" */
+    subr_size = t1_scan_num (t1_line_array + subr_size_pos, 0);
+    if (subr_size == 0) {
+        while (!t1_charstrings ())
+            t1_getline ();
+        return;
+    }
+    subr_tab = xtalloc (subr_size, cs_entry);
+    for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+        init_cs_entry (ptr);
+    subr_array_start = xstrdup (t1_line_array);
+    t1_getline ();
+    while (t1_cslen) {
+        store_subr ();
+        t1_getline ();
+    }
+    /* mark the first four entries without parsing */
+    for (i = 0; i < subr_size && i < 4; i++)
+        subr_tab[i].used = true;
+    /* the end of the Subrs array might have more than one line so we need to
+       concatnate them to subr_array_end. Unfortunately some fonts don't have
+       the Subrs array followed by the CharStrings dict immediately (synthetic
+       fonts). If we cannot find CharStrings in next POST_SUBRS_SCAN lines then
+       we will treat the font as synthetic and ignore everything until next
+       Subrs is found
+     */
+#define POST_SUBRS_SCAN     5
+    s = 0;
+    *t1_buf_array = 0;
+    for (i = 0; i < POST_SUBRS_SCAN; i++) {
+        if (t1_charstrings ())
+            break;
+        s += t1_line_ptr - t1_line_array;
+        alloc_array (t1_buf, s, T1_BUF_SIZE);
+        strcat (t1_buf_array, t1_line_array);
+        t1_getline ();
+    }
+    subr_array_end = xstrdup (t1_buf_array);
+    if (i == POST_SUBRS_SCAN) { /* CharStrings not found;
+                                   suppose synthetic font */
+        for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+            if (ptr->valid)
+                xfree (ptr->data);
+        xfree (subr_tab);
+        xfree (subr_array_start);
+        xfree (subr_array_end);
+        cs_init ();
+        t1_cs = false;
+        t1_synthetic = true;
+        while (!(t1_charstrings () || t1_subrs ()))
+            t1_getline ();
+        goto found;
+    }
+}
+
+#define t1_subr_flush()  t1_flush_cs(true)
+#define t1_cs_flush()    t1_flush_cs(false)
+
+static void t1_flush_cs (boolean is_subr)
+{
+    char *p;
+    byte *r, *return_cs = NULL;
+    cs_entry *tab, *end_tab, *ptr;
+    char *start_line, *line_end;
+    int count, size_pos;
+    unsigned short cr, cs_len;
+    if (is_subr) {
+        start_line = subr_array_start;
+        line_end = subr_array_end;
+        size_pos = subr_size_pos;
+        tab = subr_tab;
+        count = subr_max + 1;
+        end_tab = subr_tab + count;
+    } else {
+        start_line = cs_dict_start;
+        line_end = cs_dict_end;
+        size_pos = cs_size_pos;
+        tab = cs_tab;
+        end_tab = cs_ptr;
+        count = cs_counter;
+    }
+    t1_line_ptr = t1_line_array;
+    for (p = start_line; p - start_line < size_pos;)
+        *t1_line_ptr++ = *p++;
+    while (isdigit (*p))
+        p++;
+    sprintf (t1_line_ptr, "%u", count);
+    strcat (t1_line_ptr, p);
+    t1_line_ptr = eol (t1_line_array);
+    t1_putline ();
+
+	cs_len = 0; /* for -Wall */
+    /* create return_cs to replace unsused subr's */
+    if (is_subr) {
+        cr = 4330;
+        cs_len = 0;
+        return_cs = xtalloc (t1_lenIV + 1, byte);
+        if (t1_lenIV > 0) {
+            for (cs_len = 0, r = return_cs; cs_len < t1_lenIV; cs_len++, r++)
+                *r = cencrypt (0x00, &cr);
+            *r = cencrypt (CS_RETURN, &cr);
+        } else {
+            *return_cs = CS_RETURN;
+        }
+        cs_len++;
+    }
+
+    for (ptr = tab; ptr < end_tab; ptr++) {
+        if (ptr->used) {
+            if (is_subr)
+			  sprintf (t1_line_array, "dup %li %u", (long int)(ptr - tab), ptr->cslen);
+            else
+                sprintf (t1_line_array, "/%s %u", ptr->name, ptr->cslen);
+            p = strend (t1_line_array);
+            memcpy (p, ptr->data, ptr->len);
+            t1_line_ptr = p + ptr->len;
+            t1_putline ();
+        } else {
+            /* replace unsused subr's by return_cs */
+            if (is_subr) {
+			  sprintf (t1_line_array, "dup %li %u%s ", (long int)(ptr - tab), cs_len,
+                         cs_token_pair[0]);
+                p = strend (t1_line_array);
+                memcpy (p, return_cs, cs_len);
+                t1_line_ptr = p + cs_len;
+                t1_putline ();
+                sprintf (t1_line_array, " %s", cs_token_pair[1]);
+                t1_line_ptr = eol (t1_line_array);
+                t1_putline ();
+            }
+        }
+        xfree (ptr->data);
+        if (ptr->name != notdef)
+            xfree (ptr->name);
+    }
+    sprintf (t1_line_array, "%s", line_end);
+    t1_line_ptr = eol (t1_line_array);
+    t1_putline ();
+    if (is_subr)
+        xfree (return_cs);
+    xfree (tab);
+    xfree (start_line);
+    xfree (line_end);
+}
+
+static void t1_mark_glyphs(void)
+{
+    char *glyph;
+    struct avl_traverser t;
+    cs_entry *ptr;
+    if (t1_synthetic || fd_cur->all_glyphs) {   /* mark everything */
+        if (cs_tab != NULL)
+            for (ptr = cs_tab; ptr < cs_ptr; ptr++)
+                if (ptr->valid)
+                    ptr->used = true;
+        if (subr_tab != NULL) {
+            for (ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+                if (ptr->valid)
+                    ptr->used = true;
+            subr_max = subr_size - 1;
+        }
+        return;
+    }
+    mark_cs(notdef);
+    avl_t_init(&t, fd_cur->gl_tree);
+    for (glyph = (char *) avl_t_first(&t, fd_cur->gl_tree); glyph != NULL;
+         glyph = (char *) avl_t_next(&t)) {
+        mark_cs(glyph);
+    }
+    if (subr_tab != NULL)
+        for (subr_max = -1, ptr = subr_tab; ptr - subr_tab < subr_size; ptr++)
+            if (ptr->used && ptr - subr_tab > subr_max)
+                subr_max = ptr - subr_tab;
+}
+
+
+static void t1_subset_charstrings (void)
+{
+    cs_entry *ptr;
+    cs_size_pos =
+        strstr (t1_line_array, charstringname) + strlen (charstringname)
+        - t1_line_array + 1;
+    /* cs_size_pos points to the number indicating
+       dict size after "/CharStrings" */
+    cs_size = t1_scan_num (t1_line_array + cs_size_pos, 0);
+    cs_ptr = cs_tab = xtalloc (cs_size, cs_entry);
+    for (ptr = cs_tab; ptr - cs_tab < cs_size; ptr++)
+        init_cs_entry (ptr);
+    cs_notdef = NULL;
+    cs_dict_start = xstrdup (t1_line_array);
+    t1_getline ();
+    while (t1_cslen) {
+        store_cs ();
+        t1_getline ();
+    }
+    cs_dict_end = xstrdup (t1_line_array);
+    t1_mark_glyphs ();
+    if (subr_tab != NULL) {
+        if (cs_token_pair == NULL)
+            pdftex_fail
+                ("This Type 1 font uses mismatched subroutine begin/end token pairs.");
+        t1_subr_flush ();
+    }
+    for (cs_counter = 0, ptr = cs_tab; ptr < cs_ptr; ptr++)
+        if (ptr->used)
+            cs_counter++;
+    t1_cs_flush ();
+}
+
+static void t1_subset_end (void)
+{
+    if (t1_synthetic) {         /* copy to "dup /FontName get exch definefont pop" */
+        while (!strstr (t1_line_array, "definefont")) {
+            t1_getline ();
+            t1_putline ();
+        }
+        while (!t1_end_eexec ())
+            t1_getline ();      /* ignore the rest */
+        t1_putline ();          /* write "mark currentfile closefile" */
+    } else
+        while (!t1_end_eexec ()) {      /* copy to "mark currentfile closefile" */
+            t1_getline ();
+            t1_putline ();
+        }
+    t1_stop_eexec ();
+    if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
+        while (!t1_cleartomark ()) {
+            t1_getline ();
+            t1_putline ();
+        }
+        if (!t1_synthetic)      /* don't check "{restore}if" for synthetic fonts */
+            t1_check_end ();    /* write "{restore}if" if found */
+    }
+    get_length3 ();
+}
+
+void writet1(fd_entry * fd)
+{
+    fd_cur = fd;                /* fd_cur is global inside writet1.c */
+    assert(fd_cur->fm != NULL);
+    assert(is_type1(fd->fm));
+    assert(is_included(fd->fm));
+
+    t1_save_offset = 0;
+    if (!is_subsetted(fd_cur->fm)) {    /* include entire font */
+        if (!(fd->ff_found = t1_open_fontfile("<<")))
+            return;
+        t1_include ();
+        t1_close_font_file (">>");
+        return;
+    }
+    /* partial downloading */
+    if (!(fd->ff_found = t1_open_fontfile("<")))
+        return;
+    t1_subset_ascii_part ();
+    t1_start_eexec ();
+    cc_init ();
+    cs_init ();
+    t1_read_subrs ();
+    t1_subset_charstrings ();
+    t1_subset_end ();
+    t1_close_font_file (">");
+}
+
+void t1_free ()
+{
+    xfree (t1_line_array);
+    xfree (t1_buf_array);
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/font/writet3.c b/Build/source/texk/web2c/luatexdir/font/writet3.c
new file mode 100644
index 00000000000..42827d1b124
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writet3.c
@@ -0,0 +1,348 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writet3.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+#include <kpathsea/tex-glyph.h>
+#include <kpathsea/magstep.h>
+#include <string.h>
+
+#define T3_BUF_SIZE   1024
+
+typedef char t3_line_entry;
+define_array (t3_line);
+
+FILE *t3_file;
+static boolean t3_image_used;
+
+static integer t3_char_procs[256];
+static float t3_char_widths[256];
+static int t3_glyph_num;
+static float t3_font_scale;
+static integer t3_b0, t3_b1, t3_b2, t3_b3;
+static boolean is_pk_font;
+
+static unsigned char *t3_buffer  = NULL;
+static integer        t3_size    = 0;
+static integer        t3_curbyte = 0;
+
+
+#define t3_open()       \
+    open_input(&t3_file, kpse_miscfonts_format, FOPEN_RBIN_MODE)
+#define t3_read_file() readbinfile(t3_file,&t3_buffer,&t3_size)
+#define t3_close()     xfclose(t3_file, cur_file_name)
+#define t3_getchar()   t3_buffer[t3_curbyte++]
+#define t3_eof()      (t3_curbyte>t3_size)
+
+#define t3_prefix(s)    (!strncmp(t3_line_array, s, strlen(s)))
+#define t3_putchar(c)   pdfout(c)
+
+
+
+#define t3_check_eof()                                     \
+    if (t3_eof())                                          \
+        pdftex_fail("unexpected end of file");
+
+
+static void update_bbox (integer llx, integer lly, integer urx, integer ury,
+                         boolean is_first_glyph)
+{
+    if (is_first_glyph) {
+        t3_b0 = llx;
+        t3_b1 = lly;
+        t3_b2 = urx;
+        t3_b3 = ury;
+    } else {
+        if (llx < t3_b0)
+            t3_b0 = llx;
+        if (lly < t3_b1)
+            t3_b1 = lly;
+        if (urx > t3_b2)
+            t3_b2 = urx;
+        if (ury > t3_b3)
+            t3_b3 = ury;
+    }
+}
+
+static integer get_pk_font_scale (internalfontnumber f)
+{
+    return
+        divide_scaled (pk_scale_factor,
+					   divide_scaled (pdf_font_size(f), one_hundred_bp,
+                                    fixed_decimal_digits + 2), 0);
+}
+
+static integer pk_char_width (internalfontnumber f, scaled w)
+{
+    return
+	  divide_scaled (divide_scaled (w, pdf_font_size(f), 7),
+                      get_pk_font_scale (f), 0);
+}
+
+scaled get_pk_char_width (internalfontnumber f, scaled w)
+{
+    return (get_pk_font_scale (f) / 100000.0) *
+	  (pk_char_width (f, w) / 100.0) * pdf_font_size(f);
+}
+
+static boolean writepk (internalfontnumber f)
+{
+    kpse_glyph_file_type font_ret;
+    integer llx, lly, urx, ury;
+    integer cw, rw, i, j;
+    halfword *row;
+    char *name;
+	char *ftemp = NULL;
+    chardesc cd;
+    boolean is_null_glyph, check_preamble;
+    integer dpi;
+    int callback_id=0;
+    int file_opened=0;
+    int mallocsize=0;
+    if (t3_buffer!=NULL) {
+      xfree(t3_buffer);
+      t3_buffer=NULL;
+    }
+    t3_curbyte=0;
+    t3_size=0;
+
+	callback_id=callback_defined(find_pk_file_callback);
+
+	if (callback_id>0) {
+      dpi = round (fixed_pk_resolution *
+				   (((float) pdf_font_size(f)) / font_dsize(f)));
+      /* <base>.dpi/<fontname>.<tdpi>pk */
+      cur_file_name = font_name(f);
+      mallocsize = strlen(cur_file_name)+24+9;
+      name = xmalloc(mallocsize);
+      snprintf(name,mallocsize,"%ddpi/%s.%dpk",(int)fixed_pk_resolution,cur_file_name,(int)dpi);
+	  if(run_callback(callback_id,"S->S",name,&ftemp)) {
+		if(ftemp!=NULL&&strlen(ftemp)) {
+		  free(name);
+		  name = xstrdup(ftemp);
+		  free(ftemp);
+		}
+	  }
+	} else {
+      dpi =
+        kpse_magstep_fix (round
+                          (fixed_pk_resolution *
+                           (((float) pdf_font_size(f)) / font_dsize(f))),
+                          fixed_pk_resolution, NULL);
+      cur_file_name = font_name(f);
+      name = kpse_find_pk (cur_file_name, (unsigned) dpi, &font_ret);
+      if (name == NULL ||
+        !FILESTRCASEEQ (cur_file_name, font_ret.name) ||
+        !kpse_bitmap_tolerance ((float) font_ret.dpi, (float) dpi)) {
+        pdftex_warn ("Font %s at %i not found", cur_file_name, (int) dpi);
+        cur_file_name = NULL;
+        return false;
+      }
+	}
+    callback_id=callback_defined(read_pk_file_callback);
+    if (callback_id>0) {
+      if(! ( run_callback(callback_id,"S->bSd",name, &file_opened, &t3_buffer,&t3_size) &&
+	     file_opened && 
+	     t3_size>0 ) ) {
+		pdftex_warn ("Font %s at %i not found", cur_file_name, (int)dpi);
+		cur_file_name = NULL;
+		return false;
+      }
+    } else {
+      t3_file = xfopen (name, FOPEN_RBIN_MODE);
+      t3_read_file();
+      t3_close();
+    }
+    t3_image_used = true;
+    is_pk_font = true;
+	if (tracefilenames)
+	  tex_printf (" <%s", (char *) name);
+    cd.rastersize = 256;
+    cd.raster = xtalloc (cd.rastersize, halfword);
+    check_preamble = true;
+    while (readchar (check_preamble, &cd) != 0) {
+        check_preamble = false;
+        if (!pdf_char_marked (f, cd.charcode))
+            continue;
+        t3_char_widths[cd.charcode] =
+            pk_char_width (f, get_charwidth (f, cd.charcode));
+        if (cd.cwidth < 1 || cd.cheight < 1) {
+            cd.xescape = cd.cwidth =
+                round (t3_char_widths[cd.charcode] / 100.0);
+            cd.cheight = 1;
+            cd.xoff = 0;
+            cd.yoff = 0;
+            is_null_glyph = true;
+        } else
+            is_null_glyph = false;
+        llx = -cd.xoff;
+        lly = cd.yoff - cd.cheight + 1;
+        urx = cd.cwidth + llx + 1;
+        ury = cd.cheight + lly;
+        update_bbox (llx, lly, urx, ury, t3_glyph_num == 0);
+        t3_glyph_num++;
+        pdf_new_dict (0, 0, 0);
+        t3_char_procs[cd.charcode] = obj_ptr;
+        pdf_begin_stream ();
+        pdf_print_real (t3_char_widths[cd.charcode], 2);
+        pdf_printf (" 0 %i %i %i %i d1\n",
+                    (int) llx, (int) lly, (int) urx, (int) ury);
+        if (is_null_glyph)
+            goto end_stream;
+        pdf_printf ("q\n%i 0 0 %i %i %i cm\nBI\n", (int) cd.cwidth,
+                    (int) cd.cheight, (int) llx, (int) lly);
+        pdf_printf ("/W %i\n/H %i\n", (int) cd.cwidth, (int) cd.cheight);
+        pdf_puts ("/IM true\n/BPC 1\n/D [1 0]\nID ");
+        cw = (cd.cwidth + 7) / 8;
+        rw = (cd.cwidth + 15) / 16;
+        row = cd.raster;
+        for (i = 0; i < cd.cheight; i++) {
+            for (j = 0; j < rw - 1; j++) {
+                pdfout (*row / 256);
+                pdfout (*row % 256);
+                row++;
+            }
+            pdfout (*row / 256);
+            if (2 * rw == cw)
+                pdfout (*row % 256);
+            row++;
+        }
+        pdf_puts ("\nEI\nQ\n");
+      end_stream:
+        pdf_end_stream ();
+    }
+    xfree (cd.raster);
+    cur_file_name = NULL;
+    return true;
+}
+
+void writet3 (int objnum, internalfontnumber f)
+{
+
+    int i;
+    integer wptr, eptr, cptr;
+    int first_char, last_char;
+    integer pk_font_scale;
+    boolean is_notdef;
+
+
+    t3_glyph_num = 0;
+    t3_image_used = false;
+    for (i = 0; i < 256; i++) {
+        t3_char_procs[i] = 0;
+        t3_char_widths[i] = 0;
+    }
+    pack_file_name (tex_font_name(f), get_nullstr (), maketexlstring (".pgc",4));
+    cur_file_name = makecstring (make_name_string ());
+    is_pk_font = false;
+
+    if (t3_buffer!=NULL) {
+      xfree(t3_buffer);
+      t3_buffer=NULL;
+    }
+    t3_curbyte=0;
+    t3_size=0;
+	if (!writepk (f)) {
+	  cur_file_name = NULL;
+	  return;
+	}
+    for (i = font_bc(f); i <= font_ec(f); i++)
+        if (pdf_char_marked (f, i))
+            break;
+    first_char = i;
+    for (i = font_ec(f); i > first_char; i--)
+        if (pdf_char_marked (f, i))
+            break;
+    last_char = i;
+    pdf_begin_dict (objnum, 1);   /* Type 3 font dictionary */
+    pdf_puts ("/Type /Font\n/Subtype /Type3\n");
+    pdf_printf ("/Name /F%i\n", (int) f);
+    if (pdf_font_attr(f) != get_nullstr ()) {
+   	    pdf_print (pdf_font_attr(f));
+        pdf_puts ("\n");
+    }
+    if (is_pk_font) {
+        pk_font_scale = get_pk_font_scale (f);
+        pdf_puts ("/FontMatrix [");
+        pdf_print_real (pk_font_scale, 5);
+        pdf_puts (" 0 0 ");
+        pdf_print_real (pk_font_scale, 5);
+        pdf_puts (" 0 0]\n");
+    } else
+        pdf_printf ("/FontMatrix [%g 0 0 %g 0 0]\n",
+                    (double) t3_font_scale, (double) t3_font_scale);
+    pdf_printf ("/%s [ %i %i %i %i ]\n",
+                font_key[FONTBBOX1_CODE].pdfname,
+                (int) t3_b0, (int) t3_b1, (int) t3_b2, (int) t3_b3);
+    pdf_printf ("/Resources << /ProcSet [ /PDF %s] >>\n",
+                t3_image_used ? "/ImageB " : "");
+    pdf_printf ("/FirstChar %i\n/LastChar %i\n", first_char, last_char);
+    wptr = pdf_new_objnum ();
+    eptr = pdf_new_objnum ();
+    cptr = pdf_new_objnum ();
+    pdf_printf ("/Widths %i 0 R\n/Encoding %i 0 R\n/CharProcs %i 0 R\n",
+                (int)wptr, (int)eptr, (int)cptr);
+    pdf_end_dict ();
+    pdf_begin_obj (wptr, 1);      /* chars width array */
+    pdf_puts ("[");
+    if (is_pk_font)
+        for (i = first_char; i <= last_char; i++) {
+            pdf_print_real (t3_char_widths[i], 2);
+            pdf_puts (" ");
+    } else
+        for (i = first_char; i <= last_char; i++)
+            pdf_printf ("%i ", (int) t3_char_widths[i]);
+    pdf_puts ("]\n");
+    pdf_end_obj ();
+    pdf_begin_dict (eptr, 1);     /* encoding dictionary */
+    pdf_printf ("/Type /Encoding\n/Differences [%i", first_char);
+    if (t3_char_procs[first_char] == 0) {
+        pdf_printf ("/%s", notdef);
+        is_notdef = true;
+    } else {
+        pdf_printf ("/a%i", first_char);
+        is_notdef = false;
+    }
+    for (i = first_char + 1; i <= last_char; i++) {
+        if (t3_char_procs[i] == 0) {
+            if (!is_notdef) {
+                pdf_printf (" %i/%s", i, notdef);
+                is_notdef = true;
+            }
+        } else {
+            if (is_notdef) {
+                pdf_printf (" %i", i);
+                is_notdef = false;
+            }
+            pdf_printf ("/a%i", i);
+        }
+    }
+    pdf_puts ("]\n");
+    pdf_end_dict ();
+    pdf_begin_dict (cptr, 1);     /* CharProcs dictionary */
+    for (i = first_char; i <= last_char; i++)
+        if (t3_char_procs[i] != 0)
+            pdf_printf ("/a%i %i 0 R\n", (int) i, (int) t3_char_procs[i]);
+    pdf_end_dict ();
+	if (tracefilenames)
+	  tex_printf (">");
+    cur_file_name = NULL;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/writettf.c b/Build/source/texk/web2c/luatexdir/font/writettf.c
new file mode 100644
index 00000000000..2a92706a0de
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writettf.c
@@ -0,0 +1,1509 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writettf.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+#include "writettf.h"
+#include <string.h>
+
+#define DEFAULT_NTABS       14
+#define NEW_CMAP_SIZE       2
+
+#define ttf_putchar     fb_putchar
+#define ttf_offset      fb_offset
+#define ttf_seek_outbuf fb_seek
+
+					 /* #define INFILE ttf_file*/
+
+unsigned char *ttf_buffer = NULL;
+integer ttf_size = 0;
+integer ttf_curbyte = 0;
+
+typedef struct {
+    char *name;                 /* name of glyph */
+    long code;                  /* charcode in case of subfonts */
+    short newindex;             /* new index of glyph in output file */
+
+} ttfenc_entry;
+
+typedef struct {
+    TTF_USHORT platform_id;
+    TTF_USHORT encoding_id;
+    TTF_USHORT language_id;
+    TTF_USHORT name_id;
+    TTF_USHORT length;
+    TTF_USHORT offset;
+    TTF_USHORT new_offset;
+    TTF_USHORT new_length;
+} name_record;
+
+typedef struct {
+    char *ttf_name;
+    TTF_USHORT pid;
+    TTF_USHORT eid;
+    short *table;
+} ttf_cmap_entry;
+
+static TTF_USHORT ntabs;
+static TTF_USHORT upem;
+static TTF_FIXED post_format;
+static TTF_SHORT loca_format;
+static TTF_ULONG last_glyf_offset;
+static TTF_USHORT glyphs_count;
+static TTF_USHORT new_glyphs_count;
+static TTF_USHORT nhmtxs;
+static TTF_USHORT new_ntabs;
+
+glyph_entry *glyph_tab;
+dirtab_entry *dir_tab;
+
+static long *glyph_index;
+static cmap_entry *cmap_tab, new_cmap_tab[NEW_CMAP_SIZE];
+static name_record *name_tab;
+static int name_record_num;
+static char *name_buf;
+static int name_buf_size;
+static char *glyph_name_buf;
+static TTF_ULONG checksum;
+static TTF_ULONG tab_length;
+static TTF_ULONG tmp_ulong;
+static TTF_ULONG checkSumAdjustment_offset;
+FILE *ttf_file;
+static ttfenc_entry ttfenc_tab[256];
+
+fd_entry *fd_cur;        /* pointer to the current font descriptor */
+
+static struct avl_table *ttf_cmap_tree = NULL;
+
+integer ttf_length;
+
+#include "macnames.c"
+
+extern char *fb_array;
+extern char charsetstr[];
+
+static const char *newtabnames[] = {
+    "OS/2",
+    "PCLT",
+    "cmap",
+    "cvt ",
+    "fpgm",
+    "glyf",
+    "head",
+    "hhea",
+    "hmtx",
+    "loca",
+    "maxp",
+    "name",
+    "post",
+    "prep"
+};
+
+ttf_cmap_entry *new_ttf_cmap_entry (void)
+{
+    ttf_cmap_entry *e;
+    e = xtalloc (1, ttf_cmap_entry);
+    e->ttf_name = NULL;
+    e->table = NULL;
+    return e;
+}
+
+static void destroy_ttf_cmap_entry (void *pa, void *pb)
+{
+    ttf_cmap_entry *p;
+    p = (ttf_cmap_entry *) pa;
+    xfree (p->ttf_name);
+    xfree (p->table);
+    xfree (p);
+}
+
+void ttf_free (void)
+{
+    if (ttf_cmap_tree != NULL)
+        avl_destroy (ttf_cmap_tree, destroy_ttf_cmap_entry);
+}
+
+static int comp_ttf_cmap_entry (const void *pa, const void *pb, void *p)
+{
+    const ttf_cmap_entry *p1 = (const ttf_cmap_entry *) pa,
+        *p2 = (const ttf_cmap_entry *) pb;
+    int i;
+    assert (p1->ttf_name != NULL && p2->ttf_name != NULL);
+    if ((i = strcmp (p1->ttf_name, p2->ttf_name)) != 0)
+        return i;
+    cmp_return (p1->pid, p2->pid);
+    cmp_return (p1->eid, p2->eid);
+    return 0;
+}
+
+static unsigned char ttf_addchksm (unsigned char b)
+{
+    tmp_ulong = (tmp_ulong << 8) + b;
+    tab_length++;
+    if (tab_length % 4 == 0) {
+        checksum += tmp_ulong;
+        tmp_ulong = 0;
+    }
+    return b;
+}
+
+static TTF_ULONG ttf_getchksm (void)
+{
+    while (tab_length % 4 != 0)
+        ttf_putchar (ttf_addchksm (0)); /* ttf_addchksm updates tab_length */
+    return checksum;
+}
+
+long ttf_putnum (int s, long n)
+{
+    long i = n;
+    char buf[TTF_LONG_SIZE + 1], *p = buf;
+    while (s-- > 0) {
+        *p++ = i & 0xFF;
+        i >>= 8;
+    }
+    p--;
+    while (p >= buf)
+        ttf_putchar (ttf_addchksm (*p--));
+    return n;
+}
+
+long ttf_getnum (int s)
+{
+    long i = 0;
+    int c;
+    while (s > 0) {
+	  if (ttf_eof())
+		pdftex_fail ("unexpected EOF");
+	  c = ttf_getchar ();
+	  i = (i << 8) + c;
+	  s--;
+    }
+    return i;
+}
+
+static long ttf_funit (long n)
+{
+    if (n < 0)
+        return -((-n / upem) * 1000 + ((-n % upem) * 1000) / upem);
+    else
+        return (n / upem) * 1000 + ((n % upem) * 1000) / upem;
+}
+
+static void ttf_ncopy (int n)
+{
+    while (n-- > 0)
+        copy_byte ();
+}
+
+dirtab_entry *ttf_name_lookup (const char *s, boolean required)
+{
+    dirtab_entry *tab;
+    for (tab = dir_tab; tab - dir_tab < ntabs; tab++)
+        if (strncmp (tab->tag, s, 4) == 0)
+            break;
+    if (tab - dir_tab == ntabs) {
+        if (required)
+            pdftex_fail ("can't find table `%s'", s);
+        else
+            tab = NULL;
+    }
+    return tab;
+}
+
+dirtab_entry *ttf_seek_tab (const char *name, TTF_LONG offset)
+{
+    dirtab_entry *tab = ttf_name_lookup (name, true);
+    /*xfseek (INFILE, tab->offset + offset, SEEK_SET, cur_file_name);*/
+	ttf_curbyte = tab->offset + offset;
+    return tab;
+}
+
+static void ttf_seek_off (TTF_LONG offset)
+{
+	ttf_curbyte = offset;
+    //xfseek (INFILE, offset, SEEK_SET, cur_file_name);
+}
+
+static void ttf_copy_encoding(void)
+{
+    int i, *q;
+    void **aa;
+    char **glyph_names;
+    long *charcodes;
+    static char buf[SMALL_BUF_SIZE];
+    struct avl_traverser t;
+    ttfenc_entry *e = ttfenc_tab;
+
+    assert(fd_cur->tx_tree != NULL);    /* this must be set in create_fontdictionary */
+
+    if (fd_cur->fe != NULL) {
+        glyph_names = fd_cur->fe->glyph_names;
+        assert(glyph_names != NULL);
+
+        for (i = 0; i < 256; i++)
+            ttfenc_tab[i].name = (char *) notdef;
+
+        /* a workaround for a bug of AcroReader 4.0 */
+        if (strcmp(glyph_names[97], "a") == 0) {
+            q = xtalloc(1, int);
+            *q = 'a';
+            aa = avl_probe(fd_cur->tx_tree, q);
+            assert(aa != NULL);
+        }
+        /* end of workaround */
+
+        /* take over collected characters from TeX, reencode them */
+        avl_t_init(&t, fd_cur->tx_tree);
+        for (q = (int *) avl_t_first(&t, fd_cur->tx_tree); q != NULL;
+             q = (int *) avl_t_next(&t)) {
+            assert(*q >= 0 && *q < 256);
+            ttfenc_tab[*q].name = glyph_names[*q];
+        }
+        make_subset_tag(fd_cur);
+    } else if (is_subfont(fd_cur->fm)) {
+        charcodes = fd_cur->fm->subfont->charcodes;
+        assert(charcodes != NULL);
+
+        for (i = 0; i < 256; i++)
+            ttfenc_tab[i].code = -1;
+
+        /* take over collected characters from TeX */
+        avl_t_init(&t, fd_cur->tx_tree);
+        for (q = (int *) avl_t_first(&t, fd_cur->tx_tree); q != NULL;
+             q = (int *) avl_t_next(&t)) {
+            assert(*q >= 0 && *q < 256);
+            e = ttfenc_tab + *q;
+            e->code = charcodes[*q];
+            if (e->code == -1)
+                pdftex_warn("character %i is not mapped to any charcode", *q);
+            else {
+                assert(e->code < 0x10000);
+                sprintf(buf, "/c%4.4X", (int) e->code);
+                aa = avl_probe(fd_cur->gl_tree, xstrdup(buf));
+                assert(aa != NULL);
+            }
+        }
+        make_subset_tag(fd_cur);
+    } else
+        assert(0);
+}
+
+#define ttf_append_byte(B)\
+do {\
+    if (name_tab[i].platform_id == 3)\
+        *q++ = 0;\
+    *q++ = B;\
+} while (0)
+
+static char *strip_spaces_and_delims(char *s, int l)
+{
+    static char buf[SMALL_BUF_SIZE];
+    char *p = buf;
+    int i;
+
+    assert(l >= 0 && l < (int) sizeof(buf));
+
+    for (i = 0; i < l; s++, i++) {
+        if (*s == '(' || *s == ')' || *s == '<' || *s == '>' ||
+            *s == '[' || *s == ']' || *s == '{' || *s == '}' ||
+            *s == '/' || *s == '%' || isspace(*s))
+            continue;
+        *p++ = *s;
+    }
+    *p = 0;
+    return buf;
+}
+
+static void ttf_read_name (void)
+{
+    int i, j;
+    dirtab_entry *tab = ttf_seek_tab ("name", TTF_USHORT_SIZE);
+    char *p;
+    name_record_num = get_ushort ();
+    name_tab = xtalloc (name_record_num, name_record);
+    name_buf_size = tab->length -
+        (3 * TTF_USHORT_SIZE + name_record_num * 6 * TTF_USHORT_SIZE);
+    name_buf = xtalloc (name_buf_size, char);
+    ttf_skip (TTF_USHORT_SIZE);
+    for (i = 0; i < name_record_num; i++) {
+        name_tab[i].platform_id = get_ushort ();
+        name_tab[i].encoding_id = get_ushort ();
+        name_tab[i].language_id = get_ushort ();
+        name_tab[i].name_id = get_ushort ();
+        name_tab[i].length = get_ushort ();
+        name_tab[i].offset = get_ushort ();
+    }
+    for (p = name_buf; p - name_buf < name_buf_size; p++)
+        *p = get_char ();
+    /* look for PS font name */
+    for (i = 0; i < name_record_num; i++) {
+        if (name_tab[i].platform_id == 1 &&
+            name_tab[i].encoding_id == 0 && name_tab[i].name_id == 6) {
+            xfree(fd_cur->fontname);
+            fd_cur->fontname =
+                xstrdup(strip_spaces_and_delims(name_buf + name_tab[i].offset,
+                                                name_tab[i].length));
+            fd_cur->font_dim[FONTNAME_CODE].set = true;
+            break;
+        }
+    }
+    if (!fd_cur->font_dim[FONTNAME_CODE].set) {
+        for (i = 0; i < name_record_num; i++) {
+            if (name_tab[i].platform_id == 3 &&
+                (name_tab[i].encoding_id == 0 ||
+                 name_tab[i].encoding_id == 1) && name_tab[i].name_id == 6) {
+                for (j = 0, p = fd_cur->fontname; j < name_tab[i].length;
+                     j += 2)
+                    *p++ = name_buf[name_tab[i].offset + j + 1];
+                *p = 0;
+                fd_cur->font_dim[FONTNAME_CODE].set = true;
+                break;
+            }
+        }
+    }
+}
+
+static void ttf_read_mapx (void)
+{
+    glyph_entry *glyph;
+    ttf_seek_tab ("maxp", TTF_FIXED_SIZE);
+    glyph_tab = xtalloc (1 + (glyphs_count = get_ushort ()), glyph_entry);
+    for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++) {
+        glyph->newindex = -1;
+        glyph->newoffset = 0;
+        glyph->name_index = 0;
+        glyph->name = (char *) notdef;
+    }
+    glyph_index = xtalloc (glyphs_count, long);
+    glyph_index[0] = 0;         /* index of ".notdef" glyph */
+    glyph_index[1] = 1;         /* index of ".null" glyph */
+}
+
+void ttf_read_head (void)
+{
+    ttf_seek_tab ("head",
+                  2 * TTF_FIXED_SIZE + 2 * TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+    upem = get_ushort ();
+    ttf_skip (16);
+    fd_cur->font_dim[FONTBBOX1_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[FONTBBOX2_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[FONTBBOX3_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[FONTBBOX4_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[FONTBBOX1_CODE].set = true;
+    fd_cur->font_dim[FONTBBOX2_CODE].set = true;
+    fd_cur->font_dim[FONTBBOX3_CODE].set = true;
+    fd_cur->font_dim[FONTBBOX4_CODE].set = true;
+    ttf_skip (2 * TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+    loca_format = get_short ();
+}
+
+void ttf_read_hhea (void)
+{
+    ttf_seek_tab ("hhea", TTF_FIXED_SIZE);
+    fd_cur->font_dim[ASCENT_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[DESCENT_CODE].val = ttf_funit(get_fword());
+    fd_cur->font_dim[ASCENT_CODE].set = true;
+    fd_cur->font_dim[DESCENT_CODE].set = true;
+    ttf_skip (TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3 * TTF_FWORD_SIZE +
+              8 * TTF_SHORT_SIZE);
+    nhmtxs = get_ushort ();
+}
+
+void ttf_read_pclt (void)
+{
+    if (ttf_name_lookup ("PCLT", false) == NULL)
+        return;
+    ttf_seek_tab ("PCLT", TTF_FIXED_SIZE + TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+    fd_cur->font_dim[XHEIGHT_CODE].val = ttf_funit(get_ushort());
+    ttf_skip(2 * TTF_USHORT_SIZE);
+    fd_cur->font_dim[CAPHEIGHT_CODE].val = ttf_funit(get_ushort());
+    fd_cur->font_dim[XHEIGHT_CODE].set = true;
+    fd_cur->font_dim[CAPHEIGHT_CODE].set = true;
+}
+
+static void ttf_read_hmtx (void)
+{
+    glyph_entry *glyph;
+    TTF_UFWORD last_advWidth;
+    ttf_seek_tab ("hmtx", 0);
+    for (glyph = glyph_tab; glyph - glyph_tab < nhmtxs; glyph++) {
+        glyph->advWidth = get_ufword ();
+        glyph->lsb = get_ufword ();
+    }
+    if (nhmtxs < glyphs_count) {
+        last_advWidth = glyph[-1].advWidth;
+        for (; glyph - glyph_tab < glyphs_count; glyph++) {
+            glyph->advWidth = last_advWidth;
+            glyph->lsb = get_ufword ();
+        }
+    }
+}
+
+void ttf_read_post (void)
+{
+    int k, nnames;
+    long length;
+    long int_part, frac_part;
+    int sign = 1;
+    TTF_FIXED italic_angle;
+    char *p;
+    glyph_entry *glyph;
+    const dirtab_entry *tab = ttf_seek_tab ("post", 0);
+    post_format = get_fixed ();
+    italic_angle = get_fixed ();
+    int_part = italic_angle >> 16;
+    if (int_part > 0x7FFF) {    /* a negative number */
+        int_part = 0x10000 - int_part;
+        sign = -1;
+    }
+    frac_part = italic_angle % 0x10000;
+    fd_cur->font_dim[ITALIC_ANGLE_CODE].val =
+        sign * (int_part + frac_part * 1.0 / 0x10000);
+    fd_cur->font_dim[ITALIC_ANGLE_CODE].set = true;
+    if (glyph_tab == NULL)
+        return;                 /* being called from writeotf() */
+    ttf_skip (2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
+    switch (post_format) {
+    case 0x10000:
+        for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
+            glyph->name = (char *) mac_glyph_names[glyph - glyph_tab];
+            glyph->name_index = glyph - glyph_tab;
+        }
+        break;
+    case 0x20000:
+        nnames = get_ushort (); /* some fonts have this value different from nglyphs */
+        for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++)
+            glyph->name_index = get_ushort ();
+        /*length = tab->length - (xftell (INFILE, cur_file_name) - tab->offset);*/
+        length = tab->length - (ttf_curbyte - tab->offset);
+        glyph_name_buf = xtalloc (length, char);
+        for (p = glyph_name_buf; p - glyph_name_buf < length;) {
+            for (k = get_byte (); k > 0; k--)
+                *p++ = get_char ();
+            *p++ = 0;
+        }
+        for (glyph = glyph_tab; glyph - glyph_tab < nnames; glyph++) {
+            if (glyph->name_index < NMACGLYPHS)
+                glyph->name = (char *) mac_glyph_names[glyph->name_index];
+            else {
+                p = glyph_name_buf;
+                k = glyph->name_index - NMACGLYPHS;
+                for (; k > 0; k--)
+                    p = strend (p) + 1;
+                glyph->name = p;
+            }
+        }
+        break;
+    case 0x00030000:
+        for (glyph = glyph_tab; glyph - glyph_tab < NMACGLYPHS; glyph++) {
+            glyph->name_index = glyph - glyph_tab;
+        }
+        break;
+    default:
+        pdftex_fail ("unsupported format (%.8X) of `post' table",
+                     (unsigned int) post_format);
+    }
+}
+
+static void ttf_read_loca (void)
+{
+    glyph_entry *glyph;
+    ttf_seek_tab ("loca", 0);
+    if (loca_format != 0)
+        for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
+            glyph->offset = get_ulong ();
+    else
+        for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count + 1; glyph++)
+            glyph->offset = get_ushort () << 1;
+}
+
+void ttf_read_tabdir (void)
+{
+    int i;
+    dirtab_entry *tab;
+    ttf_skip (TTF_FIXED_SIZE);  /* ignore the sfnt number */
+    dir_tab = xtalloc (ntabs = get_ushort (), dirtab_entry);
+    ttf_skip (3 * TTF_USHORT_SIZE);
+    for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+        for (i = 0; i < 4; i++)
+            tab->tag[i] = get_char ();
+        tab->checksum = get_ulong ();
+        tab->offset = get_ulong ();
+        tab->length = get_ulong ();
+    }
+}
+
+static ttf_cmap_entry *ttf_read_cmap (char *ttf_name, int pid, int eid,
+                                      boolean warn)
+{
+    seg_entry *seg_tab, *s;
+    TTF_USHORT *glyphId, format, segCount;
+    TTF_USHORT ncmapsubtabs, tmp_pid, tmp_eid;
+    TTF_ULONG cmap_offset, tmp_offset;
+    long n, i, k, length, index;
+    ttf_cmap_entry tmp_e, *p;
+    void **aa;
+
+    /* loop up in ttf_cmap_tree first, return if found */
+    tmp_e.ttf_name = ttf_name;
+    tmp_e.pid = pid;
+    tmp_e.eid = eid;
+    if (ttf_cmap_tree == NULL) {
+        ttf_cmap_tree = avl_create (comp_ttf_cmap_entry, NULL, &avl_xallocator);
+        assert (ttf_cmap_tree != NULL);
+    }
+    p = (ttf_cmap_entry *) avl_find (ttf_cmap_tree, &tmp_e);
+    if (p != NULL)
+        return p;
+
+    /* not found, have to read it */
+    ttf_seek_tab ("cmap", TTF_USHORT_SIZE);     /* skip the table vesrion number (=0) */
+    ncmapsubtabs = get_ushort ();
+	/*    cmap_offset = xftell (INFILE, cur_file_name) - 2 * TTF_USHORT_SIZE;*/
+	cmap_offset = ttf_curbyte - 2 * TTF_USHORT_SIZE;
+    cmap_tab = xtalloc (ncmapsubtabs, cmap_entry);
+    for (i = 0; i < ncmapsubtabs; ++i) {
+        tmp_pid = get_ushort ();
+        tmp_eid = get_ushort ();
+        tmp_offset = get_ulong ();
+        if (tmp_pid == pid && tmp_eid == eid) {
+            ttf_seek_off (cmap_offset + tmp_offset);
+            format = get_ushort ();
+            if (format == 4)
+                goto read_cmap_format_4;
+            else {
+                if (warn)
+                    pdftex_warn ("cmap format %i unsupported", format);
+                return NULL;
+            }
+        }
+    }
+    if (warn)
+        pdftex_warn ("cannot find cmap subtable for (pid,eid) = (%i, %i)",
+                     pid, eid);
+    return NULL;
+  read_cmap_format_4:
+    /* initialize the new entry */
+    p = new_ttf_cmap_entry ();
+    p->ttf_name = xstrdup (ttf_name);
+    p->pid = pid;
+    p->eid = eid;
+    p->table = xtalloc (0x10000, short);
+    for (i = 0; i < 0x10000; ++i)
+        p->table[i] = -1;       /* unassigned yet */
+
+    /* read the subtable */
+    length = get_ushort ();     /* length of subtable */
+    (void) get_ushort ();       /* skip the version number */
+    segCount = get_ushort () / 2;
+    (void) get_ushort ();       /* skip searchRange */
+    (void) get_ushort ();       /* skip entrySelector */
+    (void) get_ushort ();       /* skip rangeShift */
+    seg_tab = xtalloc (segCount, seg_entry);
+    for (s = seg_tab; s - seg_tab < segCount; s++)
+        s->endCode = get_ushort ();
+    (void) get_ushort ();       /* skip reversedPad */
+    for (s = seg_tab; s - seg_tab < segCount; s++)
+        s->startCode = get_ushort ();
+    for (s = seg_tab; s - seg_tab < segCount; s++)
+        s->idDelta = get_ushort ();
+    for (s = seg_tab; s - seg_tab < segCount; s++)
+        s->idRangeOffset = get_ushort ();
+    length -= 8 * TTF_USHORT_SIZE + 4 * segCount * TTF_USHORT_SIZE;
+    n = length / TTF_USHORT_SIZE;       /* number of glyphID's */
+    glyphId = xtalloc (n, TTF_USHORT);
+    for (i = 0; i < n; i++)
+        glyphId[i] = get_ushort ();
+    for (s = seg_tab; s - seg_tab < segCount; s++) {
+        for (i = s->startCode; i <= s->endCode; i++) {
+            if (i == 0xFFFF)
+                break;
+            if (s->idRangeOffset != 0xFFFF) {
+                if (s->idRangeOffset == 0)
+                    index = (s->idDelta + i) & 0xFFFF;
+                else {
+                    k = (i - s->startCode) + s->idRangeOffset / 2 +
+                        (s - seg_tab) - segCount;
+                    assert (k >= 0 && k < n);
+                    index = glyphId[k];
+                    if (index != 0)
+                        index = (index + s->idDelta) & 0xFFFF;
+                }
+                if (index >= glyphs_count)
+                    pdftex_fail ("cmap: glyph index %li out of range [0..%i)",
+                                 index, glyphs_count);
+                if (p->table[i] != -1)
+                    pdftex_warn
+                        ("cmap: multiple glyphs are mapped to unicode %.4lX, "
+                         "only %i will be used (glyph %li being ignored)", i,
+                         p->table[i], index);
+                else
+                    p->table[i] = index;
+            }
+        }
+    }
+    xfree (seg_tab);
+    xfree (glyphId);
+    aa = avl_probe (ttf_cmap_tree, p);
+    assert (aa != NULL);
+    return p;
+}
+
+static void ttf_read_font (void)
+{
+    ttf_read_tabdir ();
+    if (ttf_name_lookup ("PCLT", false) == NULL)
+        new_ntabs--;
+    if (ttf_name_lookup ("fpgm", false) == NULL)
+        new_ntabs--;
+    if (ttf_name_lookup ("cvt ", false) == NULL)
+        new_ntabs--;
+    if (ttf_name_lookup ("prep", false) == NULL)
+        new_ntabs--;
+    ttf_read_mapx ();
+    ttf_read_head ();
+    ttf_read_hhea ();
+    ttf_read_pclt ();
+    ttf_read_hmtx ();
+    ttf_read_post ();
+    ttf_read_loca ();
+    ttf_read_name ();
+}
+
+static void ttf_reset_chksm (dirtab_entry * tab)
+{
+    checksum = 0;
+    tab_length = 0;
+    tmp_ulong = 0;
+    tab->offset = ttf_offset ();
+    if (tab->offset % 4 != 0)
+        pdftex_warn ("offset of `%4.4s' is not a multiple of 4", tab->tag);
+}
+
+
+static void ttf_set_chksm (dirtab_entry * tab)
+{
+    tab->length = ttf_offset () - tab->offset;
+    tab->checksum = ttf_getchksm ();
+}
+
+static void ttf_copytab (const char *name)
+{
+    long i;
+    dirtab_entry *tab = ttf_seek_tab (name, 0);
+    ttf_reset_chksm (tab);
+    for (i = tab->length; i > 0; i--)
+        copy_char ();
+    ttf_set_chksm (tab);
+}
+
+#define BYTE_ENCODING_LENGTH  \
+    ((256)*TTF_BYTE_SIZE + 3*TTF_USHORT_SIZE)
+
+static void ttf_byte_encoding (void)
+{
+    ttfenc_entry *e;
+    (void) put_ushort (0);      /* format number (0: byte encoding table) */
+    (void) put_ushort (BYTE_ENCODING_LENGTH);   /* length of table */
+    (void) put_ushort (0);      /* version number */
+    for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
+        if (e->newindex < 256) {
+            put_byte (e->newindex);
+        } else {
+            if (e->name != notdef)
+                pdftex_warn
+                    ("glyph `%s' has been mapped to `%s' in `ttf_byte_encoding' cmap table",
+                     e->name, notdef);
+            put_byte (0);       /* notdef */
+        }
+}
+
+#define TRIMMED_TABLE_MAP_LENGTH (TTF_USHORT_SIZE*(5 + (256)))
+
+static void ttf_trimmed_table_map (void)
+{
+    ttfenc_entry *e;
+    (void) put_ushort (6);      /* format number (6): trimmed table mapping */
+    (void) put_ushort (TRIMMED_TABLE_MAP_LENGTH);
+    (void) put_ushort (0);      /* version number (0) */
+    (void) put_ushort (0);      /* first character code */
+    (void) put_ushort (256);    /* number of character code in table */
+    for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
+        (void) put_ushort (e->newindex);
+}
+
+#define SEG_MAP_DELTA_LENGTH ((16 + (256))*TTF_USHORT_SIZE)
+
+static void ttf_seg_map_delta (void)
+{
+    ttfenc_entry *e;
+    (void) put_ushort (4);      /* format number (4: segment mapping to delta values) */
+    (void) put_ushort (SEG_MAP_DELTA_LENGTH);
+    (void) put_ushort (0);      /* version number */
+    (void) put_ushort (4);      /* 2*segCount */
+    (void) put_ushort (4);      /* searchRange */
+    (void) put_ushort (1);      /* entrySelector */
+    (void) put_ushort (0);      /* rangeShift */
+    (void) put_ushort (0xF0FF); /* endCount[0] */
+    (void) put_ushort (0xFFFF); /* endCount[1] */
+    (void) put_ushort (0);      /* reversedPad */
+    (void) put_ushort (0xF000); /* startCount[0] */
+    (void) put_ushort (0xFFFF); /* startCount[1] */
+    (void) put_ushort (0);      /* idDelta[0] */
+    (void) put_ushort (1);      /* idDelta[1] */
+    (void) put_ushort (2 * TTF_USHORT_SIZE);    /* idRangeOffset[0] */
+    (void) put_ushort (0);      /* idRangeOffset[1] */
+    for (e = ttfenc_tab; e - ttfenc_tab < 256; e++)
+        (void) put_ushort (e->newindex);
+}
+
+#define CMAP_ENTRY_LENGTH (2*TTF_USHORT_SIZE + TTF_ULONG_SIZE)
+
+static void ttf_select_cmap (void)
+{
+    assert (sizeof (new_cmap_tab) <= NEW_CMAP_SIZE * sizeof (cmap_entry));
+    new_cmap_tab[0].platform_id = 1;    /* Macintosh */
+    new_cmap_tab[0].encoding_id = 0;    /* Symbol; ignore code page */
+    new_cmap_tab[0].format = new_glyphs_count < 256 ? 0 /* byte encoding */
+        : 6;                    /* trimmed table mapping */
+    new_cmap_tab[1].platform_id = 3;    /* Microsoft */
+    new_cmap_tab[1].encoding_id = 0;    /* Symbol; ignore code page */
+    new_cmap_tab[1].format = 4; /* segment mapping to delta */
+}
+
+static void ttf_write_cmap (void)
+{
+    cmap_entry *ce;
+    long offset;
+    dirtab_entry *tab = ttf_name_lookup ("cmap", true);
+    ttf_select_cmap ();
+    ttf_reset_chksm (tab);
+    (void) put_ushort (0);      /* table version number (0) */
+    (void) put_ushort (NEW_CMAP_SIZE);  /* number of encoding tables */
+    offset = 2 * TTF_USHORT_SIZE + NEW_CMAP_SIZE * CMAP_ENTRY_LENGTH;
+    for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
+        ce->offset = offset;
+        switch (ce->format) {
+        case 0:
+            offset += BYTE_ENCODING_LENGTH;
+            break;
+        case 4:
+            offset += SEG_MAP_DELTA_LENGTH;
+            break;
+        case 6:
+            offset += TRIMMED_TABLE_MAP_LENGTH;
+            break;
+        default:
+            pdftex_fail ("invalid format (it should not have happened)");
+        }
+        (void) put_ushort (ce->platform_id);
+        (void) put_ushort (ce->encoding_id);
+        put_ulong (ce->offset);
+    }
+    for (ce = new_cmap_tab; ce - new_cmap_tab < NEW_CMAP_SIZE; ce++) {
+        switch (ce->format) {
+        case 0:
+            ttf_byte_encoding ();
+            break;
+        case 4:
+            ttf_seg_map_delta ();
+            break;
+        case 6:
+            ttf_trimmed_table_map ();
+            break;
+        }
+    }
+    ttf_set_chksm (tab);
+}
+
+static int prepend_subset_tags (int index, char *p)
+{
+    const boolean is_unicode = (name_tab[index].platform_id == 3);
+    int i;
+    assert (index > 0 && index < name_record_num && fd_cur->subset_tag != NULL);
+    if (is_unicode) {
+        for (i = 0; i < 6; ++i) {
+            *p++ = 0;
+            *p++ = fd_cur->subset_tag[i];
+        }
+        *p++ = 0;
+        *p++ = '+';
+        return 14;
+    } else {
+        strncpy (p, fd_cur->subset_tag, 6);
+        p += 6;
+        *p++ = '+';
+        return 7;
+    }
+}
+
+
+static void ttf_write_name (void)
+{
+    int i, l;
+    char *p;
+    int new_name_buf_size;
+    char *new_name_buf;
+    name_record *n;
+    dirtab_entry *tab = ttf_name_lookup ("name", true);
+    if (is_subsetted (fd_cur->fm)) {
+        l = 0;
+        for (i = 0; i < name_record_num; i++)
+            l += name_tab[i].length + 14;       /* maximum lengh of new stogare area */
+        new_name_buf = xtalloc (l, char);
+        /* additional space for subset tags */
+        p = new_name_buf;
+        for (i = 0; i < name_record_num; i++) {
+            n = name_tab + i;
+            n->new_offset = p - new_name_buf;
+            if ((n->name_id == 1 || n->name_id == 3 ||
+                 n->name_id == 4 || n->name_id == 6) &&
+                ((n->platform_id == 1 && n->encoding_id == 0) ||
+                 (n->platform_id == 3 && n->encoding_id == 0) ||
+                 (n->platform_id == 3 && n->encoding_id == 1))) {
+                l = prepend_subset_tags (i, p);
+                p += l;
+            } else
+                l = 0;
+            memcpy (p, name_buf + n->offset, n->length);
+            p += n->length;
+            n->new_length = n->length + l;
+        }
+        new_name_buf_size = p - new_name_buf;
+    } else {
+        new_name_buf = name_buf;
+        new_name_buf_size = name_buf_size;
+    }
+    ttf_reset_chksm (tab);
+    (void) put_ushort (0);      /* Format selector */
+    (void) put_ushort (name_record_num);
+    (void) put_ushort (3 * TTF_USHORT_SIZE +
+                       name_record_num * 6 * TTF_USHORT_SIZE);
+    for (i = 0; i < name_record_num; i++) {
+        (void) put_ushort (name_tab[i].platform_id);
+        (void) put_ushort (name_tab[i].encoding_id);
+        (void) put_ushort (name_tab[i].language_id);
+        (void) put_ushort (name_tab[i].name_id);
+        (void) put_ushort (name_tab[i].new_length);
+        (void) put_ushort (name_tab[i].new_offset);
+    }
+    for (p = new_name_buf; p - new_name_buf < new_name_buf_size; p++)
+        put_char (*p);
+    ttf_set_chksm (tab);
+    if (new_name_buf != name_buf)
+        xfree (new_name_buf);
+}
+
+static void ttf_write_dirtab (void)
+{
+    dirtab_entry *tab;
+    TTF_ULONG i, k;
+    char *p;
+    const integer save_offset = ttf_offset ();
+    ttf_seek_outbuf (TABDIR_OFF);
+    if (is_subsetted (fd_cur->fm)) {
+        for (i = 0; i < DEFAULT_NTABS; i++) {
+            tab = ttf_name_lookup (newtabnames[i], false);
+            if (tab == NULL)
+                continue;
+            for (k = 0; k < 4; k++)
+                put_char (tab->tag[k]);
+            put_ulong (tab->checksum);
+            put_ulong (tab->offset);
+            put_ulong (tab->length);
+        }
+    } else {
+        for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+            for (k = 0; k < 4; k++)
+                put_char (tab->tag[k]);
+            put_ulong (tab->checksum);
+            put_ulong (tab->offset);
+            put_ulong (tab->length);
+        }
+    }
+    /* adjust checkSumAdjustment */
+    tmp_ulong = 0;
+    checksum = 0;
+    for (p = fb_array, i = 0; i < (unsigned) save_offset;) {
+        tmp_ulong = (tmp_ulong << 8) + *p++;
+        i++;
+        if (i % 4 == 0) {
+            checksum += tmp_ulong;
+            tmp_ulong = 0;
+        }
+    }
+    if (i % 4 != 0) {
+        pdftex_warn ("font length is not a multiple of 4 (%li)", i);
+        checksum <<= 8 * (4 - i % 4);
+    }
+    k = 0xB1B0AFBA - checksum;
+    ttf_seek_outbuf (checkSumAdjustment_offset);
+    put_ulong (k);
+    ttf_seek_outbuf (save_offset);
+}
+
+static void ttf_write_glyf (void)
+{
+    long *id, k;
+    TTF_USHORT idx;
+    TTF_USHORT flags;
+    dirtab_entry *tab = ttf_name_lookup ("glyf", true);
+    const long glyf_offset = tab->offset;
+    const long new_glyf_offset = ttf_offset ();
+    ttf_reset_chksm (tab);
+    for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+        glyph_tab[*id].newoffset = ttf_offset () - new_glyf_offset;
+        if (glyph_tab[*id].offset != glyph_tab[*id + 1].offset) {
+            ttf_seek_off (glyf_offset + glyph_tab[*id].offset);
+            k = copy_short ();
+            ttf_ncopy (4 * TTF_FWORD_SIZE);
+            if (k < 0) {
+                do {
+                    flags = copy_ushort ();
+                    idx = get_ushort ();
+                    if (glyph_tab[idx].newindex < 0) {
+                        glyph_tab[idx].newindex = new_glyphs_count;
+                        glyph_index[new_glyphs_count++] = idx;
+                        /* 
+                           N.B.: Here we change `new_glyphs_count',
+                           which appears in the condition of the `for' loop
+                         */
+                    }
+                    (void) put_ushort (glyph_tab[idx].newindex);
+                    if (flags & ARG_1_AND_2_ARE_WORDS)
+                        ttf_ncopy (2 * TTF_SHORT_SIZE);
+                    else
+                        ttf_ncopy (TTF_USHORT_SIZE);
+                    if (flags & WE_HAVE_A_SCALE)
+                        ttf_ncopy (TTF_F2DOT14_SIZE);
+                    else if (flags & WE_HAVE_AN_X_AND_Y_SCALE)
+                        ttf_ncopy (2 * TTF_F2DOT14_SIZE);
+                    else if (flags & WE_HAVE_A_TWO_BY_TWO)
+                        ttf_ncopy (4 * TTF_F2DOT14_SIZE);
+                } while (flags & MORE_COMPONENTS);
+                if (flags & WE_HAVE_INSTRUCTIONS)
+                    ttf_ncopy (copy_ushort ());
+            } else
+                ttf_ncopy (glyph_tab[*id + 1].offset - glyph_tab[*id].offset -
+                           TTF_USHORT_SIZE - 4 * TTF_FWORD_SIZE);
+        }
+    }
+    last_glyf_offset = ttf_offset () - new_glyf_offset;
+    ttf_set_chksm (tab);
+}
+
+static void ttf_reindex_glyphs(void)
+{
+    ttfenc_entry *e;
+    glyph_entry *glyph;
+    int index;
+    short *t;
+    ttf_cmap_entry *cmap = NULL;
+    boolean cmap_not_found = false;
+
+    /*
+     * reindexing glyphs: we append index of used glyphs to `glyph_index'
+     * while going through `ttfenc_tab'. After appending a new entry to
+     * `glyph_index' we set field `newindex' of corresponding entries in both
+     * `glyph_tab' and `ttfenc_tab' to the newly created index
+     */
+    for (e = ttfenc_tab; e - ttfenc_tab < 256; e++) {
+        e->newindex = 0;        /* index of ".notdef" glyph */
+
+        /* handle case of subfonts first */
+        if (is_subfont(fd_cur->fm)) {
+            if (e->code == -1)
+                continue;
+            assert(fd_cur->fm->pid != -1 && fd_cur->fm->eid != -1);
+            if (cmap == NULL && !cmap_not_found) {
+                cmap =
+                    ttf_read_cmap(fd_cur->fm->ff_name, fd_cur->fm->pid,
+                                  fd_cur->fm->eid, true);
+                if (cmap == NULL)
+                    cmap_not_found = true;
+            }
+            if (cmap == NULL)
+                continue;
+            t = cmap->table;
+            assert(t != NULL && e->code < 0x10000);
+            if (t[e->code] < 0) {
+                pdftex_warn
+                    ("subfont %s: wrong mapping: character %li --> 0x%4.4lX --> .notdef",
+                     fd_cur->fm->tfm_name, (long) (e - ttfenc_tab), e->code);
+                continue;
+            }
+            assert(t[e->code] >= 0 && t[e->code] < glyphs_count);       /* t has been read from ttf */
+            glyph = glyph_tab + t[e->code];
+            goto append_new_glyph;
+        }
+
+        /* handle case of reencoded fonts */
+        if (e->name == notdef)
+            continue;
+        /* scan form `index123' */
+        if (sscanf(e->name, GLYPH_PREFIX_INDEX "%i", &index) == 1) {
+            if (index >= glyphs_count) {
+                pdftex_warn("`%s' out of valid range [0..%i)",
+                            e->name, glyphs_count);
+                continue;
+            }
+            glyph = glyph_tab + index;
+            goto append_new_glyph;
+        }
+        /* scan form `uniABCD' */
+        if (sscanf(e->name, GLYPH_PREFIX_UNICODE "%X", &index) == 1) {
+            if (cmap == NULL && !cmap_not_found) {
+                /* need to read the unicode mapping, ie (pid,eid) = (3,1) or (0,3) */
+                cmap = ttf_read_cmap(fd_cur->fm->ff_name, 3, 1, false);
+                if (cmap == NULL)
+                    cmap = ttf_read_cmap(fd_cur->fm->ff_name, 0, 3, false);
+                if (cmap == NULL) {
+                    pdftex_warn
+                        ("no unicode mapping found, all `uniXXXX' names will be ignored");
+                    cmap_not_found = true;      /* once only */
+                }
+            }
+            if (cmap == NULL)
+                continue;
+            t = cmap->table;
+            assert(t != NULL);
+            if (t[index] != -1) {
+                if (t[index] >= glyphs_count) {
+                    pdftex_warn
+                        ("`%s' is mapped to index %i which is out of valid range [0..%i)",
+                         e->name, t[index], glyphs_count);
+                    continue;
+                }
+                glyph = glyph_tab + t[index];
+                goto append_new_glyph;
+            } else {
+                pdftex_warn("`unicode %s%.4X' is not mapped to any glyph",
+                            GLYPH_PREFIX_UNICODE, index);
+                continue;
+            }
+        }
+        /* look up by name */
+        for (glyph = glyph_tab; glyph - glyph_tab < glyphs_count; glyph++)
+            if (glyph->name != notdef && strcmp(glyph->name, e->name) == 0)
+                break;
+        if (!(glyph - glyph_tab < glyphs_count)) {
+            pdftex_warn("glyph `%s' not found", e->name);
+            continue;
+        }
+      append_new_glyph:
+        assert(glyph > glyph_tab && glyph - glyph_tab < glyphs_count);
+        if (glyph->newindex < 0) {
+		  glyph_index[new_glyphs_count] = (short) (glyph - glyph_tab);
+            glyph->newindex = new_glyphs_count;
+            new_glyphs_count++;
+        }
+        e->newindex = glyph->newindex;
+    }
+}
+
+static void ttf_write_head ()
+{
+    dirtab_entry *tab;
+    tab = ttf_seek_tab ("head", 0);
+    ttf_reset_chksm (tab);
+    ttf_ncopy (2 * TTF_FIXED_SIZE);
+    checkSumAdjustment_offset = ttf_offset ();
+    put_ulong (0);
+    ttf_skip (TTF_ULONG_SIZE);  /* skip checkSumAdjustment */
+    ttf_ncopy (TTF_ULONG_SIZE + 2 * TTF_USHORT_SIZE + 16 +
+               4 * TTF_FWORD_SIZE + 2 * TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+    if (is_subsetted(fd_cur->fm)) {
+        (void) put_short (loca_format);
+        (void) put_short (0);
+    } else
+        ttf_ncopy (2 * TTF_SHORT_SIZE);
+    ttf_set_chksm (tab);
+}
+
+static void ttf_write_hhea (void)
+{
+    dirtab_entry *tab;
+    tab = ttf_seek_tab ("hhea", 0);
+    ttf_reset_chksm (tab);
+    ttf_ncopy (TTF_FIXED_SIZE + 3 * TTF_FWORD_SIZE + TTF_UFWORD_SIZE +
+               3 * TTF_FWORD_SIZE + 8 * TTF_SHORT_SIZE);
+    (void) put_ushort (new_glyphs_count);
+    ttf_set_chksm (tab);
+}
+
+static void ttf_write_htmx (void)
+{
+    long *id;
+    dirtab_entry *tab = ttf_seek_tab ("hmtx", 0);
+    ttf_reset_chksm (tab);
+    for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+        put_ufword (glyph_tab[*id].advWidth);
+        put_ufword (glyph_tab[*id].lsb);
+    }
+    ttf_set_chksm (tab);
+}
+
+static void ttf_write_loca (void)
+{
+    long *id;
+    dirtab_entry *tab = ttf_seek_tab ("loca", 0);
+    ttf_reset_chksm (tab);
+    loca_format = 0;
+    if (last_glyf_offset >= 0x00020000 || (last_glyf_offset & 1))
+        loca_format = 1;
+    else
+        for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+            if (glyph_tab[*id].newoffset & 1) {
+                loca_format = 1;
+                break;
+            }
+    if (loca_format != 0) {
+        for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+            put_ulong (glyph_tab[*id].newoffset);
+        put_ulong (last_glyf_offset);
+    } else {
+        for (id = glyph_index; id - glyph_index < new_glyphs_count; id++)
+            (void) put_ushort (glyph_tab[*id].newoffset / 2);
+        (void) put_ushort (last_glyf_offset / 2);
+    }
+    ttf_set_chksm (tab);
+}
+
+static void ttf_write_mapx (void)
+{
+    dirtab_entry *tab = ttf_seek_tab ("maxp", TTF_FIXED_SIZE + TTF_USHORT_SIZE);
+    ttf_reset_chksm (tab);
+    put_fixed (0x00010000);
+    (void) put_ushort (new_glyphs_count);
+    ttf_ncopy (13 * TTF_USHORT_SIZE);
+    ttf_set_chksm (tab);
+}
+
+static void ttf_write_OS2 (void)
+{
+    dirtab_entry *tab = ttf_seek_tab ("OS/2", 0);
+    TTF_USHORT version;
+    ttf_reset_chksm (tab);
+    version = get_ushort ();
+    if (version > 3)
+        pdftex_fail ("unknown version of OS/2 table (%.4X)", version);
+    (void) put_ushort (0x0001); /* fix version to 1 */
+    ttf_ncopy (2 * TTF_USHORT_SIZE + 13 * TTF_SHORT_SIZE + 10 * TTF_BYTE_SIZE);
+    ttf_skip (4 * TTF_ULONG_SIZE);      /* ulUnicodeRange 1--4 */
+    put_ulong (0x00000003);     /* Basic Latin + Latin-1 Supplement (0x0000--0x00FF) */
+    put_ulong (0x10000000);     /* Private Use (0xE000--0xF8FF) */
+    put_ulong (0x00000000);
+    put_ulong (0x00000000);
+    ttf_ncopy (4 * TTF_CHAR_SIZE + TTF_USHORT_SIZE);    /* achVendID + fsSelection */
+    ttf_skip (2 * TTF_USHORT_SIZE);
+    (void) put_ushort (0x0000); /* usFirstCharIndex */
+    (void) put_ushort (0xF0FF); /* usLastCharIndex */
+    ttf_ncopy (5 * TTF_USHORT_SIZE);
+    /* for version 0 the OS/2 table ends here, the rest is for version 1 */
+    put_ulong (0x80000000);     /* Symbol Character Set---don't use any code page */
+    put_ulong (0x00000000);
+    ttf_set_chksm (tab);
+}
+
+static boolean unsafe_name (char *s)
+{
+    const char **p;
+    for (p = ambiguous_names; *p != NULL; p++)
+        if (strcmp (s, *p) == 0)
+            return true;
+    return false;
+}
+
+static void ttf_write_post (void)
+{
+    dirtab_entry *tab = ttf_seek_tab ("post", TTF_FIXED_SIZE);
+    glyph_entry *glyph;
+    char *s;
+    long *id;
+    int l;
+    ttf_reset_chksm (tab);
+    if (!fd_cur->write_ttf_glyph_names || post_format == 0x00030000) {
+        put_fixed (0x00030000);
+        ttf_ncopy (TTF_FIXED_SIZE + 2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
+    } else {
+        put_fixed (0x00020000);
+        ttf_ncopy (TTF_FIXED_SIZE + 2 * TTF_FWORD_SIZE + 5 * TTF_ULONG_SIZE);
+        (void) put_ushort (new_glyphs_count);
+        k = 0;
+        for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+            glyph = glyph_tab + *id;
+            if (glyph->name_index >= NMACGLYPHS || unsafe_name (glyph->name))
+                glyph->name_index = NMACGLYPHS + k++;
+            (void) put_ushort (glyph->name_index);
+        }
+        for (id = glyph_index; id - glyph_index < new_glyphs_count; id++) {
+            glyph = glyph_tab + *id;
+            if (glyph->name_index >= NMACGLYPHS) {
+                s = glyph->name;
+                l = strlen (s);
+                put_byte (l);
+                while (l-- > 0)
+                    put_char (*s++);
+            }
+        }
+    }
+    ttf_set_chksm (tab);
+}
+
+static void ttf_init_font (int n)
+{
+    int i, k;
+    for (i = 1, k = 0; i <= n; i <<= 1, k++);
+    put_fixed (0x00010000);     /* font version */
+    (void) put_ushort (n);      /* number of tables */
+    (void) put_ushort (i << 3); /* search range */
+    (void) put_ushort (k - 1);  /* entry selector */
+    (void) put_ushort ((n << 4) - (i << 3));    /* range shift */
+    ttf_seek_outbuf (TABDIR_OFF + n * 4 * TTF_ULONG_SIZE);
+}
+
+static void ttf_subset_font (void)
+{
+    ttf_init_font (new_ntabs);
+    if (ttf_name_lookup ("PCLT", false) != NULL)
+        ttf_copytab ("PCLT");
+    if (ttf_name_lookup ("fpgm", false) != NULL)
+        ttf_copytab ("fpgm");
+    if (ttf_name_lookup ("cvt ", false) != NULL)
+        ttf_copytab ("cvt ");
+    if (ttf_name_lookup ("prep", false) != NULL)
+        ttf_copytab ("prep");
+    ttf_reindex_glyphs ();
+    ttf_write_glyf ();
+    ttf_write_loca ();
+    ttf_write_OS2 ();
+    ttf_write_head ();
+    ttf_write_hhea ();
+    ttf_write_htmx ();
+    ttf_write_mapx ();
+    ttf_write_name ();
+    ttf_write_post ();
+    ttf_write_cmap ();
+    ttf_write_dirtab ();
+}
+
+static void ttf_copy_font (void)
+{
+    dirtab_entry *tab;
+    ttf_init_font (ntabs);
+    for (tab = dir_tab; tab - dir_tab < ntabs; tab++) {
+        if (strncmp (tab->tag, "head", 4) == 0)
+            ttf_write_head ();
+        else
+            ttf_copytab (tab->tag);
+    }
+    ttf_write_dirtab ();
+}
+
+void writettf(fd_entry * fd)
+{
+  int callback_id;
+  int file_opened = 0;
+  char *ftemp = NULL;
+    fd_cur = fd;                /* fd_cur is global inside writettf.c */
+    assert(fd_cur->fm != NULL);
+    assert(is_truetype(fd_cur->fm));
+    assert(is_included(fd_cur->fm));
+
+    set_cur_file_name(fd_cur->fm->ff_name);
+
+    if (is_subsetted(fd_cur->fm) && (fd_cur->fe == NULL)
+        && !is_subfont(fd_cur->fm)) {
+        pdftex_warn ("Subset TrueType must be a reencoded or a subfont");
+        cur_file_name = NULL;
+        return;
+    }
+	ttf_curbyte=0;
+	ttf_size=0;
+	callback_id=callback_defined(find_truetype_file_callback);
+	if (callback_id>0) {
+	  if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+		if(ftemp!=NULL&&strlen(ftemp)) {
+		  free(nameoffile);
+		  namelength = strlen(ftemp);
+		  nameoffile = xmalloc(namelength+2);
+		  strcpy((char *)(nameoffile+1),ftemp);
+		  free(ftemp);
+		}
+	  }
+	}
+
+	callback_id=callback_defined(read_truetype_file_callback);
+	if (callback_id>0) {
+	  if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+					 &file_opened, &ttf_buffer,&ttf_size) &&
+		 file_opened && ttf_size>0) {
+	  } else {
+		pdftex_fail ("cannot open TrueType font file for reading");
+	  }
+	} else {
+	  if (!ttf_open ()) {
+        pdftex_fail ("cannot open TrueType font file for reading");
+	  }
+	  ttf_read_file();
+	  ttf_close();
+	}
+    cur_file_name = (char *) nameoffile + 1;
+	if (tracefilenames) {
+	  if (is_subsetted(fd_cur->fm))
+        tex_printf ("<%s", cur_file_name);
+	  else
+        tex_printf ("<<%s", cur_file_name);
+	}
+    fd_cur->ff_found = true;
+    new_glyphs_count = 2;
+    new_ntabs = DEFAULT_NTABS;
+    dir_tab = NULL;
+    glyph_tab = NULL;
+    glyph_index = NULL;
+    glyph_name_buf = NULL;
+    name_tab = NULL;
+    name_buf = NULL;
+    ttf_read_font ();
+
+        pdf_save_offset = pdfoffset ();
+        pdf_flush ();
+
+		if (is_subsetted(fd_cur->fm)) {
+            ttf_copy_encoding ();
+            ttf_subset_font ();
+        } else
+            ttf_copy_font ();
+        ttf_length = ttf_offset ();
+    
+    xfree (dir_tab);
+    xfree (glyph_tab);
+    xfree (glyph_index);
+    xfree (glyph_name_buf);
+    xfree (name_tab);
+    xfree (name_buf);
+	if (tracefilenames) {
+	  if (is_subsetted (fd_cur->fm))
+        tex_printf (">");
+	  else 
+        tex_printf (">>");
+	}
+    cur_file_name = NULL;
+}
+
+void do_writeotf(fd_entry * fd)
+{
+  long i;
+  dirtab_entry *tab;
+  dir_tab = NULL;
+  glyph_tab = NULL;
+  if (tracefilenames)
+    tex_printf ("<<%s", cur_file_name);
+  ttf_read_tabdir ();
+  /* read font parameters */
+  if (ttf_name_lookup ("head", false) != NULL)
+    ttf_read_head ();
+  if (ttf_name_lookup ("hhea", false) != NULL)
+    ttf_read_hhea ();
+  if (ttf_name_lookup ("PCLT", false) != NULL)
+    ttf_read_pclt ();
+  if (ttf_name_lookup ("post", false) != NULL)
+    ttf_read_post ();
+  /* copy font file */
+  tab = ttf_seek_tab ("CFF ", 0);
+  for (i = tab->length; i > 0; i--)
+    copy_char ();
+  xfree (dir_tab);
+  /*    ttf_close ();*/
+  if (tracefilenames)
+    tex_printf (">>");
+}
+
+void writeotf (fd_entry * fd) {
+  int callback_id;
+  int file_opened = 0;
+  char *ftemp = NULL;
+
+  
+  fd_cur = fd;                /* fd_cur is global inside writettf.c */
+  assert(fd_cur->fm != NULL);
+  assert(is_opentype(fd_cur->fm));
+  assert(is_included(fd_cur->fm));
+  
+  set_cur_file_name(fd_cur->fm->ff_name);
+  ttf_curbyte=0;
+  ttf_size=0;
+  callback_id=callback_defined(find_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+      if(ftemp!=NULL&&strlen(ftemp)) {
+	free(nameoffile);
+	namelength = strlen(ftemp);
+	nameoffile = xmalloc(namelength+2);
+	strcpy((char *)(nameoffile+1),ftemp);
+	free(ftemp);
+      }
+    }
+  }
+  callback_id=callback_defined(read_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+		    &file_opened, &ttf_buffer,&ttf_size) &&
+       file_opened && ttf_size>0) {
+    } else {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+  } else {
+    if (!otf_open ()) {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+    ttf_read_file();
+    ttf_close();
+  }
+  
+  cur_file_name = (char *) nameoffile + 1;
+  fd_cur->ff_found = true;
+  do_writeotf(fd);
+  cur_file_name = NULL;
+}
+
+/*
+ To calculate the checkSum for the 'head' table which itself includes the
+   checkSumAdjustment entry for the entire font, do the following:
+
+     * Set the checkSumAdjustment to 0.
+     * Calculate the checksum for all the tables including the 'head' table
+       and enter that value into the table directory.
+     * Calculate the checksum for the entire font.
+     * Subtract that value from the hex value B1B0AFBA.
+     * Store the result in checkSumAdjustment.
+
+   The checkSum for the 'head table which includes the checkSumAdjustment
+   entry for the entire font is now incorrect. That is not a problem. Do not
+   change it. An application attempting to verify that the 'head' table has
+   not changed should calculate the checkSum for that table by not including
+   the checkSumAdjustment value, and compare the result with the entry in the
+   table directory.
+
+   The table directory also includes the offset of the associated tagged
+   table from the beginning of the font file and the length of that table.
+ */
diff --git a/Build/source/texk/web2c/luatexdir/font/writettf.h b/Build/source/texk/web2c/luatexdir/font/writettf.h
new file mode 100644
index 00000000000..ecfaa2c37e3
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writettf.h
@@ -0,0 +1,172 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writettf.h 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+typedef signed char TTF_CHAR;
+typedef unsigned char TTF_BYTE;
+typedef signed short TTF_SHORT;
+typedef unsigned short TTF_USHORT;
+typedef signed long TTF_LONG;
+typedef unsigned long TTF_ULONG;
+typedef unsigned long TTF_FIXED;
+typedef unsigned short TTF_FUNIT;
+typedef signed short TTF_FWORD;
+typedef unsigned short TTF_UFWORD;
+typedef unsigned short TTF_F2DOT14;
+
+#define TTF_CHAR_SIZE    1
+#define TTF_BYTE_SIZE    1
+#define TTF_SHORT_SIZE   2
+#define TTF_USHORT_SIZE  2
+#define TTF_LONG_SIZE    4
+#define TTF_ULONG_SIZE   4
+#define TTF_FIXED_SIZE   4
+#define TTF_FWORD_SIZE   2
+#define TTF_UFWORD_SIZE  2
+#define TTF_F2DOT14_SIZE 2
+
+#define ARG_1_AND_2_ARE_WORDS       (1<<0)
+#define ARGS_ARE_XY_VALUES          (1<<1)
+#define ROUND_XY_TO_GRID            (1<<2)
+#define WE_HAVE_A_SCALE             (1<<3)
+#define RESERVED                    (1<<4)
+#define MORE_COMPONENTS             (1<<5)
+#define WE_HAVE_AN_X_AND_Y_SCALE    (1<<6)
+#define WE_HAVE_A_TWO_BY_TWO        (1<<7)
+#define WE_HAVE_INSTRUCTIONS        (1<<8)
+#define USE_MY_METRICS              (1<<9)
+
+#define get_type(t)     ((t)ttf_getnum(t##_SIZE))
+#define ttf_skip(n)     ttf_getnum(n)
+
+#define get_byte()      get_type(TTF_BYTE)
+#define get_char()      get_type(TTF_CHAR)
+#define get_ushort()    get_type(TTF_USHORT)
+#define get_short()     get_type(TTF_SHORT)
+#define get_ulong()     get_type(TTF_ULONG)
+#define get_long()      get_type(TTF_LONG)
+#define get_fixed()     get_type(TTF_FIXED)
+#define get_funit()     get_type(TTF_FUNIT)
+#define get_fword()     get_type(TTF_FWORD)
+#define get_ufword()    get_type(TTF_UFWORD)
+#define get_f2dot14()   get_type(TTF_F2DOT14)
+
+#define put_num(t,n)    ((t)ttf_putnum(t##_SIZE, n))
+
+#define put_char(n)     (void)put_num(TTF_CHAR, n)
+#define put_byte(n)     (void)put_num(TTF_BYTE, n)
+#define put_short(n)    put_num(TTF_SHORT, n)
+#define put_ushort(n)   put_num(TTF_USHORT, n)
+#define put_long(n)     put_num(TTF_LONG, n)
+#define put_ulong(n)    (void)put_num(TTF_ULONG, n)
+#define put_fixed(n)    (void)put_num(TTF_FIXED, n)
+#define put_funit(n)    put_num(TTF_FUNIT, n)
+#define put_fword(n)    put_num(TTF_FWORD, n)
+#define put_ufword(n)   (void)put_num(TTF_UFWORD, n)
+#define put_f2dot14(n)  put_num(TTF_F2DOT14, n)
+
+#define copy_byte()     put_byte(get_byte())
+#define copy_char()     put_char(get_char())
+#define copy_ushort()   put_ushort(get_ushort())
+#define copy_short()    put_short(get_short())
+#define copy_ulong()    put_ulong(get_ulong())
+#define copy_long()     put_long(get_long())
+#define copy_fixed()    put_fixed(get_fixed())
+#define copy_funit()    put_funit(get_funit())
+#define copy_fword()    put_fword(get_fword())
+#define copy_ufword()   put_ufword(get_ufword())
+#define copy_f2dot14()  put_f2dot14(get_f2dot14())
+
+#define is_unicode_mapping(e) \
+    (e->platform_id == 0 || (e->platform_id == 3 || e->encoding_id == 1))
+
+
+#define NMACGLYPHS      258
+#define TABDIR_OFF      12
+#define ENC_BUF_SIZE    1024
+
+#define GLYPH_PREFIX_INDEX    "index"
+#define GLYPH_PREFIX_UNICODE  "uni"
+
+typedef struct {
+    char tag[4];
+    TTF_ULONG checksum;
+    TTF_ULONG offset;
+    TTF_ULONG length;
+} dirtab_entry;
+
+typedef struct {
+    TTF_USHORT platform_id;
+    TTF_USHORT encoding_id;
+    TTF_ULONG offset;
+    TTF_USHORT format;
+} cmap_entry;
+
+typedef struct {
+    TTF_USHORT endCode;
+    TTF_USHORT startCode;
+    TTF_USHORT idDelta;
+    TTF_USHORT idRangeOffset;
+} seg_entry;
+
+typedef struct {
+    TTF_LONG offset;
+    TTF_LONG newoffset;
+    TTF_UFWORD advWidth;
+    TTF_FWORD lsb;
+    char *name;                 /* name of glyph */
+    TTF_SHORT newindex;         /* new index of glyph in output file */
+    TTF_USHORT name_index;      /* index of name as read from font file */
+} glyph_entry;
+
+/* some functions and variables are used by writetype0.c */
+
+extern fd_entry *fd_cur;        /* pointer to the current font descriptor */
+extern unsigned char *ttf_buffer;
+extern integer ttf_size;
+extern integer ttf_curbyte;
+extern glyph_entry *glyph_tab;
+extern dirtab_entry *dir_tab;
+extern dirtab_entry *ttf_name_lookup (const char *s, boolean required);
+extern dirtab_entry *ttf_seek_tab (const char *name, TTF_LONG offset);
+
+extern void ttf_read_tabdir (void);
+extern void ttf_read_head (void);
+extern void ttf_read_hhea (void);
+extern void ttf_read_pclt (void);
+extern void ttf_read_post (void);
+
+extern FILE *ttf_file;
+
+#define ttf_open()      \
+    open_input(&ttf_file, kpse_truetype_format, FOPEN_RBIN_MODE)
+#define otf_open()      \
+    open_input(&ttf_file, kpse_opentype_format, FOPEN_RBIN_MODE)
+#define ttf_read_file()  \
+    readbinfile(ttf_file,&ttf_buffer,&ttf_size)
+#define ttf_close()      xfclose(ttf_file,cur_file_name)
+#define ttf_getchar()    ttf_buffer[ttf_curbyte++]
+#define ttf_eof()        (ttf_curbyte>ttf_size)
+
+extern long ttf_putnum (int s, long n);
+extern long ttf_getnum (int s);
+
+
diff --git a/Build/source/texk/web2c/luatexdir/font/writetype0.c b/Build/source/texk/web2c/luatexdir/font/writetype0.c
new file mode 100644
index 00000000000..0f9eecaac7c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writetype0.c
@@ -0,0 +1,124 @@
+/*
+Copyright (c) 2007 Taco Hoekwater, taco@luatex.org
+
+This file is part of luaTeX.
+
+luaTeX 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.
+
+luaTeX 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 luaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writetype0.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+#include "writettf.h"
+
+#include "writecff.h"
+
+void writetype0 (fd_entry * fd) {
+  int callback_id;
+  int file_opened = 0;
+  char *ftemp = NULL;
+  long i;
+  dirtab_entry *tab;
+  cff_font *cff;
+  
+  dir_tab = NULL;
+  glyph_tab = NULL;
+  
+  fd_cur = fd;                /* fd_cur is global inside writettf.c */
+  assert(fd_cur->fm != NULL);
+  assert(is_opentype(fd_cur->fm));
+  assert(is_included(fd_cur->fm));
+  
+  set_cur_file_name(fd_cur->fm->ff_name);
+  ttf_curbyte=0;
+  ttf_size=0;
+  callback_id=callback_defined(find_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+      if(ftemp!=NULL&&strlen(ftemp)) {
+	free(nameoffile);
+	namelength = strlen(ftemp);
+	nameoffile = xmalloc(namelength+2);
+	strcpy((char *)(nameoffile+1),ftemp);
+	free(ftemp);
+      }
+    }
+  }
+  callback_id=callback_defined(read_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+		    &file_opened, &ttf_buffer,&ttf_size) &&
+       file_opened && ttf_size>0) {
+    } else {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+  } else {
+    if (!otf_open ()) {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+    ttf_read_file();
+    ttf_close();
+  }
+  
+  cur_file_name = (char *) nameoffile + 1;
+  fd_cur->ff_found = true;
+
+  if (tracefilenames) {
+    if (is_subsetted(fd_cur->fm))
+      tex_printf ("<%s", cur_file_name);
+    else
+      tex_printf ("<<%s", cur_file_name);
+  }
+  ttf_read_tabdir ();
+  /* read font parameters */
+  if (ttf_name_lookup ("head", false) != NULL)
+    ttf_read_head ();
+  if (ttf_name_lookup ("hhea", false) != NULL)
+    ttf_read_hhea ();
+  if (ttf_name_lookup ("PCLT", false) != NULL)
+    ttf_read_pclt ();
+  if (ttf_name_lookup ("post", false) != NULL)
+    ttf_read_post ();
+
+  /* copy font file */
+  tab = ttf_seek_tab ("CFF ", 0);
+
+  /* TODO the next 0 is a subfont index */
+  cff = read_cff(ttf_buffer+ttf_curbyte,tab->length,0);
+  if (cff != NULL) {
+    if (cff_is_cidfont(cff)) {
+      write_cid_cff(cff,fd_cur,0);
+	  /*
+		for (i = tab->length; i > 0; i--)
+		fb_putchar (ttf_getnum(1));
+	  */
+    } else {
+      write_cff(cff,fd_cur,0);
+    }
+  } else {
+    /* not understood, just do a copy */
+    for (i = tab->length; i > 0; i--)
+      fb_putchar (ttf_getnum(1));
+  }
+  xfree (dir_tab);
+  if (tracefilenames) {
+    if (is_subsetted (fd_cur->fm))
+      tex_printf (">");
+    else 
+      tex_printf (">>");
+  }
+  cur_file_name = NULL;
+}
diff --git a/Build/source/texk/web2c/luatexdir/font/writetype2.c b/Build/source/texk/web2c/luatexdir/font/writetype2.c
new file mode 100644
index 00000000000..649c350b707
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/font/writetype2.c
@@ -0,0 +1,422 @@
+
+/*
+Copyright (c) 2007 Taco Hoekwater, taco@luatex.org
+
+This file is part of luaTeX.
+
+luaTeX 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.
+
+luaTeX 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 luaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writetype2.c 1013 2008-02-14 00:09:02Z oneiros $
+*/
+
+#include "ptexlib.h"
+#include "writettf.h"
+#include "writecff.h"
+
+#include "sfnt.h"
+#include "tt_glyf.h"
+
+/* forward*/
+void make_tt_subset (fd_entry * fd,unsigned char *buffer, integer buflen) ;
+
+unsigned long cidtogid_obj = 0;
+
+/* low-level helpers */
+
+#define test_loc(l)					\
+  if ((f->loc+l)>f->buflen) {				\
+    fprintf (stderr,"File ended prematurely\n");	\
+    uexit(1);						\
+  }
+
+
+BYTE   get_unsigned_byte(sfnt* f) {
+  test_loc(1);
+  return (BYTE)f->buffer[(f->loc++)];
+};
+
+ICHAR get_signed_byte(sfnt* f) {
+  test_loc(1);
+  return (ICHAR)f->buffer[(f->loc++)];
+};
+
+USHORT get_unsigned_pair(sfnt* f){
+  USHORT l;
+  test_loc(2);
+  l = f->buffer[(f->loc++)];
+  l = l*0x100 + f->buffer[(f->loc++)];
+  return l;
+};
+
+SHORT  get_signed_pair(sfnt* f){
+  long l;
+  test_loc(2);
+  l = f->buffer[(f->loc++)];
+  if (l>0x80) l -= 0x100;
+  l = l*0x100 + f->buffer[(f->loc++)];
+  return l;
+};
+
+ULONG get_unsigned_quad(sfnt* f){
+  ULONG l;
+  test_loc(4);
+  l = f->buffer[(f->loc++)];
+  l = l*0x100 + f->buffer[(f->loc++)];
+  l = l*0x100 + f->buffer[(f->loc++)];
+  l = l*0x100 + f->buffer[(f->loc++)];
+  return l;
+};
+
+int do_sfnt_read (unsigned char *dest, int len, sfnt *f) {
+  int i;
+  test_loc(len);
+  for (i=0;i<len;i++) {
+    *(dest+i)=f->buffer[f->loc+i];
+  }
+  f->loc += len;
+  return len;
+};
+
+pdf_obj *pdf_new_stream(void) {
+  pdf_obj *stream = xmalloc(sizeof(pdf_obj)) ;
+  stream->length =0; 
+  stream->data=NULL;
+  return stream;
+};
+
+void pdf_add_stream(pdf_obj *stream, unsigned char *buf, long len) {
+  int i;
+  assert (stream!=NULL);
+  if (stream->data==NULL) {
+    stream->data = xmalloc(len);
+  } else {
+    stream->data = xrealloc(stream->data,len+stream->length);
+  }
+  for (i=0;i<len;i++) {
+    *(stream->data+stream->length+i)=*(buf+i);
+  }
+  stream->length+=len;
+};
+
+void pdf_release_obj(pdf_obj *stream) {
+  if (stream!=NULL) {
+    if (stream->data!=NULL) {
+      xfree(stream->data);
+    }
+    xfree(stream);
+  }
+};
+
+
+void
+writetype2 (fd_entry * fd) {
+  int callback_id;
+  int file_opened = 0;
+  char *ftemp = NULL;
+
+  glyph_tab = NULL;
+  
+  fd_cur = fd;                /* fd_cur is global inside writettf.c */
+  assert(fd_cur->fm != NULL);
+  assert(is_truetype(fd_cur->fm));
+  
+  if (!is_subsetted(fd_cur->fm)) {
+    writettf(fd);
+    return;
+  }
+  
+  assert(is_included(fd_cur->fm));
+
+  set_cur_file_name(fd_cur->fm->ff_name);
+  ttf_curbyte=0;
+  ttf_size=0;
+  callback_id=callback_defined(find_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->S",(char *)(nameoffile+1),&ftemp)) {
+      if(ftemp!=NULL&&strlen(ftemp)) {
+	free(nameoffile);
+	namelength = strlen(ftemp);
+	nameoffile = xmalloc(namelength+2);
+	strcpy((char *)(nameoffile+1),ftemp);
+	free(ftemp);
+      }
+    }
+  }
+  callback_id=callback_defined(read_opentype_file_callback);
+  if (callback_id>0) {
+    if(run_callback(callback_id,"S->bSd",(char *)(nameoffile+1),
+		    &file_opened, &ttf_buffer,&ttf_size) &&
+       file_opened && ttf_size>0) {
+    } else {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+  } else {
+    if (!otf_open ()) {
+      pdftex_fail ("cannot open OpenType font file for reading");
+    }
+    ttf_read_file();
+    ttf_close();
+  }
+  
+  cur_file_name = (char *) nameoffile + 1;
+  fd_cur->ff_found = true;
+
+  if (tracefilenames) {
+    if (is_subsetted(fd_cur->fm))
+      tex_printf ("<%s", cur_file_name);
+    else
+      tex_printf ("<<%s", cur_file_name);
+  }
+
+  /* here is the real work */
+
+  make_tt_subset(fd,ttf_buffer,ttf_size);
+
+  /*xfree (dir_tab);*/
+  if (tracefilenames) {
+    if (is_subsetted (fd_cur->fm))
+      tex_printf (">");
+    else 
+      tex_printf (">>");
+  }
+  cur_file_name = NULL;
+}
+
+/*
+ * PDF viewer applications use following tables (CIDFontType 2)
+ *
+ *  head, hhea, loca, maxp, glyf, hmtx, fpgm, cvt_, prep
+ *
+ *                                         - from PDF Ref. v.1.3, 2nd ed.
+ *
+ * The fpgm, cvt_, and prep tables appears only when TrueType instructions
+ * requires them. Those tables must be preserved if they exist.
+ * We use must_exist flag to indicate `preserve it if present'
+ * and to make sure not to cause an error when it does not exist.
+ *
+ * post and name table must exist in ordinary TrueType font file,
+ * but when a TrueType font is converted to CIDFontType 2 font, those tables
+ * are no longer required.
+ *
+ * The OS/2 table (required for TrueType font for Windows and OS/2) contains
+ * liscencing information, but PDF viewers seems not using them.
+ *
+ * The 'name' table added. See comments in ttf.c.
+ */
+
+static struct
+{
+  const char *name;
+  int         must_exist;
+} required_table[] = {
+  {"OS/2", 0}, {"head", 1}, {"hhea", 1}, {"loca", 1}, {"maxp", 1},
+  {"name", 1}, {"glyf", 1}, {"hmtx", 1}, {"fpgm", 0}, {"cvt ", 0},
+  {"prep", 0}, {NULL, 0}
+};
+
+
+unsigned long ttc_read_offset (sfnt *sfont, int ttc_idx)
+{
+  long version;
+  unsigned long offset = 0;
+  unsigned long num_dirs = 0;
+
+  sfnt_seek_set (sfont, 4); /* skip version tag */
+
+  version = sfnt_get_ulong(sfont);
+  num_dirs = sfnt_get_ulong(sfont);
+  if (ttc_idx < 0 || ttc_idx > num_dirs - 1) {
+    fprintf(stderr,"Invalid TTC index number\n");
+    uexit(1);
+  }
+
+  sfnt_seek_set (sfont, 12 + ttc_idx * 4);
+  offset = sfnt_get_ulong (sfont);
+
+  return offset;
+}
+
+extern int ff_get_ttc_index(char *ffname, char*psname);
+
+void make_tt_subset (fd_entry * fd,unsigned char *buffer, integer buflen) {
+
+  long i, cid;
+  unsigned int last_cid;
+  glw_entry *glyph, *found;
+  struct avl_traverser t;
+  unsigned char *cidtogidmap ;
+  unsigned short num_glyphs, gid;
+  struct tt_glyphs *glyphs;
+  char *used_chars;
+  sfnt *sfont;
+  pdf_obj *fontfile;
+  int verbose = 0, error = 0;
+  
+  cidtogidmap = NULL;
+
+  sfont = sfnt_open(buffer, buflen);
+
+  if (sfont->type == SFNT_TYPE_TTC) {
+	i = ff_get_ttc_index(fd->fm->ff_name,fd->fm->ps_name);
+    error = sfnt_read_table_directory(sfont, ttc_read_offset(sfont, i));
+  } else {
+	error = sfnt_read_table_directory(sfont, 0);
+  }
+
+  if (error  < 0) {
+    fprintf(stderr,"Could not parse the ttf directory.\n");
+    uexit(1);
+  }
+
+  glyphs = tt_build_init();
+
+  last_cid   = 0;
+  num_glyphs = 1; /* .notdef */
+
+  glyph = xtalloc(1,glw_entry);
+
+  avl_t_init(&t, fd->gl_tree);
+  for (found = (glw_entry *) avl_t_first(&t, fd->gl_tree); 
+       found != NULL; 
+       found = (glw_entry *) avl_t_next(&t)) {
+    if (found->id > last_cid)
+      last_cid = found->id;
+  }
+  
+#ifndef NO_GHOSTSCRIPT_BUG
+  cidtogidmap = NULL;
+#else
+  cidtogidmap = xmalloc(((last_cid + 1) * 2) * sizeof(unsigned char));
+  memset(cidtogidmap, 0, (last_cid + 1) * 2);
+#endif
+
+  /* fill used_chars */
+  used_chars = xmalloc((last_cid + 1) * sizeof(char));
+  memset(used_chars, 0, (last_cid + 1));		       
+  avl_t_init(&t, fd->gl_tree);
+  for (found = (glw_entry *) avl_t_first(&t, fd->gl_tree); 
+       found != NULL; 
+       found = (glw_entry *) avl_t_next(&t)) {
+    used_chars[found->id] = 1;
+  }
+
+  /*
+   * Map CIDs to GIDs.
+   */
+
+  num_glyphs = 1; /* .notdef */
+  for (cid = 1; cid <= last_cid; cid++) {
+    if (used_chars[cid]==0)
+      continue;
+    gid = cid;
+
+
+#ifndef NO_GHOSTSCRIPT_BUG
+      gid = tt_add_glyph(glyphs, gid, cid);
+#else
+      gid = tt_add_glyph(glyphs, gid, num_glyphs);
+      cidtogidmap[2*cid  ] = gid >> 8;
+      cidtogidmap[2*cid+1] = gid & 0xff;
+#endif /* !NO_GHOSTSCRIPT_BUG */
+    
+    num_glyphs++;
+  }
+
+  if (num_glyphs==1) {
+    fprintf(stderr,"No glyphs in subset?.\n");
+    uexit(1);
+  }
+
+  if (tt_build_tables(sfont, glyphs) < 0) {
+    fprintf(stderr,"Could not parse the ttf buffer.\n");
+    uexit(1);
+  }
+  
+  if (verbose > 1) {
+    fprintf(stdout,"[%u glyphs (Max CID: %u)]", glyphs->num_glyphs, last_cid);
+  }
+
+  tt_build_finish(glyphs);
+
+  /* Create font file */
+
+  for (i = 0; required_table[i].name; i++) {
+    if (sfnt_require_table(sfont,
+			   required_table[i].name,
+			   required_table[i].must_exist) < 0) {
+      fprintf(stderr,"Some required TrueType table does not exist.");
+      uexit(1);
+    }
+  }
+
+  fontfile = sfnt_create_FontFile_stream(sfont);
+
+  if (verbose > 1) {
+    fprintf(stdout,"[%ld bytes]", fontfile->length);
+  }
+
+  /* squeeze in the cidgidmap */
+  if (cidtogidmap!=NULL) {
+    cidtogid_obj = pdf_new_objnum();
+    pdf_begin_dict(cidtogid_obj, 0);
+    pdf_printf("/Length %i\n",((last_cid + 1) * 2));
+    pdf_end_dict();
+    pdf_printf("stream\n");
+    pdfroom ((last_cid + 1) * 2);
+    for (i = 0; i<((last_cid + 1) * 2); i++ ) {
+      pdf_buf[pdf_ptr++] = cidtogidmap[i];
+    }
+    pdf_printf("\nendstream\n");
+  }
+
+  /* the tff subset */
+  for (i = 0; i<fontfile->length; i++ )
+    fb_putchar (fontfile->data[i]);
+
+  
+  /* other stuff that needs fixing: */
+
+  /*
+   * DW, W, DW2, and W2
+   */
+  /*
+   if (opt_flags & CIDFONT_FORCE_FIXEDPITCH) {
+     pdf_add_dict(font->fontdict,
+ 		 pdf_new_name("DW"), pdf_new_number(1000.0));
+   } else {
+     add_TTCIDHMetrics(font->fontdict, glyphs, used_chars, cidtogidmap, last_cid);
+      if (v_used_chars)
+       add_TTCIDVMetrics(font->fontdict, glyphs, used_chars, cidtogidmap, last_cid);
+   }
+  */
+
+  /*
+   * CIDSet
+   */
+  /*
+  {
+    pdf_obj *cidset;
+
+    cidset = pdf_new_stream(STREAM_COMPRESS);
+    pdf_add_stream(cidset, used_chars, last_cid/8 + 1);
+    pdf_add_dict(font->descriptor,
+		 pdf_new_name("CIDSet"),
+		 pdf_ref_obj(cidset));
+    pdf_release_obj(cidset);
+  }
+  */
+
+  return;
+}
diff --git a/Build/source/texk/web2c/luatexdir/hyphen.h b/Build/source/texk/web2c/luatexdir/hyphen.h
new file mode 100644
index 00000000000..f665c7605b9
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/hyphen.h
@@ -0,0 +1,60 @@
+/* LibHnj is dual licensed under LGPL and MPL. Boilerplate for both
+ * licenses follows.
+ */
+
+/* LibHnj - a library for high quality hyphenation and justification
+ * Copyright (C) 1998 Raph Levien, (C) 2001 ALTLinux, Moscow
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, write to the 
+ * Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+ * Boston, MA  02111-1307  USA.
+*/
+
+/*
+ * The contents of this file are subject to the Mozilla Public License
+ * Version 1.0 (the "MPL"); you may not use this file except in
+ * compliance with the MPL.  You may obtain a copy of the MPL at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the MPL is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the MPL
+ * for the specific language governing rights and limitations under the
+ * MPL.
+ *
+ */
+#ifndef __HYPHEN_H__
+#define __HYPHEN_H__
+
+#ifdef __cplusplus
+extern "C" {
+#endif /* __cplusplus */
+
+typedef struct _HyphenDict HyphenDict;
+
+#include "ptexlib.h"
+#include "nodes.h"
+
+HyphenDict* hnj_hyphen_new();
+void hnj_hyphen_load(HyphenDict*dict, const unsigned char *fn);
+void hnj_hyphen_free (HyphenDict *dict);
+void hnj_hyphen_clear (HyphenDict *dict);
+void hnj_hyphen_hyphenate (HyphenDict *dict, halfword first, halfword last, int size, halfword left, halfword right, lang_variables*lan);
+unsigned char* hnj_serialize(HyphenDict*);
+void hnj_free_serialize(unsigned char*);
+
+#ifdef __cplusplus
+}
+#endif /* __cplusplus */
+
+#endif /* __HYPHEN_H__ */
diff --git a/Build/source/texk/web2c/luatexdir/image/.indent.pro b/Build/source/texk/web2c/luatexdir/image/.indent.pro
new file mode 100644
index 00000000000..e9e690f1ba8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/.indent.pro
@@ -0,0 +1,12 @@
+/* $Id$ */
+--k-and-r-style
+--blank-lines-after-procedures
+--line-length 80
+--procnames-start-lines
+--no-space-after-function-call-names
+--dont-break-procedure-type
+--space-after-cast
+/* this does not work in indent 2.2.6 :-( */
+--no-tabs
+/* this is new in indent 2.2.9 */
+--preprocessor-indentation 2
diff --git a/Build/source/texk/web2c/luatexdir/image/epdf.c b/Build/source/texk/web2c/luatexdir/image/epdf.c
new file mode 100644
index 00000000000..071181f17bd
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/epdf.c
@@ -0,0 +1,107 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: epdf.c 1012 2008-02-14 00:00:57Z oneiros $
+*/
+
+#include "ptexlib.h"
+
+
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/c-proto.h>
+#include <string.h>
+
+extern void epdf_check_mem(void);
+extern void register_fd_entry(fd_entry *);
+
+
+int is_subsetable(fm_entry * fm)
+{
+    assert(is_included(fm));
+    return is_subsetted(fm);
+}
+
+fd_entry *epdf_create_fontdescriptor(fm_entry * fm)
+{
+    fd_entry *fd;
+    if ((fd = lookup_fd_entry(fm->ff_name, fm->slant, fm->extend)) == NULL) {
+        fm->in_use = true;
+        fd = new_fd_entry();
+        fd->fm = fm;
+        register_fd_entry(fd);
+        fd->fd_objnum = pdf_new_objnum();
+        assert(fm->ps_name != NULL);
+        fd->fontname = xstrdup(fm->ps_name);    /* just fallback */
+        /* preset_fontmetrics (fo->fd, f); */
+        fd->gl_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
+        assert(fd->gl_tree != NULL);
+    }
+    return fd;
+}
+
+integer get_fd_objnum(fd_entry * fd)
+{
+    assert(fd->fd_objnum != 0);
+    return fd->fd_objnum;
+}
+
+integer get_fn_objnum(fd_entry * fd)
+{
+    if (fd->fn_objnum == 0)
+        fd->fn_objnum = pdf_new_objnum();
+    return fd->fn_objnum;
+}
+
+/***********************************************************************
+ * Mark glyphs used by embedded PDF file:
+ * 1. build fontdescriptor, if not yet existing
+ * 2. mark glyphs directly there
+ *
+ * Input charset from xpdf is a string of glyph names including
+ * leading slashes, but without blanks between them, like: /a/b/c
+***********************************************************************/
+
+void epdf_mark_glyphs(fd_entry * fd, char *charset)
+{
+    char *p, *q, *s;
+    char *glyph;
+    void **aa;
+    if (charset == NULL)
+        return;
+    assert(fd != NULL);
+    for (s = charset + 1, q = charset + strlen(charset); s < q; s = p + 1) {
+        for (p = s; *p != '\0' && *p != '/'; p++);
+        *p = '\0';
+        if ((char *) avl_find(fd->gl_tree, s) == NULL) {
+            glyph = xstrdup(s);
+            aa = avl_probe(fd->gl_tree, glyph);
+            assert(aa != NULL);
+        }
+    }
+}
+
+void embed_whole_font(fd_entry * fd)
+{
+    fd->all_glyphs = true;
+}
+
+void epdf_free(void)
+{
+    epdf_check_mem();
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/epdf.h b/Build/source/texk/web2c/luatexdir/image/epdf.h
new file mode 100644
index 00000000000..2359d53d3db
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/epdf.h
@@ -0,0 +1,125 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: epdf.h 1031 2008-02-14 23:03:20Z hhenkel $
+*/
+
+extern "C" {
+
+#include <kpathsea/c-auto.h>
+
+    extern char *xstrdup(const char *);
+
+/* the following code is extremly ugly but needed for including web2c/config.h */
+
+#include <kpathsea/c-proto.h>   /* define P?H macros */
+
+    typedef const char *const_string;   /* including kpathsea/types.h doesn't work on some systems */
+
+#define KPATHSEA_CONFIG_H       /* avoid including other kpathsea header files */
+    /* from web2c/config.h */
+
+#ifdef CONFIG_H                 /* CONFIG_H has been defined by some xpdf */
+#  undef CONFIG_H               /* header file */
+#endif
+
+#include <web2c/c-auto.h>       /* define SIZEOF_LONG */
+#include <web2c/config.h>       /* define type integer */
+
+#include <web2c/luatexdir/ptexmac.h>
+#include "openbsd-compat.h"
+#include "image.h"
+
+/* #-define pdfbufsize      pdfbufmax */
+
+    extern integer epdf_page_box;
+    extern void *epdf_xref;
+
+    extern integer pdf_box_spec_media;
+    extern integer pdf_box_spec_crop;
+    extern integer pdf_box_spec_bleed;
+    extern integer pdf_box_spec_trim;
+    extern integer pdf_box_spec_art;
+
+    extern integer pdf_stream_length;
+    extern integer pdf_ptr;
+    extern integer pool_ptr;
+    typedef unsigned char eight_bits;
+    extern eight_bits *pdf_buf;
+    extern integer pdf_buf_size;
+    extern integer pdf_os_mode;
+    extern eight_bits pdf_last_byte;
+
+    extern char notdef[];
+
+    extern integer fixed_replace_font;
+
+    extern int is_subsetable(struct fm_entry *);
+    extern struct fm_entry *lookup_fontmap(char *);
+    extern integer get_fontfile(struct fm_entry *);
+    extern integer get_fontname(struct fm_entry *);
+    extern integer pdf_new_objnum(void);
+    extern void read_pdf_info(image_dict *, integer, integer);
+    extern void embed_whole_font(struct fd_entry *);
+    extern void epdf_check_mem(void);
+    extern void epdf_delete(image_dict *);
+    extern void epdf_free(void);
+    __attribute__ ((format(printf, 1, 2)))
+    extern void pdf_printf(const char *fmt, ...);
+    extern void pdf_puts(const char *);
+    extern void pdf_begin_stream(void);
+    extern void pdf_end_obj(void);
+    extern void pdf_end_stream(void);
+    extern void pdf_flush(void);
+    __attribute__ ((noreturn, format(printf, 1, 2)))
+    extern void pdftex_fail(const char *fmt, ...);
+    __attribute__ ((format(printf, 1, 2)))
+    extern void pdftex_warn(const char *fmt, ...);
+    __attribute__ ((format(printf, 1, 2)))
+    extern void tex_printf(const char *, ...);
+    extern void write_epdf(image_dict *);
+    extern void zpdf_begin_dict(integer, bool);
+    extern void zpdf_begin_obj(integer, bool);
+    extern void zpdf_create_obj(integer, integer);
+    extern void zpdf_new_dict(integer, integer, bool);
+    extern void zpdf_os_get_os_buf(integer);
+
+/* epdf.c */
+    extern void epdf_mark_glyphs(struct fd_entry *, char *);
+    extern struct fd_entry *epdf_create_fontdescriptor(struct fm_entry *);
+    extern int get_fd_objnum(struct fd_entry *);
+    extern int get_fn_objnum(struct fd_entry *);
+
+/* write_enc.c */
+    extern void epdf_write_enc(char **, integer);
+
+/* write_enc.c */
+    extern pdf_img_struct *new_pdf_img_struct(void);
+
+/* utils.c */
+    extern char *convertStringToPDFString(char *in, int len);
+    extern char *stripzeros(char *a);
+
+/* config.c */
+    extern integer cfgpar(integer);
+
+/* avlstuff.c */
+    extern void avl_put_obj(integer, integer);
+    extern integer avl_find_obj(integer, integer, integer);
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/image.h b/Build/source/texk/web2c/luatexdir/image/image.h
new file mode 100644
index 00000000000..cf7d4f0dd88
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/image.h
@@ -0,0 +1,223 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: image.h 1100 2008-03-09 13:40:48Z hhenkel $
+*/
+
+#ifndef IMAGE_H
+#  define IMAGE_H
+
+#  include <../libpng/png.h>
+
+#  define JPG_UINT16      unsigned int
+#  define JPG_UINT32      unsigned long
+#  define JPG_UINT8       unsigned char
+
+#  define IMAGE_COLOR_B   1
+#  define IMAGE_COLOR_C   2
+#  define IMAGE_COLOR_I   4
+
+extern integer zround(double);  /* from zround.c */
+#  define bp2int(p)       zround(p * (one_hundred_bp / 100.0))
+
+#  define TYPE_IMG        "image"
+#  define TYPE_IMG_DICT   "image-dict"
+
+#  define scaled          integer
+
+/**********************************************************************/
+
+typedef struct {
+    float width;
+    float height;
+    float orig_x;
+    float orig_y;
+    void *doc;
+} pdf_img_struct;
+
+typedef struct {
+    png_structp png_ptr;
+    png_infop info_ptr;
+} png_img_struct;
+
+typedef struct {
+    int color_space;            /* used color space. See JPG_ constants */
+    JPG_UINT32 length;          /* length of file/data */
+} jpg_img_struct;
+
+typedef struct {                /* currently unused */
+} jb2_img_struct;
+
+typedef enum { DICT_NEW,        /* fresh dictionary */
+    DICT_FILESCANNED,           /* image file scanned */
+    DICT_REFERED,               /* pdf_refximage_node in node list --> read-only dict */
+    DICT_OUTIMG,                /* /Im* appears in pagestream */
+    DICT_SCHEDULED,             /* image dict scheduled for writing */
+    DICT_WRITTEN                /* image dict written to file */
+} dict_state;
+
+typedef enum { IMAGE_TYPE_NONE, IMAGE_TYPE_PDF, IMAGE_TYPE_PNG, IMAGE_TYPE_JPG,
+    IMAGE_TYPE_JBIG2, IMAGE_TYPE_SENTINEL
+} imgtype_e;
+
+typedef enum { IMG_KEEPOPEN, IMG_CLOSEINBETWEEN } img_readtype_e;
+
+typedef enum { PDF_BOX_SPEC_NONE, PDF_BOX_SPEC_MEDIA, PDF_BOX_SPEC_CROP,
+    PDF_BOX_SPEC_BLEED, PDF_BOX_SPEC_TRIM, PDF_BOX_SPEC_ART,
+    PDF_BOX_SPEC_SENTINEL
+} pdfboxspec_e;
+
+/**********************************************************************/
+
+typedef struct {
+    integer objnum;
+    integer index;              /* /Im1, /Im2, ... */
+    integer x_size;             /* dimensions in pixel counts as in JPG/PNG/JBIG2 file */
+    integer y_size;
+    integer x_res;              /* pixel resolution as in JPG/PNG/JBIG2 file */
+    integer y_res;
+    integer colorspace;         /* number of /ColorSpace object */
+    integer total_pages;
+    integer page_num;           /* requested page (by number) */
+    char *pagename;             /* requested page (by name) */
+    char *filename;             /* requested raw file name */
+    char *filepath;             /* full file path after kpathsea */
+    char *attr;                 /* additional image dict entries */
+    FILE *file;
+    imgtype_e image_type;
+    int color_space;            /* used color space. See JPG_ constants */
+    int color_depth;            /* color depth */
+    pdfboxspec_e page_box_spec; /* PDF page box spec.: media/crop/bleed/trim/art */
+    dict_state state;
+    union {
+        pdf_img_struct *pdf;
+        png_img_struct *png;
+        jpg_img_struct *jpg;
+        jb2_img_struct *jb2;
+    } img_struct;
+} image_dict;
+
+#  define img_objnum(N)         ((N)->objnum)
+#  define img_index(N)          ((N)->index)
+#  define img_xsize(N)          ((N)->x_size)
+#  define img_ysize(N)          ((N)->y_size)
+#  define img_xres(N)           ((N)->x_res)
+#  define img_yres(N)           ((N)->y_res)
+#  define img_colorspace(N)     ((N)->colorspace)
+#  define img_totalpages(N)     ((N)->total_pages)
+#  define img_pagenum(N)        ((N)->page_num)
+#  define img_pagename(N)       ((N)->pagename)
+#  define img_filename(N)       ((N)->filename)
+#  define img_filepath(N)       ((N)->filepath)
+#  define img_attr(N)           ((N)->attr)
+#  define img_file(N)           ((N)->file)
+#  define img_type(N)           ((N)->image_type)
+#  define img_color(N)          ((N)->color_space)
+#  define img_colordepth(N)     ((N)->color_depth)
+#  define img_pagebox(N)        ((N)->page_box_spec)
+#  define img_state(N)          ((N)->state)
+
+#  define img_pdf_ptr(N)        ((N)->img_struct.pdf)
+#  define img_pdf_width(N)      ((N)->img_struct.pdf->width)
+#  define img_pdf_height(N)     ((N)->img_struct.pdf->height)
+#  define img_pdf_orig_x(N)     ((N)->img_struct.pdf->orig_x)
+#  define img_pdf_orig_y(N)     ((N)->img_struct.pdf->orig_y)
+#  define img_pdf_doc(N)        ((N)->img_struct.pdf->doc)
+
+#  define img_png_ptr(N)        ((N)->img_struct.png)
+#  define img_png_png_ptr(N)    ((N)->img_struct.png->png_ptr)
+#  define img_png_info_ptr(N)   ((N)->img_struct.png->info_ptr)
+
+#  define img_jpg_ptr(N)        ((N)->img_struct.jpg)
+#  define img_jpg_color(N)      ((N)->img_struct.jpg->color_space)
+
+#  define img_jb2_ptr(N)        ((N)->img_struct.jb2)
+
+/**********************************************************************/
+
+typedef struct {
+    integer width;              /* requested/actual TeX dimensions */
+    integer height;
+    integer depth;
+    integer transform;
+    integer flags;
+    image_dict *dict;
+    int dict_ref;               /* luaL_ref() reference */
+} image;
+
+#  define img_width(N)          ((N)->width)
+#  define img_height(N)         ((N)->height)
+#  define img_depth(N)          ((N)->depth)
+#  define img_transform(N)      ((N)->transform)
+#  define img_flags(N)          ((N)->flags)
+#  define img_dict(N)           ((N)->dict)
+#  define img_dictref(N)        ((N)->dict_ref)
+
+#  define F_FLAG_SCALED         0x01
+#  define F_FLAG_REFERED        0x02
+
+#  define img_flags(N)          ((N)->flags)
+#  define img_set_scaled(N)     (img_flags(N) |= F_FLAG_SCALED)
+#  define img_set_refered(N)    (img_flags(N) |= F_FLAG_REFERED)
+#  define img_unset_scaled(N)   (img_flags(N) &= ~F_FLAG_SCALED)
+#  define img_unset_refered(N)  (img_flags(N) &= ~F_FLAG_REFERED)
+#  define img_is_scaled(N)      ((img_flags(N) & F_FLAG_SCALED) != 0)
+#  define img_is_refered(N)     ((img_flags(N) & F_FLAG_REFERED) != 0)
+
+#  define set_wd_running(N)     (img_width(N) = null_flag)
+#  define set_ht_running(N)     (img_height(N) = null_flag)
+#  define set_dp_running(N)     (img_depth(N) = null_flag)
+#  define is_wd_running(N)      (img_width(N) == null_flag)
+#  define is_ht_running(N)      (img_height(N) == null_flag)
+#  define is_dp_running(N)      (img_depth(N) == null_flag)
+
+/**********************************************************************/
+
+/* writeimg.c */
+
+image *new_image();
+image_dict *new_image_dict();
+void init_image(image *);
+void init_image_dict(image_dict *);
+void scale_img(image *);
+integer img_to_array(image *);
+void delete_image(image *);
+void free_image_dict(image_dict * p);
+void read_img(image_dict *, integer, integer);
+
+/* writepng.c */
+
+#  ifndef boolean               /* TODO: from where to get the original definition? */
+#    define boolean int
+#  endif
+
+void read_png_info(image_dict *, img_readtype_e);
+void read_jpg_info(image_dict *, img_readtype_e);
+void read_jbig2_info(image_dict *);
+void read_pdf_info(image_dict *, integer, integer);
+void write_img(image_dict *);
+void write_png(image_dict *);
+void write_jpg(image_dict *);
+void write_jbig2(image_dict *);
+void write_epdf(image_dict *);
+
+/* pdftoepdf.cc */
+
+void epdf_delete(image_dict * idict);
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/image/pdftoepdf.cc b/Build/source/texk/web2c/luatexdir/image/pdftoepdf.cc
new file mode 100644
index 00000000000..c5270eb58bd
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/pdftoepdf.cc
@@ -0,0 +1,1008 @@
+/*
+Copyright 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: pdftoepdf.cc 1058 2008-02-19 21:13:58Z hhenkel $
+*/
+
+#include <stdlib.h>
+#include <math.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <aconf.h>
+#include <GString.h>
+#include <gmem.h>
+#include <gfile.h>
+#include <config.h>
+#include <assert.h>
+#include "Object.h"
+#include "Stream.h"
+#include "Array.h"
+#include "Dict.h"
+#include "XRef.h"
+#include "Catalog.h"
+#include "Link.h"
+#include "Page.h"
+#include "GfxFont.h"
+#include "PDFDoc.h"
+#include "GlobalParams.h"
+#include "Error.h"
+
+#include "epdf.h"
+
+#define one_hundred_bp  6578176 /* 7227 * 65536 / 72 */
+
+// This file is mostly C and not very much C++; it's just used to interface
+// the functions of xpdf, which happens to be written in C++.
+
+// Used flags below:
+//   PDFTEX_COPY_PAGEGROUP
+//     If pdfTeX should copy a page group (a new feature in PDF 1.4 for
+//     transparency) of an included file. The current support for this is
+//     most likely broken. pdfTeX will at least give a warning if this flag
+//     is not set. Surprisingly Acrobat and Jaws display files without a
+//     page group correctly, so it might be safe to not set the flag.
+//     See also PDFTEX_COPY_PAGEGROUP_NOFAIL.
+//   PDFTEX_COPY_PAGEGROUP_NOFAIL
+//     If set to false, pdfTeX will treat a page group in an included file
+//     as an error and abort gracefully. This is only evaluated if
+//     PDFTEX_COPY_PAGEGROUP is set.
+
+// The prefix "PTEX" for the PDF keys is special to pdfTeX;
+// this has been registered with Adobe by Hans Hagen.
+
+#define pdfkeyprefix "PTEX"
+
+// PdfObject encapsulates the xpdf Object type,
+// and properly frees its resources on destruction.
+// Use obj-> to access members of the Object,
+// and &obj to get a pointer to the object.
+// It is no longer necessary to call Object::free explicitely.
+
+class PdfObject {
+  public:
+    PdfObject() {               // nothing
+    } ~PdfObject() {
+        iObject.free();
+    }
+    Object *operator->() {
+        return &iObject;
+    }
+    Object *operator&() {
+        return &iObject;
+    }
+  private:                     // no copying or assigning
+    PdfObject(const PdfObject &);
+    void operator=(const PdfObject &);
+  public:
+    Object iObject;
+};
+
+// When copying the Resources of the selected page, all objects are copied
+// recusively top-down. Indirect objects however are not fetched during
+// copying, but get a new object number from pdfTeX and then will be
+// appended into a linked list. Duplicates are checked and removed from the
+// list of indirect objects during appending.
+
+enum InObjType {
+    objFont,
+    objFontDesc,
+    objOther
+};
+
+struct InObj {
+    Ref ref;                    // ref in original PDF
+    InObjType type;             // object type
+    InObj *next;                // next entry in list of indirect objects
+    integer num;                // new object number in output PDF
+    fd_entry *fd;               // pointer to /FontDescriptor object structure
+    integer enc_objnum;         // Encoding for objFont
+    int written;                // has it been written to output PDF?
+};
+
+struct UsedEncoding {
+    integer enc_objnum;
+    GfxFont *font;
+    UsedEncoding *next;
+};
+
+static InObj *inObjList;
+static UsedEncoding *encodingList;
+static GBool isInit = gFalse;
+
+// --------------------------------------------------------------------
+// Maintain list of open embedded PDF files
+// --------------------------------------------------------------------
+
+struct PdfDocument {
+    char *file_name;
+    PDFDoc *doc;
+    XRef *xref;
+    InObj *inObjList;
+    int occurences;             // number of references to the document; the doc can be
+    // deleted when this is negative
+    PdfDocument *next;
+};
+
+static PdfDocument *pdfDocuments = 0;
+
+static XRef *xref = 0;
+
+// Returns pointer to PdfDocument record for PDF file.
+// Creates a new record if it doesn't exist yet.
+// xref is made current for the document.
+
+static PdfDocument *find_add_document(char *file_name)
+{
+    PdfDocument *p = pdfDocuments;
+    while (p && strcmp(p->file_name, file_name) != 0)
+        p = p->next;
+    if (p) {
+        xref = p->xref;
+        (p->occurences)++;
+#ifdef DEBUG
+        fprintf(stderr, "\npdfTeX Debug: Incrementing %s (%d)\n", p->file_name,
+                p->occurences);
+#endif
+        return p;
+    }
+    p = new PdfDocument;
+    p->file_name = xstrdup(file_name);
+    p->xref = xref = 0;
+    p->occurences = 0;
+#ifdef DEBUG
+    fprintf(stderr, "\npdfTeX Debug: Creating %s (%d)\n", p->file_name,
+            p->occurences);
+#endif
+    GString *docName = new GString(p->file_name);
+    p->doc = new PDFDoc(docName);       // takes ownership of docName
+    if (!p->doc->isOk() || !p->doc->okToPrint()) {
+        pdftex_fail("xpdf: reading PDF image failed");
+    }
+    p->inObjList = 0;
+    p->next = pdfDocuments;
+    pdfDocuments = p;
+    return p;
+}
+
+// Deallocate a PdfDocument with all its resources
+
+static void delete_document(PdfDocument * pdf_doc)
+{
+    PdfDocument **p = &pdfDocuments;
+    while (*p && *p != pdf_doc)
+        p = &((*p)->next);
+    // should not happen:
+    if (!*p)
+        return;
+    // unlink from list
+    *p = pdf_doc->next;
+    // free pdf_doc's resources
+    InObj *r, *n;
+    for (r = pdf_doc->inObjList; r != 0; r = n) {
+        n = r->next;
+        delete r;
+    }
+    xref = pdf_doc->xref;
+    delete pdf_doc->doc;
+    xfree(pdf_doc->file_name);
+    delete pdf_doc;
+}
+
+// Replacement for
+//      Object *initDict(Dict *dict1){ initObj(objDict); dict = dict1; return this; }
+
+static void initDictFromDict(PdfObject & obj, Dict * dict)
+{
+    obj->initDict(xref);
+    for (int i = 0, l = dict->getLength(); i < l; i++) {
+        Object obj1;
+        obj->dictAdd(copyString(dict->getKey(i)), dict->getValNF(i, &obj1));
+    }
+}
+
+// --------------------------------------------------------------------
+
+static int addEncoding(GfxFont * gfont)
+{
+    UsedEncoding *n;
+    n = new UsedEncoding;
+    n->next = encodingList;
+    encodingList = n;
+    n->font = gfont;
+    n->enc_objnum = pdf_new_objnum();
+    return n->enc_objnum;
+}
+
+#define addFont(ref, fd, enc_objnum) \
+        addInObj(objFont, ref, fd, enc_objnum)
+
+// addFontDesc is only used to avoid writing the original FontDescriptor
+// from the PDF file.
+
+#define addFontDesc(ref, fd) \
+        addInObj(objFontDesc, ref, fd, 0)
+
+#define addOther(ref) \
+        addInObj(objOther, ref, 0, 0)
+
+static int addInObj(InObjType type, Ref ref, fd_entry * fd, integer e)
+{
+    InObj *p, *q, *n = new InObj;
+    if (ref.num == 0)
+        pdftex_fail("PDF inclusion: invalid reference");
+    n->ref = ref;
+    n->type = type;
+    n->next = 0;
+    n->fd = fd;
+    n->enc_objnum = e;
+    n->written = 0;
+    if (inObjList == 0)
+        inObjList = n;
+    else {
+        for (p = inObjList; p != 0; p = p->next) {
+            if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
+                delete n;
+                return p->num;
+            }
+            q = p;
+        }
+        // it is important to add new objects at the end of the list,
+        // because new objects are being added while the list is being
+        // written out.
+        q->next = n;
+    }
+    if (type == objFontDesc)
+        n->num = get_fd_objnum(fd);
+    else
+        n->num = pdf_new_objnum();
+    return n->num;
+}
+
+static void copyObject(Object *);
+
+static void copyName(char *s)
+{
+    pdf_puts("/");
+    for (; *s != 0; s++) {
+        if (isdigit(*s) || isupper(*s) || islower(*s) || *s == '_' ||
+            *s == '.' || *s == '-')
+            pdfout(*s);
+        else
+            pdf_printf("#%.2X", *s & 0xFF);
+    }
+}
+
+static void copyDictEntry(Object * obj, int i)
+{
+    PdfObject obj1;
+    copyName(obj->dictGetKey(i));
+    pdf_puts(" ");
+    obj->dictGetValNF(i, &obj1);
+    copyObject(&obj1);
+    pdf_puts("\n");
+}
+
+static void copyDict(Object * obj)
+{
+    int i, l;
+    if (!obj->isDict())
+        pdftex_fail("PDF inclusion: invalid dict type <%s>",
+                    obj->getTypeName());
+    for (i = 0, l = obj->dictGetLength(); i < l; ++i)
+        copyDictEntry(obj, i);
+}
+
+static void copyFontDict(Object * obj, InObj * r)
+{
+    int i, l;
+    char *key;
+    if (!obj->isDict())
+        pdftex_fail("PDF inclusion: invalid dict type <%s>",
+                    obj->getTypeName());
+    pdf_puts("<<\n");
+    assert(r->type == objFont); // FontDescriptor is in fd_tree
+    for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
+        key = obj->dictGetKey(i);
+        if (strncmp("FontDescriptor", key, strlen("FontDescriptor")) == 0
+            || strncmp("BaseFont", key, strlen("BaseFont")) == 0
+            || strncmp("Encoding", key, strlen("Encoding")) == 0)
+            continue;           // skip original values
+        copyDictEntry(obj, i);
+    }
+    // write new FontDescriptor, BaseFont, and Encoding
+    pdf_printf("/FontDescriptor %d 0 R\n", (int) get_fd_objnum(r->fd));
+    pdf_printf("/BaseFont %d 0 R\n", (int) get_fn_objnum(r->fd));
+    pdf_printf("/Encoding %d 0 R\n", (int) r->enc_objnum);
+    pdf_puts(">>");
+}
+
+static void copyStream(Stream * str)
+{
+    int c;
+    str->reset();
+    while ((c = str->getChar()) != EOF)
+        pdfout(c);
+    pdf_last_byte = pdf_buf[pdf_ptr - 1];
+}
+
+static void copyProcSet(Object * obj)
+{
+    int i, l;
+    PdfObject procset;
+    if (!obj->isArray())
+        pdftex_fail("PDF inclusion: invalid ProcSet array type <%s>",
+                    obj->getTypeName());
+    pdf_puts("/ProcSet [ ");
+    for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
+        obj->arrayGetNF(i, &procset);
+        if (!procset->isName())
+            pdftex_fail("PDF inclusion: invalid ProcSet entry type <%s>",
+                        procset->getTypeName());
+        copyName(procset->getName());
+        pdf_puts(" ");
+    }
+    pdf_puts("]\n");
+}
+
+#define REPLACE_TYPE1C true
+
+static void copyFont(char *tag, Object * fontRef)
+{
+    PdfObject fontdict, subtype, basefont, fontdescRef, fontdesc, charset,
+        fontfile, ffsubtype;
+    GfxFont *gfont;
+    fd_entry *fd;
+    fm_entry *fontmap;
+    // Check whether the font has already been embedded before analysing it.
+    InObj *p;
+    Ref ref = fontRef->getRef();
+    for (p = inObjList; p; p = p->next) {
+        if (p->ref.num == ref.num && p->ref.gen == ref.gen) {
+            copyName(tag);
+            pdf_printf(" %d 0 R ", (int) p->num);
+            return;
+        }
+    }
+    // Only handle included Type1 (and Type1C) fonts; anything else will be copied.
+    // Type1C fonts are replaced by Type1 fonts, if REPLACE_TYPE1C is true.
+    if (fixed_replace_font && fontRef->fetch(xref, &fontdict)->isDict()
+        && fontdict->dictLookup("Subtype", &subtype)->isName()
+        && !strcmp(subtype->getName(), "Type1")
+        && fontdict->dictLookup("BaseFont", &basefont)->isName()
+        && fontdict->dictLookupNF("FontDescriptor", &fontdescRef)->isRef()
+        && fontdescRef->fetch(xref, &fontdesc)->isDict()
+        && (fontdesc->dictLookup("FontFile", &fontfile)->isStream()
+            || (REPLACE_TYPE1C
+                && fontdesc->dictLookup("FontFile3", &fontfile)->isStream()
+                && fontfile->streamGetDict()->lookup("Subtype",
+                                                     &ffsubtype)->isName()
+                && !strcmp(ffsubtype->getName(), "Type1C")))
+        && (fontmap = lookup_fontmap(basefont->getName())) != NULL) {
+        fd = epdf_create_fontdescriptor(fontmap);
+        if (fontdesc->dictLookup("CharSet", &charset) &&
+            charset->isString() && is_subsetable(fontmap))
+            epdf_mark_glyphs(fd, charset->getString()->getCString());
+        else
+            embed_whole_font(fd);
+        addFontDesc(fontdescRef->getRef(), fd);
+        copyName(tag);
+        gfont = GfxFont::makeFont(xref, tag, fontRef->getRef(),
+                                  fontdict->getDict());
+        pdf_printf(" %d 0 R ", addFont(fontRef->getRef(), fd,
+                                       addEncoding(gfont)));
+    } else {
+        copyName(tag);
+        pdf_puts(" ");
+        copyObject(fontRef);
+    }
+}
+
+static void copyFontResources(Object * obj)
+{
+    PdfObject fontRef;
+    int i, l;
+    if (!obj->isDict())
+        pdftex_fail("PDF inclusion: invalid font resources dict type <%s>",
+                    obj->getTypeName());
+    pdf_puts("/Font << ");
+    for (i = 0, l = obj->dictGetLength(); i < l; ++i) {
+        obj->dictGetValNF(i, &fontRef);
+        if (fontRef->isRef())
+            copyFont(obj->dictGetKey(i), &fontRef);
+        else
+            pdftex_fail("PDF inclusion: invalid font in reference type <%s>",
+                        fontRef->getTypeName());
+    }
+    pdf_puts(">>\n");
+}
+
+static void copyOtherResources(Object * obj, char *key)
+{
+    // copies all other resources (write_epdf handles Fonts and ProcSets),
+    // but gives a warning if an object is not a dictionary.
+
+    if (!obj->isDict())
+        //FIXME: Write the message only to the log file
+        pdftex_warn("PDF inclusion: invalid other resource which is no dict"
+                    " (key '%s', type <%s>); copying it anyway.",
+                    key, obj->getTypeName());
+    copyName(key);
+    pdf_puts(" ");
+    copyObject(obj);
+}
+
+// Function onverts double to string; very small and very large numbers
+// are NOT converted to scientific notation.
+// n must be a number or real conforming to the implementation limits
+// of PDF as specified in appendix C.1 of the PDF Ref.
+// These are:
+// maximum value of ints is +2^32
+// maximum value of reals is +2^15
+// smalles values of reals is 1/(2^16)
+
+static char *convertNumToPDF(double n)
+{
+    static const int precision = 6;
+    static const int fact = (int) 1E6;  // must be 10^precision
+    static const double epsilon = 0.5E-6;       // 2epsilon must be 10^-precision
+    static char buf[64];
+    // handle very small values: return 0
+    if (fabs(n) < epsilon) {
+        buf[0] = '0';
+        buf[1] = '\0';
+    } else {
+        char ints[64];
+        int bindex = 0, sindex = 0;
+        int ival, fval;
+        // handle the sign part if n is negative
+        if (n < 0) {
+            buf[bindex++] = '-';
+            n = -n;
+        }
+        n += epsilon;           // for rounding
+        // handle the integer part, simply with sprintf
+        ival = (int) floor(n);
+        n -= ival;
+        sprintf(ints, "%d", ival);
+        while (ints[sindex] != 0)
+            buf[bindex++] = ints[sindex++];
+        // handle the fractional part up to 'precision' digits
+        fval = (int) floor(n * fact);
+        if (fval) {
+            // set a dot
+            buf[bindex++] = '.';
+            sindex = bindex + precision;
+            buf[sindex--] = '\0';
+            // fill up trailing zeros with the string terminator NULL
+            while (((fval % 10) == 0) && (sindex >= bindex)) {
+                buf[sindex--] = '\0';
+                fval /= 10;
+            }
+            // fill up the fractional part back to front
+            while (sindex >= bindex) {
+                buf[sindex--] = (fval % 10) + '0';
+                fval /= 10;
+            }
+        } else
+            buf[bindex++] = 0;
+    }
+    return (char *) buf;
+}
+
+static void copyObject(Object * obj)
+{
+    PdfObject obj1;
+    int i, l, c;
+    Ref ref;
+    char *p;
+    GString *s;
+    if (obj->isBool()) {
+        pdf_printf("%s", obj->getBool()? "true" : "false");
+    } else if (obj->isInt()) {
+        pdf_printf("%i", obj->getInt());
+    } else if (obj->isReal()) {
+        pdf_printf("%s", convertNumToPDF(obj->getReal()));
+    } else if (obj->isNum()) {
+        pdf_printf("%s", convertNumToPDF(obj->getNum()));
+    } else if (obj->isString()) {
+        s = obj->getString();
+        p = s->getCString();
+        l = s->getLength();
+        if (strlen(p) == (unsigned int) l) {
+            pdf_puts("(");
+            for (; *p != 0; p++) {
+                c = (unsigned char) *p;
+                if (c == '(' || c == ')' || c == '\\')
+                    pdf_printf("\\%c", c);
+                else if (c < 0x20 || c > 0x7F)
+                    pdf_printf("\\%03o", c);
+                else
+                    pdfout(c);
+            }
+            pdf_puts(")");
+        } else {
+            pdf_puts("<");
+            for (i = 0; i < l; i++) {
+                c = s->getChar(i) & 0xFF;
+                pdf_printf("%.2x", c);
+            }
+            pdf_puts(">");
+        }
+    } else if (obj->isName()) {
+        copyName(obj->getName());
+    } else if (obj->isNull()) {
+        pdf_puts("null");
+    } else if (obj->isArray()) {
+        pdf_puts("[");
+        for (i = 0, l = obj->arrayGetLength(); i < l; ++i) {
+            obj->arrayGetNF(i, &obj1);
+            if (!obj1->isName())
+                pdf_puts(" ");
+            copyObject(&obj1);
+        }
+        pdf_puts("]");
+    } else if (obj->isDict()) {
+        pdf_puts("<<\n");
+        copyDict(obj);
+        pdf_puts(">>");
+    } else if (obj->isStream()) {
+        initDictFromDict(obj1, obj->streamGetDict());
+        obj->streamGetDict()->incRef();
+        pdf_puts("<<\n");
+        copyDict(&obj1);
+        pdf_puts(">>\n");
+        pdf_puts("stream\n");
+        copyStream(obj->getStream()->getBaseStream());
+        if (pdf_last_byte != '\n')
+            pdf_puts("\n");
+        pdf_puts("endstream");  // can't simply write pdf_end_stream()
+    } else if (obj->isRef()) {
+        ref = obj->getRef();
+        if (ref.num == 0) {
+            pdftex_warn
+                ("PDF inclusion: reference to invalid object was replaced by <null>");
+            pdf_puts("null");
+        } else
+            pdf_printf("%d 0 R", addOther(ref));
+    } else {
+        pdftex_fail("PDF inclusion: type <%s> cannot be copied",
+                    obj->getTypeName());
+    }
+}
+
+static void writeRefs()
+{
+    InObj *r;
+    for (r = inObjList; r != 0; r = r->next) {
+        if (!r->written) {
+            Object obj1;
+            r->written = 1;
+            xref->fetch(r->ref.num, r->ref.gen, &obj1);
+            if (r->type == objFont) {
+                assert(!obj1.isStream());
+                zpdf_begin_obj(r->num, 2);      // \pdfobjcompresslevel = 2 is for this
+                copyFontDict(&obj1, r);
+                pdf_puts("\n");
+                pdf_end_obj();
+            } else if (r->type != objFontDesc) {        // /FontDescriptor is written via write_fontdescriptor()
+                if (obj1.isStream())
+                    zpdf_begin_obj(r->num, 0);
+                else
+                    zpdf_begin_obj(r->num, 2);  // \pdfobjcompresslevel = 2 is for this
+                copyObject(&obj1);
+                pdf_puts("\n");
+                pdf_end_obj();
+            }
+            obj1.free();
+        }
+    }
+}
+
+static void writeEncodings()
+{
+    UsedEncoding *r, *n;
+    char *glyphNames[256], *s;
+    int i;
+    for (r = encodingList; r != 0; r = r->next) {
+        for (i = 0; i < 256; i++) {
+            if (r->font->isCIDFont()) {
+                pdftex_warn
+                    ("PDF inclusion: CID font included, encoding maybe wrong");
+            }
+            if ((s = ((Gfx8BitFont *) r->font)->getCharName(i)) != 0)
+                glyphNames[i] = s;
+            else
+                glyphNames[i] = notdef;
+        }
+        epdf_write_enc(glyphNames, r->enc_objnum);
+    }
+    for (r = encodingList; r != 0; r = n) {
+        n = r->next;
+        delete r->font;
+        delete r;
+    }
+}
+
+// get the pagebox according to the pagebox_spec
+
+static PDFRectangle *get_pagebox(Page * page, integer pagebox_spec)
+{
+    if (pagebox_spec == pdf_box_spec_media)
+        return page->getMediaBox();
+    else if (pagebox_spec == pdf_box_spec_crop)
+        return page->getCropBox();
+    else if (pagebox_spec == pdf_box_spec_bleed)
+        return page->getBleedBox();
+    else if (pagebox_spec == pdf_box_spec_trim)
+        return page->getTrimBox();
+    else if (pagebox_spec == pdf_box_spec_art)
+        return page->getArtBox();
+    else
+        pdftex_fail("PDF inclusion: unknown value of pagebox spec (%i)",
+                    (int) pagebox_spec);
+    return page->getMediaBox(); // to make the compiler happy
+}
+
+
+// Reads various information about the PDF and sets it up for later inclusion.
+// This will fail if the PDF version of the PDF is higher than
+// minor_pdf_version_wanted or page_name is given and can not be found.
+// It makes no sense to give page_name _and_ page_num.
+// Returns the page number.
+
+void
+read_pdf_info(image_dict * idict, integer minor_pdf_version_wanted,
+              integer pdf_inclusion_errorlevel)
+{
+    PdfDocument *pdf_doc;
+    Page *page;
+    int rotate;
+    PDFRectangle *pagebox;
+    float pdf_version_found, pdf_version_wanted;
+    assert(idict != NULL);
+    assert(img_type(idict) == IMAGE_TYPE_PDF);
+    assert(img_pdf_ptr(idict) == NULL);
+    img_pdf_ptr(idict) = new_pdf_img_struct();
+    // initialize
+    if (!isInit) {
+        globalParams = new GlobalParams();
+        globalParams->setErrQuiet(gFalse);
+        isInit = gTrue;
+    }
+    // open PDF file
+    pdf_doc = find_add_document(img_filepath(idict));
+    img_pdf_doc(idict) = pdf_doc;
+
+    // check PDF version
+    // this works only for PDF 1.x -- but since any versions of PDF newer
+    // than 1.x will not be backwards compatible to PDF 1.x, pdfTeX will
+    // then have to changed drastically anyway.
+    pdf_version_found = pdf_doc->doc->getPDFVersion();
+    pdf_version_wanted = 1 + (minor_pdf_version_wanted * 0.1);
+    if (pdf_version_found > pdf_version_wanted) {
+        char msg[] =
+            "PDF inclusion: found PDF version <%.1f>, but at most version <%.1f> allowed";
+        if (pdf_inclusion_errorlevel > 0) {
+            pdftex_fail(msg, pdf_version_found, pdf_version_wanted);
+        } else {
+            pdftex_warn(msg, pdf_version_found, pdf_version_wanted);
+        }
+    }
+    img_totalpages(idict) = pdf_doc->doc->getCatalog()->getNumPages();
+    if (img_pagename(idict)) {
+        // get page by name
+        GString name(img_pagename(idict));
+        LinkDest *link = pdf_doc->doc->findDest(&name);
+        if (link == 0 || !link->isOk())
+            pdftex_fail("PDF inclusion: invalid destination <%s>",
+                        img_pagename(idict));
+        Ref ref = link->getPageRef();
+        img_pagenum(idict) =
+            pdf_doc->doc->getCatalog()->findPage(ref.num, ref.gen);
+        if (img_pagenum(idict) == 0)
+            pdftex_fail("PDF inclusion: destination is not a page <%s>",
+                        img_pagename(idict));
+        delete link;
+    } else {
+        // get page by number
+        if (img_pagenum(idict) <= 0
+            || img_pagenum(idict) > img_totalpages(idict))
+            pdftex_fail("PDF inclusion: required page <%i> does not exist",
+                        (int) img_pagenum(idict));
+    }
+    // get the required page
+    page = pdf_doc->doc->getCatalog()->getPage(img_pagenum(idict));
+
+    // get the pagebox (media, crop...) to use.
+    pagebox = get_pagebox(page, img_pagebox(idict));
+    if (pagebox->x2 > pagebox->x1) {
+        img_pdf_orig_x(idict) = pagebox->x1;
+        img_pdf_width(idict) = pagebox->x2 - pagebox->x1;
+    } else {
+        img_pdf_orig_x(idict) = pagebox->x2;
+        img_pdf_width(idict) = pagebox->x1 - pagebox->x2;
+    }
+    if (pagebox->y2 > pagebox->y1) {
+        img_pdf_orig_y(idict) = pagebox->y1;
+        img_pdf_height(idict) = pagebox->y2 - pagebox->y1;
+    } else {
+        img_pdf_orig_y(idict) = pagebox->y2;
+        img_pdf_height(idict) = pagebox->y1 - pagebox->y2;
+    }
+
+    rotate = page->getRotate();
+    // handle page rotation and adjust dimens as needed
+    if (rotate != 0) {
+        if (rotate % 90 == 0) {
+            // handle only the simple case: multiple of 90s.
+            // these are the only values allowed according to the
+            // reference (v1.3, p. 78).
+            // 180 needs no special treatment here
+            register float f;
+            switch (rotate) {
+            case 90:
+                f = img_pdf_height(idict);
+                img_pdf_height(idict) = img_pdf_width(idict);
+                img_pdf_width(idict) = f;
+                break;
+            case 270:
+                f = img_pdf_height(idict);
+                img_pdf_height(idict) = img_pdf_width(idict);
+                img_pdf_width(idict) = f;
+                break;
+            }
+        }
+    }
+    pdf_doc->xref = pdf_doc->doc->getXRef();
+    img_xsize(idict) = bp2int(img_pdf_width(idict));
+    img_ysize(idict) = bp2int(img_pdf_height(idict));
+}
+
+// writes the current epf_doc.
+// Here the included PDF is copied, so most errors that can happen during PDF
+// inclusion will arise here.
+
+void write_epdf(image_dict * idict)
+{
+    Page *page;
+    PdfObject contents, obj1, obj2;
+    PdfObject group, metadata, pieceinfo, separationInfo;
+    Object info;
+    char *key;
+    char s[256];
+    int i, l;
+    int rotate;
+    double scale[6] = { 0, 0, 0, 0, 0, 0 };
+    bool writematrix = false;
+    PdfDocument *pdf_doc = (PdfDocument *) img_pdf_doc(idict);
+    (pdf_doc->occurences)--;
+#ifdef DEBUG
+    fprintf(stderr, "\npdfTeX Debug: Decrementing %s (%d)\n",
+            pdf_doc->file_name, pdf_doc->occurences);
+#endif
+    xref = pdf_doc->xref;
+    inObjList = pdf_doc->inObjList;
+    encodingList = 0;
+    page = pdf_doc->doc->getCatalog()->getPage(img_pagenum(idict));
+    rotate = page->getRotate();
+    PDFRectangle *pagebox;
+    // write the Page header
+    pdf_puts("/Type /XObject\n/Subtype /Form\n");
+    if (img_attr(idict) != NULL && strlen(img_attr(idict)) > 0)
+        pdf_printf("%s\n", img_attr(idict));
+    pdf_puts("/FormType 1\n");
+
+    // write additional information
+    pdf_printf("/%s.FileName (%s)\n", pdfkeyprefix,
+               convertStringToPDFString(pdf_doc->file_name,
+                                        strlen(pdf_doc->file_name)));
+    pdf_printf("/%s.PageNumber %i\n", pdfkeyprefix, (int) img_pagenum(idict));
+    pdf_doc->doc->getDocInfoNF(&info);
+    if (info.isRef()) {
+        // the info dict must be indirect (PDF Ref p. 61)
+        pdf_printf("/%s.InfoDict ", pdfkeyprefix);
+        pdf_printf("%d 0 R\n", addOther(info.getRef()));
+    }
+    // get the pagebox (media, crop...) to use.
+    pagebox = get_pagebox(page, img_pagebox(idict));
+
+    // handle page rotation
+    if (rotate != 0) {
+        if (rotate % 90 == 0) {
+            // this handles only the simple case: multiple of 90s but these
+            // are the only values allowed according to the reference
+            // (v1.3, p. 78).
+            // the image is rotated around its center.
+            // the /Rotate key is clockwise while the matrix is
+            // counterclockwise :-%
+            tex_printf(", page is rotated %d degrees", rotate);
+            switch (rotate) {
+            case 90:
+                scale[1] = -1;
+                scale[2] = 1;
+                scale[4] = pagebox->x1 - pagebox->y1;
+                scale[5] = pagebox->y1 + pagebox->x2;
+                writematrix = true;
+                break;
+            case 180:
+                scale[0] = scale[3] = -1;
+                scale[4] = pagebox->x1 + pagebox->x2;
+                scale[5] = pagebox->y1 + pagebox->y2;
+                writematrix = true;
+                break;          // width and height are exchanged
+            case 270:
+                scale[1] = 1;
+                scale[2] = -1;
+                scale[4] = pagebox->x1 + pagebox->y2;
+                scale[5] = pagebox->y1 - pagebox->x1;
+                writematrix = true;
+                break;
+            }
+            if (writematrix) {  // The matrix is only written if the image is rotated.
+                sprintf(s, "/Matrix [%.8f %.8f %.8f %.8f %.8f %.8f]\n",
+                        scale[0],
+                        scale[1], scale[2], scale[3], scale[4], scale[5]);
+                pdf_printf(stripzeros(s));
+            }
+        }
+    }
+
+    sprintf(s, "/BBox [%.8f %.8f %.8f %.8f]\n",
+            pagebox->x1, pagebox->y1, pagebox->x2, pagebox->y2);
+    pdf_printf(stripzeros(s));
+
+    // write the page Group if it's there
+    if (page->getGroup() != NULL) {
+#if PDFTEX_COPY_PAGEGROUP
+#  if PDFTEX_COPY_PAGEGROUP_NOFAIL
+        // FIXME: This will most likely produce incorrect PDFs :-(
+        initDictFromDict(group, page->getGroup());
+        if (group->dictGetLength() > 0) {
+            pdf_puts("/Group ");
+            copyObject(&group);
+            pdf_puts("\n");
+        }
+#  else
+        // FIXME: currently we don't know how to handle Page Groups so we abort gracefully :-(
+        pdftex_fail
+            ("PDF inclusion: Page Group detected which pdfTeX can't handle. Sorry.");
+#  endif
+#else
+        // FIXME: currently we don't know how to handle Page Groups so we at least give a warning :-(
+        pdftex_warn
+            ("PDF inclusion: Page Group detected which pdfTeX can't handle. Ignoring it.");
+#endif
+    }
+    // write the page Metadata if it's there
+    if (page->getMetadata() != NULL) {
+        metadata->initStream(page->getMetadata());
+        pdf_puts("/Metadata ");
+        copyObject(&metadata);
+        pdf_puts("\n");
+    }
+    // write the page PieceInfo if it's there
+    if (page->getPieceInfo() != NULL) {
+        initDictFromDict(pieceinfo, page->getPieceInfo());
+        if (pieceinfo->dictGetLength() > 0) {
+            pdf_puts("/PieceInfo ");
+            copyObject(&pieceinfo);
+            pdf_puts("\n");
+        }
+    }
+    // write the page SeparationInfo if it's there
+    if (page->getSeparationInfo() != NULL) {
+        initDictFromDict(separationInfo, page->getSeparationInfo());
+        if (separationInfo->dictGetLength() > 0) {
+            pdf_puts("/SeparationInfo ");
+            copyObject(&separationInfo);
+            pdf_puts("\n");
+        }
+    }
+    // write the Resources dictionary
+    if (page->getResourceDict() == NULL) {
+        // Resources can be missing (files without them have been spotted
+        // in the wild). This violates the PDF Ref., which claims they are
+        // required, but all RIPs accept them.
+        // We "replace" them with empty /Resources, although in form xobjects
+        // /Resources are not required.
+        pdftex_warn
+            ("PDF inclusion: no /Resources detected. Replacing with empty /Resources.");
+        pdf_puts("/Resources <<>>\n");
+    } else {
+        initDictFromDict(obj1, page->getResourceDict());
+        page->getResourceDict()->incRef();
+        if (!obj1->isDict())
+            pdftex_fail("PDF inclusion: invalid resources dict type <%s>",
+                        obj1->getTypeName());
+        pdf_puts("/Resources <<\n");
+        for (i = 0, l = obj1->dictGetLength(); i < l; ++i) {
+            obj1->dictGetVal(i, &obj2);
+            key = obj1->dictGetKey(i);
+            if (strcmp("Font", key) == 0)
+                copyFontResources(&obj2);
+            else if (strcmp("ProcSet", key) == 0)
+                copyProcSet(&obj2);
+            else
+                copyOtherResources(&obj2, key);
+        }
+        pdf_puts(">>\n");
+    }
+    // write the page contents
+    page->getContents(&contents);
+    if (contents->isStream()) {
+        initDictFromDict(obj1, contents->streamGetDict());
+        contents->streamGetDict()->incRef();
+        copyDict(&obj1);
+        pdf_puts(">>\nstream\n");
+        copyStream(contents->getStream()->getBaseStream());
+        pdf_end_stream();
+    } else if (contents->isArray()) {
+        pdf_begin_stream();
+        for (i = 0, l = contents->arrayGetLength(); i < l; ++i) {
+            Object contentsobj;
+            copyStream((contents->arrayGet(i, &contentsobj))->getStream());
+            contentsobj.free();
+        }
+        pdf_end_stream();
+    } else {                    // the contents are optional, but we need to include an empty stream
+        pdf_begin_stream();
+        pdf_end_stream();
+    }
+    // write out all indirect objects
+    writeRefs();
+    // write out all used encodings (and delete list)
+    writeEncodings();
+    // save object list, xref
+    pdf_doc->inObjList = inObjList;
+    pdf_doc->xref = xref;
+}
+
+// Called when an image has been written and it's resources in image_tab are
+// freed and it's not referenced anymore.
+
+void epdf_delete(image_dict * idict)
+{
+    PdfDocument *pdf_doc = (PdfDocument *) img_pdf_doc(idict);
+    xref = pdf_doc->xref;
+    if (pdf_doc->occurences < 0) {
+#ifdef DEBUG
+        fprintf(stderr, "\npdfTeX Debug: Deleting %s\n", pdf_doc->file_name);
+#endif
+        delete_document(pdf_doc);
+    }
+    img_pdf_doc(idict) = NULL;
+}
+
+// Called when PDF embedding system is finalized.
+// Now deallocate all remaining PdfDocuments.
+
+void epdf_check_mem()
+{
+    if (isInit) {
+        PdfDocument *p, *n;
+        for (p = pdfDocuments; p; p = n) {
+            n = p->next;
+            delete_document(p);
+        }
+        // see above for globalParams
+        delete globalParams;
+    }
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/writeimg.c b/Build/source/texk/web2c/luatexdir/image/writeimg.c
new file mode 100644
index 00000000000..66eb459bc0c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/writeimg.c
@@ -0,0 +1,677 @@
+/*
+Copyright (c) 1996-2002, 2005 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writeimg.c 1119 2008-03-22 11:27:02Z hhenkel $
+*/
+
+#include <assert.h>
+#include "ptexlib.h"
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-memstr.h>
+
+#include "image.h"
+
+#include <../lua51/lua.h>
+#include <../lua51/lauxlib.h>
+
+extern void pdf_print_real(integer m, integer d);
+
+#define obj_aux(A) obj_tab[(A)].int4
+
+/**********************************************************************/
+/*
+  Patch ImageTypeDetection 2003/02/08 by Heiko Oberdiek.
+
+  Function "readimage" performs some basic initializations.
+  Then it looks at the file extension to determine the
+  image type and calls specific code/functions.
+    The main disadvantage is that standard file extensions
+  have to be used, otherwise pdfTeX is not able to detect
+  the correct image type.
+
+  The patch now looks at the file header first regardless of
+  the file extension. This is implemented in function
+  "check_type_by_header". If this check fails, the traditional
+  test of standard file extension is tried, done in function
+  "check_type_by_extension".
+
+  Magic headers:
+
+  * "PNG (Portable Network Graphics) Specification", Version 1.2
+    (http://www.libpng.org/pub/png):
+
+  |   3.1. PNG file signature
+  |
+  |      The first eight bytes of a PNG file always contain the following
+  |      (decimal) values:
+  |
+  |         137 80 78 71 13 10 26 10
+
+  Translation to C: "\x89PNG\r\n\x1A\n"
+
+  * "JPEG File Interchange Format", Version 1.02:
+
+  | o you can identify a JFIF file by looking for the following
+  |   sequence: X'FF', SOI X'FF', APP0, <2 bytes to be skipped>,
+  |   "JFIF", X'00'.
+
+  Function "check_type_by_header" only looks at the first two bytes:
+    "\xFF\xD8"
+
+  * ISO/IEC JTC 1/SC 29/WG 1
+    (ITU-T SG8)
+    Coding of Still Pictures
+    Title: 14492 FCD
+    Source: JBIG Committee
+    Project: JTC 1.29.10
+    Status: Final Committee Draft
+
+  | D.4.1, ID string
+  |
+  | This is an 8-byte sequence containing 0x97 0x4A 0x42 0x32 0x0D 0x0A
+  | 0x1A 0x0A.
+
+  * "PDF Reference", third edition:
+    * The first line should contain "%PDF-1.0" until "%PDF-1.4"
+      (section 3.4.1 "File Header").
+    * The "implementation notes" say:
+
+    | 3.4.1,  File Header
+    |   12. Acrobat viewers require only that the header appear
+    |       somewhere within the first 1024 bytes of the file.
+    |   13. Acrobat viewers will also accept a header of the form
+    |           %!PS-Adobe-N.n PDF-M.m
+
+    The check in function "check_type_by_header" only implements
+    the first issue. The implementation notes are not considered.
+    Therefore files with garbage at start of file must have the
+    standard extension.
+
+    Functions "check_type_by_header" and "check_type_by_extension":
+    img_type(img) is set to IMAGE_TYPE_NONE by new_image_dict().
+    Both functions try to detect a type and set img_type(img).
+    Thus a value other than IMAGE_TYPE_NONE indicates that a
+    type has been found.
+*/
+
+#define HEADER_JPG "\xFF\xD8"
+#define HEADER_PNG "\x89PNG\r\n\x1A\n"
+#define HEADER_JBIG2 "\x97\x4A\x42\x32\x0D\x0A\x1A\x0A"
+#define HEADER_PDF "%PDF-1."
+#define MAX_HEADER (sizeof(HEADER_PNG)-1)
+
+static void check_type_by_header(image_dict * idict)
+{
+    int i;
+    FILE *file = NULL;
+    char header[MAX_HEADER];
+
+    assert(idict != NULL);
+    if (img_type(idict) != IMAGE_TYPE_NONE)     /* nothing to do */
+        return;
+    /* read the header */
+    file = xfopen(img_filepath(idict), FOPEN_RBIN_MODE);
+    for (i = 0; (unsigned) i < MAX_HEADER; i++) {
+        header[i] = xgetc(file);
+        if (feof(file))
+            pdftex_fail("reading image file failed");
+    }
+    xfclose(file, img_filepath(idict));
+    /* tests */
+    if (strncmp(header, HEADER_JPG, sizeof(HEADER_JPG) - 1) == 0)
+        img_type(idict) = IMAGE_TYPE_JPG;
+    else if (strncmp(header, HEADER_PNG, sizeof(HEADER_PNG) - 1) == 0)
+        img_type(idict) = IMAGE_TYPE_PNG;
+    else if (strncmp(header, HEADER_JBIG2, sizeof(HEADER_JBIG2) - 1) == 0)
+        img_type(idict) = IMAGE_TYPE_JBIG2;
+    else if (strncmp(header, HEADER_PDF, sizeof(HEADER_PDF) - 1) == 0)
+        img_type(idict) = IMAGE_TYPE_PDF;
+}
+
+static void check_type_by_extension(image_dict * idict)
+{
+    char *image_suffix;
+
+    assert(idict != NULL);
+    if (img_type(idict) != IMAGE_TYPE_NONE)     /* nothing to do */
+        return;
+    /* tests */
+    if ((image_suffix = strrchr(img_filename(idict), '.')) == 0)
+        img_type(idict) = IMAGE_TYPE_NONE;
+    else if (strcasecmp(image_suffix, ".png") == 0)
+        img_type(idict) = IMAGE_TYPE_PNG;
+    else if (strcasecmp(image_suffix, ".jpg") == 0 ||
+             strcasecmp(image_suffix, ".jpeg") == 0)
+        img_type(idict) = IMAGE_TYPE_JPG;
+    else if (strcasecmp(image_suffix, ".jbig2") == 0 ||
+             strcasecmp(image_suffix, ".jb2") == 0)
+        img_type(idict) = IMAGE_TYPE_JBIG2;
+    else if (strcasecmp(image_suffix, ".pdf") == 0)
+        img_type(idict) = IMAGE_TYPE_PDF;
+}
+
+/**********************************************************************/
+
+pdf_img_struct *new_pdf_img_struct()
+{
+    pdf_img_struct *p;
+    p = xtalloc(1, pdf_img_struct);
+    p->width = 0;
+    p->height = 0;
+    p->orig_x = 0;
+    p->orig_y = 0;
+    p->doc = NULL;
+    return p;
+}
+
+void init_image(image * p)
+{
+    assert(p != NULL);
+    set_wd_running(p);
+    set_ht_running(p);
+    set_dp_running(p);
+    img_transform(p) = 0;
+    img_flags(p) = 0;
+    img_unset_refered(p);       /* wd/ht/dp may be modified */
+    img_unset_scaled(p);
+    img_dict(p) = NULL;
+    img_dictref(p) = LUA_NOREF;
+}
+
+image *new_image()
+{
+    image *p = xtalloc(1, image);
+    init_image(p);
+    return p;
+}
+
+void init_image_dict(image_dict * p)
+{
+    assert(p != NULL);
+    img_objnum(p) = 0;
+    img_index(p) = 0;
+    img_xsize(p) = 0;
+    img_ysize(p) = 0;
+    img_xres(p) = 0;
+    img_yres(p) = 0;
+    img_colorspace(p) = 0;
+    img_totalpages(p) = 0;
+    img_pagenum(p) = 1;
+    img_pagename(p) = NULL;
+    img_filename(p) = NULL;
+    img_filepath(p) = NULL;
+    img_attr(p) = NULL;
+    img_file(p) = NULL;
+    img_type(p) = IMAGE_TYPE_NONE;
+    img_color(p) = 0;
+    img_colordepth(p) = 0;
+    img_pagebox(p) = PDF_BOX_SPEC_MEDIA;
+    img_state(p) = DICT_NEW;
+    img_pdf_ptr(p) = NULL;      /* union */
+}
+
+image_dict *new_image_dict()
+{
+    image_dict *p = xtalloc(1, image_dict);
+    init_image_dict(p);
+    return p;
+}
+
+void free_dict_strings(image_dict * p)
+{
+    if (img_filename(p) != NULL)
+        xfree(img_filename(p));
+    img_filename(p) = NULL;
+    if (img_filepath(p) != NULL)
+        xfree(img_filepath(p));
+    img_filepath(p) = NULL;
+    if (img_attr(p) != NULL)
+        xfree(img_attr(p));
+    img_attr(p) = NULL;
+    if (img_pagename(p) != NULL)
+        xfree(img_pagename(p));
+    img_pagename(p) = NULL;
+}
+
+void free_image_dict(image_dict * p)
+{
+    free_dict_strings(p);
+    if (img_type(p) == IMAGE_TYPE_PDF)
+        epdf_delete(p);
+    assert(img_file(p) == NULL);
+    xfree(p);
+}
+
+/**********************************************************************/
+
+void pdf_print_resname_prefix()
+{
+    if (pdf_resname_prefix != 0)
+        pdf_printf(makecstring(pdf_resname_prefix));
+}
+
+void read_img(image_dict * idict, integer pdf_minor_version,
+              integer pdf_inclusion_errorlevel)
+{
+    char *filepath;
+    int callback_id;
+    assert(idict != NULL);
+    if (img_filename(idict) == NULL)
+        pdftex_fail("image file name missing");
+    callback_id = callback_defined(find_image_file_callback);
+    if (img_filepath(idict) == NULL) {
+        if (callback_id > 0
+            && run_callback(callback_id, "S->S", img_filename(idict),
+                            &filepath)) {
+            if (filepath && (strlen(filepath) > 0))
+                img_filepath(idict) = strdup(filepath);
+        } else
+            img_filepath(idict) =
+                kpse_find_file(img_filename(idict), kpse_tex_format, true);
+    }
+    if (img_filepath(idict) == NULL)
+        pdftex_fail("cannot find image file");
+    /* type checks */
+    check_type_by_header(idict);
+    check_type_by_extension(idict);
+    /* read image */
+    switch (img_type(idict)) {
+    case IMAGE_TYPE_PDF:
+        read_pdf_info(idict, pdf_minor_version, pdf_inclusion_errorlevel);
+        break;
+    case IMAGE_TYPE_PNG:
+        read_png_info(idict, IMG_CLOSEINBETWEEN);
+        break;
+    case IMAGE_TYPE_JPG:
+        read_jpg_info(idict, IMG_CLOSEINBETWEEN);
+        break;
+    case IMAGE_TYPE_JBIG2:
+        if (pdf_minor_version < 4) {
+            pdftex_fail
+                ("JBIG2 images only possible with at least PDF 1.4; you are generating PDF 1.%i",
+                 (int) pdf_minor_version);
+        }
+        read_jbig2_info(idict);
+        break;
+    default:
+        pdftex_fail("internal error: unknown image type");
+    }
+    cur_file_name = NULL;
+    if (img_state(idict) < DICT_FILESCANNED)
+        img_state(idict) = DICT_FILESCANNED;
+}
+
+void scale_img(image * img)
+{
+    integer x, y, xr, yr;       /* size and resolution of image */
+    scaled w, h;                /* indeed size corresponds to image resolution */
+    integer default_res;
+    assert(img != NULL);
+    image_dict *idict = img_dict(img);
+    assert(idict != NULL);
+    x = img_xsize(idict);       /* dimensions, resolutions from image file */
+    y = img_ysize(idict);
+    xr = img_xres(idict);
+    yr = img_yres(idict);
+    if ((img_transform(img) & 1) == 1) {
+        int tmp = x;
+        x = y;
+        y = tmp;
+        tmp = xr;
+        xr = yr;
+        yr = tmp;
+    }
+    if (xr > 65535 || yr > 65535) {
+        xr = 0;
+        yr = 0;
+        pdftex_warn("ext1: too large image resolution ignored");
+    }
+    if (x <= 0 || y <= 0 || xr < 0 || yr < 0)
+        pdftex_fail("ext1: invalid image dimensions");
+    if (img_type(idict) == IMAGE_TYPE_PDF) {
+        w = x;
+        h = y;
+    } else {
+        default_res = fix_int(get_pdf_image_resolution(), 0, 65535);
+        if (default_res > 0 && (xr == 0 || yr == 0)) {
+            xr = default_res;
+            yr = default_res;
+        }
+        if (is_wd_running(img) && is_ht_running(img)) {
+            if (xr > 0 && yr > 0) {
+                w = ext_xn_over_d(one_hundred_inch, x, 100 * xr);
+                h = ext_xn_over_d(one_hundred_inch, y, 100 * yr);
+            } else {
+                w = ext_xn_over_d(one_hundred_inch, x, 7200);
+                h = ext_xn_over_d(one_hundred_inch, y, 7200);
+            }
+        }
+    }
+    if (is_wd_running(img) && is_ht_running(img) && is_dp_running(img)) {
+        img_width(img) = w;
+        img_height(img) = h;
+        img_depth(img) = 0;
+    } else if (is_wd_running(img)) {
+        /* image depth or height is explicitly specified */
+        if (is_ht_running(img)) {
+            /* image depth is explicitly specified */
+            img_width(img) = ext_xn_over_d(h, x, y);
+            img_height(img) = h - img_depth(img);
+        } else if (is_dp_running(img)) {
+            /* image height is explicitly specified */
+            img_width(img) = ext_xn_over_d(img_height(img), x, y);
+            img_depth(img) = 0;
+        } else {
+            /* both image depth and height are explicitly specified */
+            img_width(img) =
+                ext_xn_over_d(img_height(img) + img_depth(img), x, y);
+        }
+    } else {
+        /* image width is explicitly specified */
+        if (is_ht_running(img) && is_dp_running(img)) {
+            /* both image depth and height are not specified */
+            img_height(img) = ext_xn_over_d(img_width(img), y, x);
+            img_depth(img) = 0;
+        }
+        /* image depth is explicitly specified */
+        else if (is_ht_running(img)) {
+            img_height(img) =
+                ext_xn_over_d(img_width(img), y, x) - img_depth(img);
+        }
+        /* image height is explicitly specified */
+        else if (is_dp_running(img)) {
+            img_depth(img) = 0;
+        }
+        /* else both image depth and height are explicitly specified */
+    }
+    img_set_scaled(img);
+}
+
+void out_img(image * img, scaled hpos, scaled vpos)
+{
+    float a[7];                 /* transformation matrix (todo: indices should be reduced!) */
+    int r;                      /* number of digits after the decimal point */
+    assert(img != 0);
+    image_dict *idict = img_dict(img);
+    assert(idict != 0);
+    scaled wd = img_width(img);
+    scaled ht = img_height(img);
+    scaled dp = img_depth(img);
+    if (img_type(idict) == IMAGE_TYPE_PDF) {
+        a[1] = wd * 1.0e6 / img_xsize(idict);
+        a[2] = 0;
+        a[3] = 0;
+        a[4] = (ht + dp) * 1.0e6 / img_ysize(idict);
+        a[5] = hpos -
+            (float) wd *bp2int(img_pdf_orig_x(idict)) / img_xsize(idict);
+        a[6] = vpos -
+            (float) ht *bp2int(img_pdf_orig_y(idict)) / img_ysize(idict);
+        r = 6;
+    } else {
+        a[1] = wd * 1.0e6 / one_hundred_bp;
+        a[2] = 0;
+        a[3] = 0;
+        a[4] = (ht + dp) * 1.0e6 / one_hundred_bp;
+        a[5] = hpos;
+        a[6] = vpos;
+        r = 4;
+    }
+    if ((img_transform(img) & 1) == 1) {
+        if (ht == -dp)
+            pdftex_fail("image transform: division by zero (height == -depth)");
+        if (wd == 0)
+            pdftex_fail("image transform: division by zero (width == 0)");
+    }
+    switch (img_transform(img) & 7) {
+    case 0:                    /* unrotated */
+        break;
+    case 1:                    /* rot. 90 deg. (counterclockwise) */
+        a[2] = a[1] * (ht + dp) / wd;
+        a[1] = 0;
+        a[3] = -a[4] * wd / (ht + dp);
+        a[4] = 0;
+        a[5] += wd;
+        break;
+    case 2:                    /* rot. 180 deg. */
+        a[1] = -a[1];
+        a[4] = -a[4];
+        a[5] += wd;
+        a[6] += ht + dp;
+        break;
+    case 3:                    /* rot. 270 deg. */
+        a[2] = -a[1] * (ht + dp) / wd;
+        a[1] = 0;
+        a[3] = a[4] * wd / (ht + dp);
+        a[4] = 0;
+        a[6] += ht + dp;
+        break;
+    case 4:                    /* mirrored, unrotated */
+        a[1] = -a[1];
+        a[5] += wd;
+        break;
+    case 5:                    /* mirrored, then rot. 90 deg. */
+        a[2] = -a[1] * (ht + dp) / wd;
+        a[1] = 0;
+        a[3] = -a[4] * wd / (ht + dp);
+        a[4] = 0;
+        a[5] += wd;
+        a[6] += ht + dp;
+        break;
+    case 6:                    /* mirrored, then rot. 180 deg. */
+        a[4] = -a[4];
+        a[6] += ht + dp;
+        break;
+    case 7:                    /* mirrored, then rot. 270 deg. */
+        a[2] = a[1] * (ht + dp) / wd;
+        a[1] = 0;
+        a[3] = a[4] * wd / (ht + dp);
+        a[4] = 0;
+        break;
+    default:
+        assert(0);
+    }
+    pdf_end_text();
+    pdf_printf("q\n");
+    pdf_print_real((integer) a[1], r);
+    pdfout(' ');
+    pdf_print_real((integer) a[2], r);
+    pdfout(' ');
+    pdf_print_real((integer) a[3], r);
+    pdfout(' ');
+    pdf_print_real((integer) a[4], r);
+    pdfout(' ');
+    pdf_print_bp((integer) a[5]);
+    pdfout(' ');
+    pdf_print_bp((integer) a[6]);
+    pdf_printf(" cm\n/Im");
+    pdf_print_int(img_index(idict));
+    pdf_print_resname_prefix();
+    pdf_printf(" Do\nQ\n");
+    if (img_state(idict) < DICT_OUTIMG)
+        img_state(idict) = DICT_OUTIMG;
+}
+
+void write_img(image_dict * idict)
+{
+    assert(idict != NULL);
+    if (img_state(idict) < DICT_WRITTEN) {
+        if (tracefilenames)
+            tex_printf(" <%s", img_filepath(idict));
+        switch (img_type(idict)) {
+        case IMAGE_TYPE_PNG:
+            write_png(idict);
+            break;
+        case IMAGE_TYPE_JPG:
+            write_jpg(idict);
+            break;
+        case IMAGE_TYPE_JBIG2:
+            write_jbig2(idict);
+            break;
+        case IMAGE_TYPE_PDF:
+            write_epdf(idict);
+            break;
+        default:
+            pdftex_fail("internal error: unknown image type");
+        }
+        if (tracefilenames)
+            tex_printf(">");
+    }
+    if (img_state(idict) < DICT_WRITTEN)
+        img_state(idict) = DICT_WRITTEN;
+}
+
+/**********************************************************************/
+
+typedef image *img_entry;
+/* define img_ptr, img_array, & img_limit */
+define_array(img);              /* array of pointers to image structures */
+
+integer img_to_array(image * img)
+{
+    assert(img != NULL);
+    alloc_array(img, 1, SMALL_BUF_SIZE);
+    *img_ptr = img;
+    return img_ptr++ - img_array;       /* now img is read-only */
+}
+
+/**********************************************************************/
+/* stuff to be accessible from TeX */
+
+integer read_image(integer objnum, integer index, strnumber filename,
+                   integer page_num,
+                   strnumber attr,
+                   strnumber page_name,
+                   integer colorspace, integer page_box,
+                   integer pdf_minor_version, integer pdf_inclusion_errorlevel)
+{
+    integer ref;
+    image *a = new_image();
+    ref = img_to_array(a);
+    image_dict *idict = img_dict(a) = new_image_dict();
+    assert(idict != NULL);
+    img_objnum(idict) = objnum;
+    img_index(idict) = index;
+    /* img_xsize, img_ysize, img_xres, img_yres set by read_img() */
+    img_colorspace(idict) = colorspace;
+    img_pagenum(idict) = page_num;
+    /* img_totalpages set by read_img() */
+    if (page_name != 0)
+        img_pagename(idict) = xstrdup(makecstring(page_name));
+    cur_file_name = makecfilename(filename);
+    assert(cur_file_name != NULL);
+    img_filename(idict) = xstrdup(cur_file_name);
+    if (attr != 0)
+        img_attr(idict) = xstrdup(makecstring(attr));
+    img_pagebox(idict) = page_box;
+    read_img(idict, pdf_minor_version, pdf_inclusion_errorlevel);
+    img_unset_scaled(a);
+    img_set_refered(a);
+    return ref;
+}
+
+void set_image_dimensions(integer ref, integer wd, integer ht, integer dp)
+{
+    image *a = img_array[ref];
+    img_width(a) = wd;
+    img_height(a) = ht;
+    img_depth(a) = dp;
+}
+
+void scale_image(integer ref)
+{
+    scale_img(img_array[ref]);
+}
+
+void out_image(integer ref, scaled hpos, scaled vpos)
+{
+    image *a = img_array[ref];
+    out_img(a, hpos, vpos);
+}
+
+void write_image(integer ref)
+{
+    write_img(img_dict(img_array[ref]));
+}
+
+integer image_pages(integer ref)
+{
+    return img_totalpages(img_dict(img_array[ref]));
+}
+
+integer image_colordepth(integer ref)
+{
+    return img_colordepth(img_dict(img_array[ref]));
+}
+
+integer epdf_orig_x(integer ref)
+{
+    return bp2int(img_pdf_orig_x(img_dict(img_array[ref])));
+}
+
+integer epdf_orig_y(integer ref)
+{
+    return bp2int(img_pdf_orig_y(img_dict(img_array[ref])));
+}
+
+integer image_objnum(integer ref)
+{
+    return img_objnum(img_dict(img_array[ref]));
+}
+
+integer image_index(integer ref)
+{
+    return img_index(img_dict(img_array[ref]));
+}
+
+integer image_width(integer ref)
+{
+    return img_width(img_array[ref]);
+}
+
+integer image_height(integer ref)
+{
+    return img_height(img_array[ref]);
+}
+
+integer image_depth(integer ref)
+{
+    return img_depth(img_array[ref]);
+}
+
+void update_image_procset(integer ref)
+{
+    pdf_image_procset |= img_color(img_dict(img_array[ref]));
+}
+
+/**********************************************************************/
+
+boolean check_image_b(integer procset)
+{
+    return procset & IMAGE_COLOR_B;
+}
+
+boolean check_image_c(integer procset)
+{
+    return procset & IMAGE_COLOR_C;
+}
+
+boolean check_image_i(integer procset)
+{
+    return procset & IMAGE_COLOR_I;
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/writejbig2.c b/Build/source/texk/web2c/luatexdir/image/writejbig2.c
new file mode 100644
index 00000000000..d50ed88c485
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/writejbig2.c
@@ -0,0 +1,749 @@
+/***********************************************************************
+Copyright (c) 2002-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software Foundation, Inc., 59
+Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+This is experimental JBIG2 image support to pdfTeX. JBIG2 image decoding
+is part of Adobe PDF-1.4, and requires Acroread 5.0 or later.
+
+References
+==========
+
+* 14492 FCD: Information technology -- coded representation of picture
+and audio information -- lossy/lossless coding of bi-level images /
+JBIG committee, 1999 July 16. This JBIG2 Working Draft is available from
+http://www.jpeg.org/public/fcd14492.pdf. The references in the C-code
+correspond to the sections of this document.
+
+* PDF Reference, 5th edition, version 1.6, 1985--2005 Adobe Systems
+Incorporated. Available online:
+
+http://partners.adobe.com/public/developer/en/pdf/PDFReference16.pdf
+
+News
+====
+
+31 May 2006: no need to wait for endoffileflag in sequential access
+organization.
+
+10 May 2006: ygetc() for some catching of broken JBIG2 files; modify to
+accept Example 3.4 from PDFRef 5th ed. with short end-of-file segment.
+
+09 May 2006: pages_maketree() and segments_maketree() by AVL tree,
+some cleaning up.
+
+06 May 2006: File list replaced by AVL tree; new_fileinfo(),
+new_pageinfo().
+
+04 May 2006: Updated for pdftex-1.40-beta-20060213.
+
+08 Jan. 2003: Added flushjbig2page0objects() function. Now at the end
+of the pdfTeX run all pending page0 objects are written out.
+
+08 Jan. 2003: Release on private webpage.
+
+04 Jan. 2003: Completely rewritten. Now with some data structures.
+Rudimentary local file and image bookkeeping. Multiple image inclusion
+from one JBIG2 file. Only required page0 segments are marked for
+inclusion.
+
+13 Nov. 2002: pdfcrypting removed.
+
+08 Dec. 2002: bug in page 0 stream writing repaired.
+Strategy for multiple page inclusion from same JBIG2 file: When writing
+1st image, create fresh PDF object for page 0, and include any page
+0 segments from complete file (even if these segments are not needed
+for image). When writing next image, check by filename comparison if
+PDF object for page 0 of this JBIG2 file has already been written. This
+can only remember the file name for the direct predecessor JBIG2 image
+(but images of other types might come inbetween). If such page 0 PDF
+object exists, reference it. Else create fresh one.
+
+09 Dec. 2002: JBIG2 seg. page numbers > 0 are now set to 1, see PDF Ref.
+
+$Id: writejbig2.c 1027 2008-02-14 21:01:03Z hhenkel $
+***********************************************************************/
+
+#include "writejbig2.h"
+#undef DEBUG
+
+/**********************************************************************/
+
+struct avl_table *file_tree = NULL;
+
+static int comp_file_entry(const void *pa, const void *pb, void *p)
+{
+    return strcmp(((const FILEINFO *) pa)->filepath,
+                  ((const FILEINFO *) pb)->filepath);
+}
+
+static int comp_page_entry(const void *pa, const void *pb, void *p)
+{
+    return ((const PAGEINFO *) pa)->pagenum - ((const PAGEINFO *) pb)->pagenum;
+}
+
+static int comp_segment_entry(const void *pa, const void *pb, void *p)
+{
+    return ((const SEGINFO *) pa)->segnum - ((const SEGINFO *) pb)->segnum;
+}
+
+/**********************************************************************/
+
+int ygetc(FILE * stream)
+{
+    int c = getc(stream);
+    if (c < 0) {
+        if (c == EOF)
+            pdftex_fail("getc() failed; premature end of JBIG2 image file");
+        else
+            pdftex_fail("getc() failed (can't happen)");
+    }
+    return c;
+}
+
+/**********************************************************************/
+
+FILEINFO *new_fileinfo()
+{
+    FILEINFO *fip;
+    fip = xtalloc(1, FILEINFO);
+    fip->file = NULL;
+    fip->filepath = NULL;
+    fip->filesize = 0;
+    initlinkedlist(&(fip->pages));
+    initlinkedlist(&(fip->page0));
+    fip->filehdrflags = 0;
+    fip->sequentialaccess = false;
+    fip->numofpages = 0;
+    fip->streamstart = 0;
+    fip->pdfpage0objnum = 0;
+    fip->phase = INITIAL;
+    return fip;
+}
+
+PAGEINFO *new_pageinfo()
+{
+    PAGEINFO *pip;
+    pip = xtalloc(1, PAGEINFO);
+    initlinkedlist(&(pip->segments));
+    pip->pagenum = 0;
+    pip->width = 0;
+    pip->height = 0;
+    pip->xres = 0;
+    pip->yres = 0;
+    pip->pagesegmentflags = 0;
+    pip->stripinginfo = 0;
+    pip->stripedheight = 0;
+    return pip;
+}
+
+void init_seginfo(SEGINFO * sip)
+{
+    sip->segnum = 0;
+    sip->isrefered = false;
+    sip->refers = false;
+    sip->seghdrflags = 0;
+    sip->pageassocsizeflag = false;
+    sip->reftosegcount = 0;
+    sip->countofrefered = 0;
+    sip->fieldlen = 0;
+    sip->segnumwidth = 0;
+    sip->segpage = 0;
+    sip->segdatalen = 0;
+    sip->hdrstart = 0;
+    sip->hdrend = 0;
+    sip->datastart = 0;
+    sip->dataend = 0;
+    sip->endofstripeflag = false;
+    sip->endofpageflag = false;
+    sip->pageinfoflag = false;
+    sip->endoffileflag = false;
+}
+
+/**********************************************************************/
+
+void initlinkedlist(LIST * lp)
+{
+    lp->first = NULL;
+    lp->last = NULL;
+    lp->tree = NULL;
+}
+
+LIST *litem_append(LIST * lp)
+{
+    LITEM *ip;
+    ip = xtalloc(1, LITEM);
+    if (lp->first == NULL) {
+        lp->first = ip;
+        ip->prev = NULL;
+    } else {
+        lp->last->next = ip;
+        ip->prev = lp->last;
+    }
+    lp->last = ip;
+    ip->next = NULL;
+    ip->d = NULL;
+    return lp;
+}
+
+/**********************************************************************/
+
+void pages_maketree(LIST * plp)
+{
+    LITEM *ip;
+    void **aa;
+    assert(plp->tree == NULL);
+    plp->tree = avl_create(comp_page_entry, NULL, &avl_xallocator);
+    assert(plp->tree != NULL);
+    for (ip = plp->first; ip != NULL; ip = ip->next) {
+        aa = avl_probe(plp->tree, (PAGEINFO *) ip->d);
+        assert(aa != NULL);
+    }
+}
+
+void segments_maketree(LIST * slp)
+{
+    LITEM *ip;
+    void **aa;
+    assert(slp->tree == NULL);
+    slp->tree = avl_create(comp_segment_entry, NULL, &avl_xallocator);
+    assert(slp->tree != NULL);
+    for (ip = slp->first; ip != NULL; ip = ip->next) {
+        aa = avl_probe(slp->tree, (SEGINFO *) ip->d);
+        assert(aa != NULL);
+    }
+}
+
+/**********************************************************************/
+
+PAGEINFO *find_pageinfo(LIST * plp, unsigned long pagenum)
+{
+    PAGEINFO tmp;
+    tmp.pagenum = pagenum;
+    assert(plp->tree != NULL);
+    return (PAGEINFO *) avl_find(plp->tree, &tmp);
+}
+
+SEGINFO *find_seginfo(LIST * slp, unsigned long segnum)
+{
+    SEGINFO tmp;
+    tmp.segnum = segnum;
+    assert(slp->tree != NULL);
+    return (SEGINFO *) avl_find(slp->tree, &tmp);
+}
+
+/**********************************************************************/
+
+unsigned int read2bytes(FILE * f)
+{
+    unsigned int c = ygetc(f);
+    return (c << 8) + ygetc(f);
+}
+
+unsigned long read4bytes(FILE * f)
+{
+    unsigned int l = read2bytes(f);
+    return (l << 16) + read2bytes(f);
+}
+
+/**********************************************************************/
+
+unsigned long getstreamlen(LITEM * slip, boolean refer)
+{
+    SEGINFO *sip;
+    unsigned long len = 0;
+    for (; slip != NULL; slip = slip->next) {
+        sip = slip->d;
+        if (refer || sip->isrefered)
+            len += sip->hdrend - sip->hdrstart + sip->dataend - sip->datastart;
+    }
+    return len;
+}
+
+/**********************************************************************/
+
+void readfilehdr(FILEINFO * fip)
+{
+    unsigned int i;
+    /* Annex D.4 File header syntax */
+    /* Annex D.4.1 ID string */
+    unsigned char jbig2_id[] = { 0x97, 'J', 'B', '2', 0x0d, 0x0a, 0x1a, 0x0a };
+    xfseek(fip->file, 0, SEEK_SET, fip->filepath);
+    for (i = 0; i < 8; i++)
+        if (ygetc(fip->file) != jbig2_id[i])
+            pdftex_fail
+                ("readfilehdr(): reading JBIG2 image file failed: ID string missing");
+    /* Annex D.4.2 File header flags */
+    fip->filehdrflags = ygetc(fip->file);
+    fip->sequentialaccess = (fip->filehdrflags & 0x01) ? true : false;
+    if (fip->sequentialaccess) {        /* Annex D.1 vs. Annex D.2 */
+        xfseek(fip->file, 0, SEEK_END, fip->filepath);
+        fip->filesize = xftell(fip->file, fip->filepath);
+        xfseek(fip->file, 9, SEEK_SET, fip->filepath);
+    }
+    /* Annex D.4.3 Number of pages */
+    if (!(fip->filehdrflags >> 1) & 0x01)       /* known number of pages */
+        fip->numofpages = read4bytes(fip->file);
+    /* --- at end of file header --- */
+}
+
+/**********************************************************************/
+/* for first reading of file; return value tells if header been read */
+
+boolean readseghdr(FILEINFO * fip, SEGINFO * sip)
+{
+    unsigned int i;
+    sip->hdrstart = xftell(fip->file, fip->filepath);
+    if (fip->sequentialaccess && sip->hdrstart == fip->filesize)
+        return false;           /* no endoffileflag is ok for sequentialaccess */
+#ifdef DEBUG
+    printf("\nhdrstart %d\n", sip->hdrstart);
+#endif
+    /* 7.2.2 Segment number */
+    sip->segnum = read4bytes(fip->file);
+#ifdef DEBUG
+    printf("  segnum %d\n", sip->segnum);
+#endif
+    /* 7.2.3 Segment header flags */
+    sip->seghdrflags = ygetc(fip->file);
+#ifdef DEBUG
+    printf("  hdrflags %d\n", sip->seghdrflags & 0x3f);
+#endif
+    checkseghdrflags(sip);
+    if (fip->sequentialaccess && sip->endoffileflag)    /* accept shorter segment, */
+        return true;            /* makes it compliant with Example 3.4 of PDFRef. 5th ed. */
+    sip->pageassocsizeflag = ((sip->seghdrflags >> 6) & 0x01) ? true : false;
+    /* 7.2.4 Referred-to segment count and retention flags */
+    sip->reftosegcount = (unsigned int) ygetc(fip->file);
+    sip->countofrefered = sip->reftosegcount >> 5;
+    if (sip->countofrefered < 5)
+        sip->fieldlen = 1;
+    else {
+        sip->fieldlen = 5 + sip->countofrefered / 8;
+        xfseek(fip->file, sip->fieldlen - 1, SEEK_CUR, fip->filepath);
+    }
+    /* 7.2.5 Referred-to segment numbers */
+    if (sip->segnum <= 256)
+        sip->segnumwidth = 1;
+    else if (sip->segnum <= 65536)
+        sip->segnumwidth = 2;
+    else
+        sip->segnumwidth = 4;
+    for (i = 0; i < sip->countofrefered; i++) {
+        switch (sip->segnumwidth) {
+        case 1:
+            (void) ygetc(fip->file);
+            break;
+        case 2:
+            (void) read2bytes(fip->file);
+            break;
+        case 4:
+            (void) read4bytes(fip->file);
+            break;
+        }
+    }
+    /* 7.2.6 Segment page association */
+    if (sip->pageassocsizeflag)
+        sip->segpage = read4bytes(fip->file);
+    else
+        sip->segpage = ygetc(fip->file);
+    /* 7.2.7 Segment data length */
+    sip->segdatalen = read4bytes(fip->file);
+    sip->hdrend = xftell(fip->file, fip->filepath);
+    /* ---- at end of segment header ---- */
+    return true;
+}
+
+/**********************************************************************/
+/* for writing, marks refered page0 segments, sets segpage > 0 to 1 */
+
+void writeseghdr(FILEINFO * fip, SEGINFO * sip)
+{
+    unsigned int i;
+    unsigned long referedseg = 0;
+    /* 7.2.2 Segment number */
+    /* 7.2.3 Segment header flags */
+    /* 7.2.4 Referred-to segment count and retention flags */
+    for (i = 0; i < 5 + sip->fieldlen; i++)
+        pdfout(ygetc(fip->file));
+    /* 7.2.5 Referred-to segment numbers */
+    for (i = 0; i < sip->countofrefered; i++) {
+        switch (sip->segnumwidth) {
+        case 1:
+            referedseg = ygetc(fip->file);
+            pdfout(referedseg);
+            break;
+        case 2:
+            referedseg = read2bytes(fip->file);
+            pdfout((referedseg >> 8) & 0xff);
+            pdfout(referedseg & 0xff);
+            break;
+        case 4:
+            referedseg = read4bytes(fip->file);
+            pdfout((referedseg >> 24) & 0xff);
+            pdfout((referedseg >> 16) & 0xff);
+            pdfout((referedseg >> 8) & 0xff);
+            pdfout(referedseg & 0xff);
+            break;
+        }
+        if (fip->page0.last != NULL && !sip->refers)
+            markpage0seg(fip, referedseg);
+    }
+    if (sip->countofrefered > 0)
+        sip->refers = true;
+    /* 7.2.6 Segment page association */
+    if (sip->pageassocsizeflag)
+        for (i = 0; i < 3; i++) {
+            (void) ygetc(fip->file);
+            pdfout(0);
+        }
+    (void) ygetc(fip->file);
+    pdfout((sip->segpage > 0) ? 1 : 0);
+    /* 7.2.7 Segment data length */
+    for (i = 0; i < 4; i++)
+        pdfout(ygetc(fip->file));
+    /* ---- at end of segment header ---- */
+}
+
+/**********************************************************************/
+/* for recursive marking of refered page0 segments */
+
+void checkseghdr(FILEINFO * fip, SEGINFO * sip)
+{
+    unsigned int i;
+    unsigned long referedseg = 0;
+    /* 7.2.2 Segment number */
+    /* 7.2.3 Segment header flags */
+    /* 7.2.4 Referred-to segment count and retention flags */
+    xfseek(fip->file, 5 + sip->fieldlen, SEEK_CUR, fip->filepath);
+    /* 7.2.5 Referred-to segment numbers */
+    for (i = 0; i < sip->countofrefered; i++) {
+        switch (sip->segnumwidth) {
+        case 1:
+            referedseg = ygetc(fip->file);
+            break;
+        case 2:
+            referedseg = read2bytes(fip->file);
+            break;
+        case 4:
+            referedseg = read4bytes(fip->file);
+            break;
+        }
+        if (!sip->refers)
+            markpage0seg(fip, referedseg);
+    }
+    if (sip->countofrefered > 0)
+        sip->refers = true;
+    /* 7.2.6 Segment page association */
+    /* 7.2.7 Segment data length */
+    if (sip->pageassocsizeflag)
+        xfseek(fip->file, 8, SEEK_CUR, fip->filepath);
+    else
+        xfseek(fip->file, 5, SEEK_CUR, fip->filepath);
+    /* ---- at end of segment header ---- */
+}
+
+/**********************************************************************/
+
+void checkseghdrflags(SEGINFO * sip)
+{
+    sip->endofstripeflag = false;
+    sip->endofpageflag = false;
+    sip->pageinfoflag = false;
+    sip->endoffileflag = false;
+    /* 7.3 Segment types */
+    switch (sip->seghdrflags & 0x3f) {
+    case M_SymbolDictionary:
+    case M_IntermediateTextRegion:
+    case M_ImmediateTextRegion:
+    case M_ImmediateLosslessTextRegion:
+    case M_PatternDictionary:
+    case M_IntermediateHalftoneRegion:
+    case M_ImmediateHalftoneRegion:
+    case M_ImmediateLosslessHalftoneRegion:
+    case M_IntermediateGenericRegion:
+    case M_ImmediateGenericRegion:
+    case M_ImmediateLosslessGenericRegion:
+    case M_IntermediateGenericRefinementRegion:
+    case M_ImmediateGenericRefinementRegion:
+    case M_ImmediateLosslessGenericRefinementRegion:
+        break;
+    case M_PageInformation:
+        sip->pageinfoflag = true;
+        break;
+    case M_EndOfPage:
+        sip->endofpageflag = true;
+        break;
+    case M_EndOfStripe:
+        sip->endofstripeflag = true;
+        break;
+    case M_EndOfFile:
+        sip->endoffileflag = true;
+        break;
+    case M_Profiles:
+    case M_Tables:
+    case M_Extension:
+        break;
+    default:
+        pdftex_fail
+            ("checkseghdrflags(): unknown segment type in JBIG2 image file");
+        break;
+    }
+}
+
+/**********************************************************************/
+
+void markpage0seg(FILEINFO * fip, unsigned long referedseg)
+{
+    PAGEINFO *pip;
+    SEGINFO *sip;
+    pip = fip->page0.first->d;
+    sip = find_seginfo(&(pip->segments), referedseg);
+    if (sip != NULL) {
+        if (!sip->refers && sip->countofrefered > 0)
+            checkseghdr(fip, sip);
+        sip->isrefered = true;
+    }
+}
+
+/**********************************************************************/
+
+unsigned long findstreamstart(FILEINFO * fip)
+{
+    SEGINFO tmp;
+    assert(!fip->sequentialaccess);     /* D.2 Random-access organisation */
+    do                          /* find random-access stream start */
+        (void) readseghdr(fip, &tmp);
+    while (!tmp.endoffileflag);
+    fip->streamstart = tmp.hdrend;
+    readfilehdr(fip);
+    return fip->streamstart;
+}
+
+/**********************************************************************/
+
+void rd_jbig2_info(FILEINFO * fip)
+{
+    unsigned long seekdist = 0; /* for sequential-access only */
+    unsigned long streampos = 0;        /* for random-access only */
+    unsigned long currentpage = 0;
+    boolean sipavail = false;
+    PAGEINFO *pip;
+    SEGINFO *sip = NULL;
+    LIST *plp, *slp;
+    fip->file = xfopen(fip->filepath, FOPEN_RBIN_MODE);
+    readfilehdr(fip);
+    if (!fip->sequentialaccess) /* D.2 Random-access organisation */
+        streampos = findstreamstart(fip);
+    while (true) {              /* loop over segments */
+        if (!sipavail) {
+            sip = xtalloc(1, SEGINFO);
+            sipavail = true;
+        }
+        init_seginfo(sip);
+        if (!readseghdr(fip, sip) || sip->endoffileflag)
+            break;
+        if (sip->segpage > 0) {
+            if (sip->segpage > currentpage) {
+                plp = litem_append(&(fip->pages));
+                plp->last->d = new_pageinfo();
+                currentpage = sip->segpage;
+            }
+            pip = fip->pages.last->d;
+        } else {
+            if (fip->page0.last == NULL) {
+                plp = litem_append(&(fip->page0));
+                plp->last->d = new_pageinfo();
+            }
+            pip = fip->page0.last->d;
+        }
+        if (!sip->endofpageflag) {
+            slp = litem_append(&(pip->segments));
+            slp->last->d = sip;
+            sipavail = false;
+        }
+        if (!fip->sequentialaccess)
+            sip->datastart = streampos;
+        else
+            sip->datastart = sip->hdrend;
+        sip->dataend = sip->datastart + sip->segdatalen;
+        if (!fip->sequentialaccess
+            && (sip->pageinfoflag || sip->endofstripeflag))
+            xfseek(fip->file, sip->datastart, SEEK_SET, fip->filepath);
+        seekdist = sip->segdatalen;
+        /* 7.4.8 Page information segment syntax */
+        if (sip->pageinfoflag) {
+            pip->pagenum = sip->segpage;
+            pip->width = read4bytes(fip->file);
+            pip->height = read4bytes(fip->file);
+            pip->xres = read4bytes(fip->file);
+            pip->yres = read4bytes(fip->file);
+            pip->pagesegmentflags = ygetc(fip->file);
+            /* 7.4.8.6 Page striping information */
+            pip->stripinginfo = read2bytes(fip->file);
+            seekdist -= 19;
+        }
+        if (sip->endofstripeflag) {
+            pip->stripedheight = read4bytes(fip->file);
+            seekdist -= 4;
+        }
+        if (!fip->sequentialaccess
+            && (sip->pageinfoflag || sip->endofstripeflag))
+            xfseek(fip->file, sip->hdrend, SEEK_SET, fip->filepath);
+        if (!fip->sequentialaccess)
+            streampos += sip->segdatalen;
+        if (fip->sequentialaccess)
+            xfseek(fip->file, seekdist, SEEK_CUR, fip->filepath);
+        if (sip->endofpageflag && currentpage && (pip->stripinginfo >> 15))
+            pip->height = pip->stripedheight;
+    }
+    fip->phase = HAVEINFO;
+    if (sipavail)
+        xfree(sip);
+    xfclose(fip->file, fip->filepath);
+}
+
+/**********************************************************************/
+
+void wr_jbig2(FILEINFO * fip, unsigned long page)
+{
+    LITEM *slip;
+    PAGEINFO *pip;
+    SEGINFO *sip;
+    unsigned long i;
+    if (page > 0) {
+        pip = find_pageinfo(&(fip->pages), page);
+        assert(pip != NULL);
+        pdf_puts("/Type /XObject\n/Subtype /Image\n");
+        pdf_printf("/Width %i\n", pip->width);
+        pdf_printf("/Height %i\n", pip->height);
+        pdf_puts("/ColorSpace /DeviceGray\n");
+        pdf_puts("/BitsPerComponent 1\n");
+        pdf_printf("/Length %lu\n", getstreamlen(pip->segments.first, true));
+        pdf_puts("/Filter [/JBIG2Decode]\n");
+        if (fip->page0.last != NULL) {
+            if (fip->pdfpage0objnum == 0) {
+                pdf_create_obj(0, 0);
+                fip->pdfpage0objnum = obj_ptr;
+            }
+            pdf_printf("/DecodeParms [<< /JBIG2Globals %lu 0 R >>]\n",
+                       fip->pdfpage0objnum);
+        }
+    } else {
+        pip = find_pageinfo(&(fip->page0), page);
+        assert(pip != NULL);
+        pdf_begin_dict(fip->pdfpage0objnum, 0);
+        pdf_printf("/Length %lu\n", getstreamlen(pip->segments.first, false));
+    }
+    pdf_puts(">>\n");
+    pdf_puts("stream\n");
+    fip->file = xfopen(fip->filepath, FOPEN_RBIN_MODE);
+    for (slip = pip->segments.first; slip != NULL; slip = slip->next) { /* loop over page segments */
+        sip = slip->d;
+        if (sip->isrefered || page > 0) {
+            xfseek(fip->file, sip->hdrstart, SEEK_SET, fip->filepath);
+            /* mark refered-to page 0 segments, change segpages > 1 to 1 */
+            writeseghdr(fip, sip);
+            xfseek(fip->file, sip->datastart, SEEK_SET, fip->filepath);
+            for (i = sip->datastart; i < sip->dataend; i++)
+                pdfout(ygetc(fip->file));
+        }
+    }
+    pdf_end_stream();
+    xfclose(fip->file, fip->filepath);
+}
+
+/**********************************************************************/
+
+void read_jbig2_info(image_dict * idict)
+{
+    FILEINFO *fip, tmp;
+    PAGEINFO *pip;
+    void **aa;
+    assert(idict != NULL);
+    img_type(idict) = IMAGE_TYPE_JBIG2;
+    if (img_pagenum(idict) < 1)
+        pdftex_fail
+            ("read_jbig2_info(): page %d not in JBIG2 image file; page must be > 0",
+             (int) img_pagenum(idict));
+    if (file_tree == NULL) {
+        file_tree = avl_create(comp_file_entry, NULL, &avl_xallocator);
+        assert(file_tree != NULL);
+    }
+    tmp.filepath = img_filepath(idict);
+    fip = (FILEINFO *) avl_find(file_tree, &tmp);
+    if (fip == NULL) {
+        fip = new_fileinfo();
+        fip->filepath = xstrdup(img_filepath(idict));
+        aa = avl_probe(file_tree, fip);
+        assert(aa != NULL);
+    }
+    if (fip->phase == INITIAL) {
+        rd_jbig2_info(fip);
+        pages_maketree(&(fip->pages));
+        if (fip->page0.last != NULL) {
+            pages_maketree(&(fip->page0));
+            pip = fip->page0.first->d;
+            segments_maketree(&(pip->segments));
+        }
+    }
+    pip = find_pageinfo(&(fip->pages), img_pagenum(idict));
+    if (pip == NULL)
+        pdftex_fail("read_jbig2_info(): page %d not found in JBIG2 image file",
+                    (int) img_pagenum(idict));
+    img_xsize(idict) = pip->width;
+    img_ysize(idict) = pip->height;
+    img_xres(idict) = (int) (pip->xres * 0.0254 + 0.5);
+    img_yres(idict) = (int) (pip->yres * 0.0254 + 0.5);
+    img_colordepth(idict) = 1;
+}
+
+/**********************************************************************/
+
+void write_jbig2(image_dict * idict)
+{
+    FILEINFO *fip, tmp;
+    PAGEINFO *pip;
+    assert(idict != NULL);
+    assert(file_tree != NULL);
+    tmp.filepath = img_filepath(idict);
+    fip = (FILEINFO *) avl_find(file_tree, &tmp);
+    assert(fip != NULL);
+    assert(fip->phase == HAVEINFO);     /* don't write before rd_jbig2_info() call */
+    pip = find_pageinfo(&(fip->pages), img_pagenum(idict));
+    assert(pip != NULL);
+    wr_jbig2(fip, pip->pagenum);
+    img_file(idict) = NULL;
+}
+
+/**********************************************************************/
+
+void flush_jbig2_page0_objects()
+{
+    FILEINFO *fip;
+    struct avl_traverser t;
+    if (file_tree != NULL) {
+        avl_t_init(&t, file_tree);
+        for (fip = avl_t_first(&t, file_tree); fip != NULL;
+             fip = avl_t_next(&t)) {
+            if (fip->page0.last != NULL)
+                wr_jbig2(fip, 0);
+        }
+    }
+}
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/luatexdir/image/writejbig2.h b/Build/source/texk/web2c/luatexdir/image/writejbig2.h
new file mode 100644
index 00000000000..c1bec32d859
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/writejbig2.h
@@ -0,0 +1,151 @@
+/***********************************************************************
+Copyright (c) 2002-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software Foundation, Inc., 59
+Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+This is experimental JBIG2 image support to pdfTeX. JBIG2 image decoding
+is part of Adobe PDF-1.4, and requires Acroread 5.0 or later.
+
+$Id: writejbig2.h 1012 2008-02-14 00:00:57Z oneiros $
+***********************************************************************/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <assert.h>
+#include "ptexlib.h"
+#include "ptexmac.h"
+#include "image.h"
+
+/* 7.3 Segment types */
+#define M_SymbolDictionary 0
+#define M_IntermediateTextRegion 4
+#define M_ImmediateTextRegion 6
+#define M_ImmediateLosslessTextRegion 7
+#define M_PatternDictionary 16
+#define M_IntermediateHalftoneRegion 20
+#define M_ImmediateHalftoneRegion 22
+#define M_ImmediateLosslessHalftoneRegion 23
+#define M_IntermediateGenericRegion 36
+#define M_ImmediateGenericRegion 38
+#define M_ImmediateLosslessGenericRegion 39
+#define M_IntermediateGenericRefinementRegion 40
+#define M_ImmediateGenericRefinementRegion 42
+#define M_ImmediateLosslessGenericRefinementRegion 43
+#define M_PageInformation 48
+#define M_EndOfPage 49
+#define M_EndOfStripe 50
+#define M_EndOfFile 51
+#define M_Profiles 52
+#define M_Tables 53
+#define M_Extension 62
+
+/**********************************************************************/
+
+typedef enum { INITIAL, HAVEINFO, WRITEPDF } PHASE;
+
+typedef struct _LITEM {
+    struct _LITEM *prev;
+    struct _LITEM *next;
+    void *d;                    /* data */
+} LITEM;
+
+typedef struct _LIST {
+    LITEM *first;
+    LITEM *last;
+    struct avl_table *tree;
+} LIST;
+
+typedef struct _SEGINFO {
+    unsigned long segnum;
+    boolean isrefered;
+    boolean refers;
+    unsigned int seghdrflags;   /* set by readseghdr() */
+    boolean pageassocsizeflag;  /* set by readseghdr() */
+    unsigned int reftosegcount; /* set by readseghdr() */
+    unsigned int countofrefered;        /* set by readseghdr() */
+    unsigned int fieldlen;      /* set by readseghdr() */
+    unsigned int segnumwidth;   /* set by readseghdr() */
+    long segpage;               /* set by readseghdr() */
+    unsigned long segdatalen;   /* set by readseghdr() */
+    unsigned long hdrstart;     /* set by readseghdr() */
+    unsigned long hdrend;       /* set by readseghdr() */
+    unsigned long datastart;
+    unsigned long dataend;
+    boolean endofstripeflag;    /* set by checkseghdrflags() */
+    boolean endofpageflag;      /* set by checkseghdrflags() */
+    boolean pageinfoflag;       /* set by checkseghdrflags() */
+    boolean endoffileflag;      /* set by checkseghdrflags() */
+} SEGINFO;
+
+typedef struct _PAGEINFO {
+    LIST segments;              /* segments associated with page */
+    unsigned long pagenum;
+    unsigned int width;
+    unsigned int height;
+    unsigned int xres;
+    unsigned int yres;
+    unsigned int pagesegmentflags;
+    unsigned int stripinginfo;
+    unsigned int stripedheight;
+} PAGEINFO;
+
+typedef struct _FILEINFO {
+    FILE *file;
+    char *filepath;
+    long filesize;
+    LIST pages;                 /* not including page0 */
+    LIST page0;
+    unsigned int filehdrflags;  /* set by readfilehdr() */
+    boolean sequentialaccess;   /* set by readfilehdr() */
+    unsigned long numofpages;   /* set by readfilehdr() */
+    unsigned long streamstart;  /* set by get_jbig2_info() */
+    unsigned long pdfpage0objnum;
+    PHASE phase;
+} FILEINFO;
+
+/**********************************************************************/
+
+static int comp_file_entry(const void *, const void *, void *);
+static int comp_page_entry(const void *, const void *, void *);
+static int comp_segment_entry(const void *, const void *, void *);
+int ygetc(FILE *);
+FILEINFO *new_fileinfo();
+PAGEINFO *new_pageinfo();
+void initseginfo(SEGINFO *);
+void initlinkedlist(LIST *);
+LIST *litem_append(LIST *);
+void pages_maketree(LIST *);
+void segments_maketree(LIST *);
+PAGEINFO *find_pageinfo(LIST *, unsigned long);
+SEGINFO *find_seginfo(LIST *, unsigned long);
+unsigned int read2bytes(FILE *);
+unsigned long read4bytes(FILE *);
+unsigned long getstreamlen(LITEM *, boolean);
+void readfilehdr(FILEINFO *);
+boolean readseghdr(FILEINFO *, SEGINFO *);
+void writeseghdr(FILEINFO *, SEGINFO *);
+void checkseghdr(FILEINFO *, SEGINFO *);
+void checkseghdrflags(SEGINFO * sip);
+void markpage0seg(FILEINFO *, unsigned long);
+unsigned long findstreamstart(FILEINFO *);
+void rd_jbig2_info(FILEINFO *);
+void wr_jbig2(FILEINFO *, unsigned long);
+void read_jbig2_info(image_dict *);
+void write_jbig2(image_dict *);
+void flushjbig2page0objects();
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/luatexdir/image/writejpg.c b/Build/source/texk/web2c/luatexdir/image/writejpg.c
new file mode 100644
index 00000000000..422c29470fb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/writejpg.c
@@ -0,0 +1,277 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writejpg.c 1100 2008-03-09 13:40:48Z hhenkel $
+*/
+
+#include <assert.h>
+#include "ptexlib.h"
+#include "image.h"
+
+#define JPG_GRAY  1             /* Gray color space, use /DeviceGray  */
+#define JPG_RGB   3             /* RGB color space, use /DeviceRGB    */
+#define JPG_CMYK  4             /* CMYK color space, use /DeviceCMYK  */
+
+typedef enum {                  /* JPEG marker codes                    */
+    M_SOF0 = 0xc0,              /* baseline DCT                         */
+    M_SOF1 = 0xc1,              /* extended sequential DCT              */
+    M_SOF2 = 0xc2,              /* progressive DCT                      */
+    M_SOF3 = 0xc3,              /* lossless (sequential)                */
+
+    M_SOF5 = 0xc5,              /* differential sequential DCT          */
+    M_SOF6 = 0xc6,              /* differential progressive DCT         */
+    M_SOF7 = 0xc7,              /* differential lossless                */
+
+    M_JPG = 0xc8,               /* JPEG extensions                      */
+    M_SOF9 = 0xc9,              /* extended sequential DCT              */
+    M_SOF10 = 0xca,             /* progressive DCT                      */
+    M_SOF11 = 0xcb,             /* lossless (sequential)                */
+
+    M_SOF13 = 0xcd,             /* differential sequential DCT          */
+    M_SOF14 = 0xce,             /* differential progressive DCT         */
+    M_SOF15 = 0xcf,             /* differential lossless                */
+
+    M_DHT = 0xc4,               /* define Huffman tables                */
+
+    M_DAC = 0xcc,               /* define arithmetic conditioning table */
+
+    M_RST0 = 0xd0,              /* restart                              */
+    M_RST1 = 0xd1,              /* restart                              */
+    M_RST2 = 0xd2,              /* restart                              */
+    M_RST3 = 0xd3,              /* restart                              */
+    M_RST4 = 0xd4,              /* restart                              */
+    M_RST5 = 0xd5,              /* restart                              */
+    M_RST6 = 0xd6,              /* restart                              */
+    M_RST7 = 0xd7,              /* restart                              */
+
+    M_SOI = 0xd8,               /* start of image                       */
+    M_EOI = 0xd9,               /* end of image                         */
+    M_SOS = 0xda,               /* start of scan                        */
+    M_DQT = 0xdb,               /* define quantization tables           */
+    M_DNL = 0xdc,               /* define number of lines               */
+    M_DRI = 0xdd,               /* define restart interval              */
+    M_DHP = 0xde,               /* define hierarchical progression      */
+    M_EXP = 0xdf,               /* expand reference image(s)            */
+
+    M_APP0 = 0xe0,              /* application marker, used for JFIF    */
+    M_APP1 = 0xe1,              /* application marker                   */
+    M_APP2 = 0xe2,              /* application marker                   */
+    M_APP3 = 0xe3,              /* application marker                   */
+    M_APP4 = 0xe4,              /* application marker                   */
+    M_APP5 = 0xe5,              /* application marker                   */
+    M_APP6 = 0xe6,              /* application marker                   */
+    M_APP7 = 0xe7,              /* application marker                   */
+    M_APP8 = 0xe8,              /* application marker                   */
+    M_APP9 = 0xe9,              /* application marker                   */
+    M_APP10 = 0xea,             /* application marker                   */
+    M_APP11 = 0xeb,             /* application marker                   */
+    M_APP12 = 0xec,             /* application marker                   */
+    M_APP13 = 0xed,             /* application marker                   */
+    M_APP14 = 0xee,             /* application marker, used by Adobe    */
+    M_APP15 = 0xef,             /* application marker                   */
+
+    M_JPG0 = 0xf0,              /* reserved for JPEG extensions         */
+    M_JPG13 = 0xfd,             /* reserved for JPEG extensions         */
+    M_COM = 0xfe,               /* comment                              */
+
+    M_TEM = 0x01,               /* temporary use                        */
+
+    M_ERROR = 0x100             /* dummy marker, internal use only      */
+} JPEG_MARKER;
+
+static JPG_UINT16 read2bytes(FILE * f)
+{
+    int c = xgetc(f);
+    return (c << 8) + xgetc(f);
+}
+
+void close_and_cleanup_jpg(image_dict * idict)
+{
+    assert(idict != NULL);
+    assert(img_file(idict) != NULL);
+    assert(img_filepath(idict) != NULL);
+    xfclose(img_file(idict), img_filepath(idict));
+    img_file(idict) = NULL;
+    assert(img_jpg_ptr(idict) != NULL);
+    xfree(img_jpg_ptr(idict));
+    img_jpg_ptr(idict) = NULL;
+}
+
+void read_jpg_info(image_dict * idict, img_readtype_e readtype)
+{
+    int i, units = 0;
+    unsigned char jpg_id[] = "JFIF";
+    assert(idict != NULL);
+    assert(img_type(idict) == IMAGE_TYPE_JPG);
+    img_totalpages(idict) = 1;
+    img_pagenum(idict) = 1;
+    img_xres(idict) = img_yres(idict) = 0;
+    assert(img_file(idict) == NULL);
+    img_file(idict) = xfopen(img_filepath(idict), FOPEN_RBIN_MODE);
+    assert(img_jpg_ptr(idict) == NULL);
+    img_jpg_ptr(idict) = xtalloc(1, jpg_img_struct);
+    xfseek(img_file(idict), 0, SEEK_END, img_filepath(idict));
+    img_jpg_ptr(idict)->length = xftell(img_file(idict), img_filepath(idict));
+    xfseek(img_file(idict), 0, SEEK_SET, img_filepath(idict));
+    if (read2bytes(img_file(idict)) != 0xFFD8)
+        pdftex_fail("reading JPEG image failed (no JPEG header found)");
+    /* currently only true JFIF files allow extracting img_xres and img_yres */
+    if (read2bytes(img_file(idict)) == 0xFFE0) {        /* check for JFIF */
+        (void) read2bytes(img_file(idict));
+        for (i = 0; i < 5; i++) {
+            if (xgetc(img_file(idict)) != jpg_id[i])
+                break;
+        }
+        if (i == 5) {           /* it's JFIF */
+            read2bytes(img_file(idict));
+            units = xgetc(img_file(idict));
+            img_xres(idict) = read2bytes(img_file(idict));
+            img_yres(idict) = read2bytes(img_file(idict));
+            switch (units) {
+            case 1:
+                break;          /* pixels per inch */
+            case 2:
+                img_xres(idict) *= 2.54;
+                img_yres(idict) *= 2.54;
+                break;          /* pixels per cm */
+            default:
+                img_xres(idict) = img_yres(idict) = 0;
+                break;
+            }
+        }
+    }
+    xfseek(img_file(idict), 0, SEEK_SET, img_filepath(idict));
+    while (1) {
+        if (feof(img_file(idict)))
+            pdftex_fail("reading JPEG image failed (premature file end)");
+        if (fgetc(img_file(idict)) != 0xFF)
+            pdftex_fail("reading JPEG image failed (no marker found)");
+        switch (xgetc(img_file(idict))) {
+        case M_SOF5:
+        case M_SOF6:
+        case M_SOF7:
+        case M_SOF9:
+        case M_SOF10:
+        case M_SOF11:
+        case M_SOF13:
+        case M_SOF14:
+        case M_SOF15:
+            pdftex_fail("unsupported type of compression");
+        case M_SOF2:
+            if (fixed_pdf_minor_version <= 2)
+                pdftex_fail("cannot use progressive DCT with PDF-1.2");
+        case M_SOF0:
+        case M_SOF1:
+        case M_SOF3:
+            (void) read2bytes(img_file(idict)); /* read segment length  */
+            img_colordepth(idict) = xgetc(img_file(idict));
+            img_ysize(idict) = read2bytes(img_file(idict));
+            img_xsize(idict) = read2bytes(img_file(idict));
+            img_jpg_color(idict) = xgetc(img_file(idict));
+            xfseek(img_file(idict), 0, SEEK_SET, img_filepath(idict));
+            switch (img_jpg_color(idict)) {
+            case JPG_GRAY:
+                img_color(idict) = IMAGE_COLOR_B;
+                break;
+            case JPG_RGB:
+                img_color(idict) = IMAGE_COLOR_C;
+                break;
+            case JPG_CMYK:
+                img_color(idict) = IMAGE_COLOR_C;
+                break;
+            default:
+                pdftex_fail("Unsupported color space %i",
+                            (int) img_jpg_color(idict));
+            }
+            if (readtype == IMG_CLOSEINBETWEEN)
+                close_and_cleanup_jpg(idict);
+            return;
+        case M_SOI:            /* ignore markers without parameters */
+        case M_EOI:
+        case M_TEM:
+        case M_RST0:
+        case M_RST1:
+        case M_RST2:
+        case M_RST3:
+        case M_RST4:
+        case M_RST5:
+        case M_RST6:
+        case M_RST7:
+            break;
+        default:               /* skip variable length markers */
+            xfseek(img_file(idict), read2bytes(img_file(idict)) - 2,
+                   SEEK_CUR, img_filepath(idict));
+            break;
+        }
+    }
+    assert(0);
+}
+
+static void reopen_jpg(image_dict * idict)
+{
+    integer width, height, xres, yres;
+    width = img_xsize(idict);
+    height = img_ysize(idict);
+    xres = img_xres(idict);
+    yres = img_yres(idict);
+    read_jpg_info(idict, IMG_KEEPOPEN);
+    if (width != img_xsize(idict) || height != img_ysize(idict)
+        || xres != img_xres(idict) || yres != img_yres(idict))
+        pdftex_fail("writejpg: image dimensions have changed");
+}
+
+void write_jpg(image_dict * idict)
+{
+    long unsigned l;
+    FILE *f;
+    assert(idict != NULL);
+    if (img_file(idict) == NULL)
+        reopen_jpg(idict);
+    assert(img_jpg_ptr(idict) != NULL);
+    pdf_puts("/Type /XObject\n/Subtype /Image\n");
+    if (img_attr(idict) != NULL && strlen(img_attr(idict)) > 0)
+        pdf_printf("%s\n", img_attr(idict));
+    pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n/Length %i\n",
+               (int) img_xsize(idict),
+               (int) img_ysize(idict),
+               (int) img_colordepth(idict), (int) img_jpg_ptr(idict)->length);
+    pdf_puts("/ColorSpace ");
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        switch (img_jpg_color(idict)) {
+        case JPG_GRAY:
+            pdf_puts("/DeviceGray\n");
+            break;
+        case JPG_RGB:
+            pdf_puts("/DeviceRGB\n");
+            break;
+        case JPG_CMYK:
+            pdf_puts("/DeviceCMYK\n/Decode [1 0 1 0 1 0 1 0]\n");
+            break;
+        default:
+            pdftex_fail("Unsupported color space %i",
+                        (int) img_jpg_color(idict));
+        }
+    }
+    pdf_puts("/Filter /DCTDecode\n>>\nstream\n");
+    for (l = img_jpg_ptr(idict)->length, f = img_file(idict); l > 0; l--)
+        pdfout(xgetc(f));
+    pdf_end_stream();
+    close_and_cleanup_jpg(idict);
+}
diff --git a/Build/source/texk/web2c/luatexdir/image/writepng.c b/Build/source/texk/web2c/luatexdir/image/writepng.c
new file mode 100644
index 00000000000..7f1269d9943
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/image/writepng.c
@@ -0,0 +1,635 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id: writepng.c 1101 2008-03-09 16:12:15Z hhenkel $
+*/
+
+#include <assert.h>
+#include "ptexlib.h"
+#include "image.h"
+
+void close_and_cleanup_png(image_dict * idict)
+{
+    assert(idict != NULL);
+    assert(img_file(idict) != NULL);
+    assert(img_filepath(idict) != NULL);
+    xfclose(img_file(idict), img_filepath(idict));
+    img_file(idict) = NULL;
+    assert(img_png_ptr(idict) != NULL);
+    png_destroy_read_struct(&(img_png_png_ptr(idict)),
+                            &(img_png_info_ptr(idict)), NULL);
+    xfree(img_png_ptr(idict));
+    img_png_ptr(idict) = NULL;
+}
+
+void read_png_info(image_dict * idict, img_readtype_e readtype)
+{
+    double gamma;
+    png_structp png_p;
+    png_infop info_p;
+    assert(idict != NULL);
+    assert(img_type(idict) == IMAGE_TYPE_PNG);
+    img_totalpages(idict) = 1;
+    img_pagenum(idict) = 1;
+    img_xres(idict) = img_yres(idict) = 0;
+    assert(img_file(idict) == NULL);
+    img_file(idict) = xfopen(img_filepath(idict), FOPEN_RBIN_MODE);
+    assert(img_png_ptr(idict) == NULL);
+    img_png_ptr(idict) = xtalloc(1, png_img_struct);
+    if ((png_p = png_create_read_struct(PNG_LIBPNG_VER_STRING,
+                                        NULL, NULL, NULL)) == NULL)
+        pdftex_fail("libpng: png_create_read_struct() failed");
+    img_png_png_ptr(idict) = png_p;
+    if ((info_p = png_create_info_struct(png_p)) == NULL)
+        pdftex_fail("libpng: png_create_info_struct() failed");
+    img_png_info_ptr(idict) = info_p;
+    if (setjmp(png_p->jmpbuf))
+        pdftex_fail("libpng: internal error");
+    png_init_io(png_p, img_file(idict));
+    png_read_info(png_p, info_p);
+    /* simple transparency support */
+    if (png_get_valid(png_p, info_p, PNG_INFO_tRNS)) {
+        png_set_tRNS_to_alpha(png_p);
+    }
+    /* alpha channel support  */
+    if (fixed_pdf_minor_version < 4 && png_p->color_type | PNG_COLOR_MASK_ALPHA)
+        png_set_strip_alpha(png_p);
+    /* 16bit depth support */
+    if (fixed_pdf_minor_version < 5)
+        fixed_image_hicolor = 0;
+    if (info_p->bit_depth == 16 && !fixed_image_hicolor)
+        png_set_strip_16(png_p);
+    /* gamma support */
+    if (fixed_image_apply_gamma) {
+        if (png_get_gAMA(png_p, info_p, &gamma))
+            png_set_gamma(png_p, (fixed_gamma / 1000.0), gamma);
+        else
+            png_set_gamma(png_p, (fixed_gamma / 1000.0),
+                          (1000.0 / fixed_image_gamma));
+    }
+    /* reset structure */
+    png_read_update_info(png_p, info_p);
+    /* resolution support */
+    img_xsize(idict) = info_p->width;
+    img_ysize(idict) = info_p->height;
+    if (info_p->valid & PNG_INFO_pHYs) {
+        img_xres(idict) =
+            round(0.0254 * png_get_x_pixels_per_meter(png_p, info_p));
+        img_yres(idict) =
+            round(0.0254 * png_get_y_pixels_per_meter(png_p, info_p));
+    }
+    switch (info_p->color_type) {
+    case PNG_COLOR_TYPE_PALETTE:
+        img_color(idict) = IMAGE_COLOR_C | IMAGE_COLOR_I;
+        break;
+    case PNG_COLOR_TYPE_GRAY:
+    case PNG_COLOR_TYPE_GRAY_ALPHA:
+        img_color(idict) = IMAGE_COLOR_B;
+        break;
+    case PNG_COLOR_TYPE_RGB:
+    case PNG_COLOR_TYPE_RGB_ALPHA:
+        img_color(idict) = IMAGE_COLOR_C;
+        break;
+    default:
+        pdftex_fail("unsupported type of color_type <%i>", info_p->color_type);
+    }
+    img_colordepth(idict) = info_p->bit_depth;
+    if (readtype == IMG_CLOSEINBETWEEN)
+        close_and_cleanup_png(idict);
+}
+
+#define write_gray_pixel_16(r)                           \
+  if (j % 4 == 0||j % 4 == 1) pdf_buf[pdf_ptr++] = *r++; \
+  else                        smask[smask_ptr++] = *r++
+
+#define write_gray_pixel_8(r)                   \
+    if (j % 2 == 0)  pdf_buf[pdf_ptr++] = *r++; \
+    else  	     smask[smask_ptr++] = *r++
+
+
+#define write_rgb_pixel_16(r)                                  \
+    if (!(j % 8 == 6||j % 8 == 7)) pdf_buf[pdf_ptr++]  = *r++; \
+    else                           smask[smask_ptr++] = *r++
+
+#define write_rgb_pixel_8(r)                   \
+    if (j % 4 != 3) pdf_buf[pdf_ptr++] = *r++; \
+    else            smask[smask_ptr++] = *r++
+
+#define write_simple_pixel(r)    pdf_buf[pdf_ptr++] = *r++
+
+#define write_noninterlaced(outmac)                      \
+  for (i = 0; (unsigned) i < (int)info_p->height; i++) { \
+    png_read_row(png_p, row, NULL);                      \
+    r = row;                                             \
+    k = info_p->rowbytes;                                \
+    while(k > 0) {                                       \
+	l = (k > pdf_buf_size)? pdf_buf_size : k;        \
+		pdfroom(l);                              \
+		for (j = 0; j < l; j++) {                \
+		  outmac;	                         \
+		}                                        \
+		k -= l;                                  \
+	    }                                            \
+        }
+
+#define write_interlaced(outmac)                         \
+  for (i = 0; (unsigned) i < (int)info_p->height; i++) { \
+            row = rows[i];                               \
+	    k = info_p->rowbytes;                        \
+	    while(k > 0) {                               \
+		l = (k > pdf_buf_size)? pdf_buf_size : k;\
+		pdfroom(l);                              \
+		for (j = 0; j < l; j++) {                \
+		  outmac;           	                 \
+		}                                        \
+		k -= l;                                  \
+	    }                                            \
+            xfree(rows[i]);                              \
+        }
+
+void write_png_palette(image_dict * idict)
+{
+    int i, j, k, l;
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    png_bytep row, r, *rows;
+    integer palette_objnum = 0;
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        pdf_create_obj(0, 0);
+        palette_objnum = obj_ptr;
+        pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
+                   (int) (info_p->num_palette - 1), (int) palette_objnum);
+    }
+    pdf_begin_stream();
+    if (info_p->interlace_type == PNG_INTERLACE_NONE) {
+        row = xtalloc(info_p->rowbytes, png_byte);
+        write_noninterlaced(write_simple_pixel(r));
+        xfree(row);
+    } else {
+        if (info_p->height * info_p->rowbytes >= 10240000L)
+            pdftex_warn
+                ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+        rows = xtalloc(info_p->height, png_bytep);
+        for (i = 0; (unsigned) i < info_p->height; i++)
+            rows[i] = xtalloc(info_p->rowbytes, png_byte);
+        png_read_image(png_p, rows);
+        write_interlaced(write_simple_pixel(row));
+        xfree(rows);
+    }
+    pdf_end_stream();
+    if (palette_objnum > 0) {
+        pdf_begin_dict(palette_objnum, 0);
+        pdf_begin_stream();
+        for (i = 0; (unsigned) i < info_p->num_palette; i++) {
+            pdfroom(3);
+            pdf_buf[pdf_ptr++] = info_p->palette[i].red;
+            pdf_buf[pdf_ptr++] = info_p->palette[i].green;
+            pdf_buf[pdf_ptr++] = info_p->palette[i].blue;
+        }
+        pdf_end_stream();
+    }
+}
+
+void write_png_gray(image_dict * idict)
+{
+    int i, j, k, l;
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    png_bytep row, r, *rows;
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        pdf_puts("/DeviceGray\n");
+    }
+    pdf_begin_stream();
+    if (info_p->interlace_type == PNG_INTERLACE_NONE) {
+        row = xtalloc(info_p->rowbytes, png_byte);
+        write_noninterlaced(write_simple_pixel(r));
+        xfree(row);
+    } else {
+        if (info_p->height * info_p->rowbytes >= 10240000L)
+            pdftex_warn
+                ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+        rows = xtalloc(info_p->height, png_bytep);
+        for (i = 0; (unsigned) i < info_p->height; i++)
+            rows[i] = xtalloc(info_p->rowbytes, png_byte);
+        png_read_image(png_p, rows);
+        write_interlaced(write_simple_pixel(row));
+        xfree(rows);
+    }
+    pdf_end_stream();
+}
+
+void write_png_gray_alpha(image_dict * idict)
+{
+    int i, j, k, l;
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    png_bytep row, r, *rows;
+    integer smask_objnum = 0;
+    png_bytep smask;
+    integer smask_ptr = 0;
+    integer smask_size = 0;
+    int bitdepth;
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        pdf_puts("/DeviceGray\n");
+    }
+    pdf_create_obj(0, 0);
+    smask_objnum = obj_ptr;
+    pdf_printf("/SMask %i 0 R\n", (int) smask_objnum);
+    smask_size = (info_p->rowbytes / 2) * info_p->height;
+    smask = xtalloc(smask_size, png_byte);
+    pdf_begin_stream();
+    if (info_p->interlace_type == PNG_INTERLACE_NONE) {
+        row = xtalloc(info_p->rowbytes, png_byte);
+        if ((info_p->bit_depth == 16) && fixed_image_hicolor) {
+            write_noninterlaced(write_gray_pixel_16(r));
+        } else {
+            write_noninterlaced(write_gray_pixel_8(r));
+        }
+        xfree(row);
+    } else {
+        if (info_p->height * info_p->rowbytes >= 10240000L)
+            pdftex_warn
+                ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+        rows = xtalloc(info_p->height, png_bytep);
+        for (i = 0; (unsigned) i < info_p->height; i++)
+            rows[i] = xtalloc(info_p->rowbytes, png_byte);
+        png_read_image(png_p, rows);
+        if ((info_p->bit_depth == 16) && fixed_image_hicolor) {
+            write_interlaced(write_gray_pixel_16(row));
+        } else {
+            write_interlaced(write_gray_pixel_8(row));
+        }
+        xfree(rows);
+    }
+    pdf_end_stream();
+    pdf_flush();
+    /* now write the Smask object */
+    bitdepth = (int) info_p->bit_depth;
+    pdf_begin_dict(smask_objnum, 0);
+    pdf_puts("/Type /XObject\n/Subtype /Image\n");
+    if (img_attr(idict) != NULL && strlen(img_attr(idict)) > 0)
+        pdf_printf("%s\n", img_attr(idict));
+    pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+               (int) info_p->width,
+               (int) info_p->height, (bitdepth == 16 ? 8 : bitdepth));
+    pdf_puts("/ColorSpace /DeviceGray\n");
+    pdf_begin_stream();
+    for (i = 0; i < smask_size; i++) {
+        if (i % 8 == 0)
+            pdfroom(8);
+        pdf_buf[pdf_ptr++] = smask[i];
+        if (bitdepth == 16)
+            i++;
+    }
+    pdf_end_stream();
+    xfree(smask);
+}
+
+void write_png_rgb(image_dict * idict)
+{
+    int i, j, k, l;
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    png_bytep row, r, *rows;
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        pdf_puts("/DeviceRGB\n");
+    }
+    pdf_begin_stream();
+    if (info_p->interlace_type == PNG_INTERLACE_NONE) {
+        row = xtalloc(info_p->rowbytes, png_byte);
+        write_noninterlaced(write_simple_pixel(r));
+        xfree(row);
+    } else {
+        if (info_p->height * info_p->rowbytes >= 10240000L)
+            pdftex_warn
+                ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+        rows = xtalloc(info_p->height, png_bytep);
+        for (i = 0; (unsigned) i < info_p->height; i++)
+            rows[i] = xtalloc(info_p->rowbytes, png_byte);
+        png_read_image(png_p, rows);
+        write_interlaced(write_simple_pixel(row));
+        xfree(rows);
+    }
+    pdf_end_stream();
+}
+
+void write_png_rgb_alpha(image_dict * idict)
+{
+    int i, j, k, l;
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    png_bytep row, r, *rows;
+    integer smask_objnum = 0;
+    png_bytep smask;
+    integer smask_ptr = 0;
+    integer smask_size = 0;
+    int bitdepth;
+    if (img_colorspace(idict) != 0) {
+        pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+    } else {
+        pdf_puts("/DeviceRGB\n");
+    }
+    pdf_create_obj(0, 0);
+    smask_objnum = obj_ptr;
+    pdf_printf("/SMask %i 0 R\n", (int) smask_objnum);
+    smask_size = (info_p->rowbytes / 2) * info_p->height;
+    smask = xtalloc(smask_size, png_byte);
+    pdf_begin_stream();
+    if (info_p->interlace_type == PNG_INTERLACE_NONE) {
+        row = xtalloc(info_p->rowbytes, png_byte);
+        if ((info_p->bit_depth == 16) && fixed_image_hicolor) {
+            write_noninterlaced(write_rgb_pixel_16(r));
+        } else {
+            write_noninterlaced(write_rgb_pixel_8(r));
+        }
+        xfree(row);
+    } else {
+        if (info_p->height * info_p->rowbytes >= 10240000L)
+            pdftex_warn
+                ("large interlaced PNG might cause out of memory (use non-interlaced PNG to fix this)");
+        rows = xtalloc(info_p->height, png_bytep);
+        for (i = 0; (unsigned) i < info_p->height; i++)
+            rows[i] = xtalloc(info_p->rowbytes, png_byte);
+        png_read_image(png_p, rows);
+        if ((info_p->bit_depth == 16) && fixed_image_hicolor) {
+            write_interlaced(write_rgb_pixel_16(row));
+        } else {
+            write_interlaced(write_rgb_pixel_8(row));
+        }
+        xfree(rows);
+    }
+    pdf_end_stream();
+    pdf_flush();
+    /* now write the Smask object */
+    if (smask_objnum > 0) {
+        bitdepth = (int) info_p->bit_depth;
+        pdf_begin_dict(smask_objnum, 0);
+        pdf_puts("/Type /XObject\n/Subtype /Image\n");
+        if (img_attr(idict) != NULL)
+            pdf_printf("%s\n", img_attr(idict));
+        pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+                   (int) info_p->width,
+                   (int) info_p->height, (bitdepth == 16 ? 8 : bitdepth));
+        pdf_puts("/ColorSpace /DeviceGray\n");
+        pdf_begin_stream();
+        for (i = 0; i < smask_size; i++) {
+            if (i % 8 == 0)
+                pdfroom(8);
+            pdf_buf[pdf_ptr++] = smask[i];
+            if (bitdepth == 16)
+                i++;
+        }
+        xfree(smask);
+        pdf_end_stream();
+    }
+}
+
+/**********************************************************************/
+/*
+ * The |copy_png| function is from Hartmut Henkel. The goal is to use 
+ * pdf's native FlateDecode support if that is possible.
+ *
+ * Only a subset of the png files allows this, but when possible it
+ * greatly improves inclusion speed. 
+ *
+ * Code cheerfully gleaned from Thomas Merz' PDFlib,
+ * file p_png.c "SPNG - Simple PNG"
+ */
+
+static int spng_getint(FILE * fp)
+{
+    unsigned char buf[4];
+    if (fread(buf, 1, 4, fp) != 4)
+        pdftex_fail("writepng: reading chunk type failed");
+    return ((((((int) buf[0] << 8) + buf[1]) << 8) + buf[2]) << 8) + buf[3];
+}
+
+#define SPNG_CHUNK_IDAT 0x49444154
+#define SPNG_CHUNK_IEND 0x49454E44
+
+void copy_png(image_dict * idict)
+{
+    assert(idict != NULL);
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    FILE *fp = (FILE *) png_p->io_ptr;
+    int i, len, type, streamlength = 0;
+    boolean endflag = false;
+    int idat = 0;               /* flag to check continuous IDAT chunks sequence */
+    /* 1st pass to find overall stream /Length */
+    if (fseek(fp, 8, SEEK_SET) != 0)
+        pdftex_fail("writepng: fseek in PNG file failed");
+    do {
+        len = spng_getint(fp);
+        type = spng_getint(fp);
+        switch (type) {
+        case SPNG_CHUNK_IEND:
+            endflag = true;
+            break;
+        case SPNG_CHUNK_IDAT:
+            streamlength += len;
+        default:
+            if (fseek(fp, len + 4, SEEK_CUR) != 0)
+                pdftex_fail("writepng: fseek in PNG file failed");
+        }
+    } while (endflag == false);
+    pdf_printf("/Length %d\n", streamlength);
+    pdf_printf("/Filter /FlateDecode\n");
+    pdf_printf("/DecodeParms << ");
+    pdf_printf("/Colors %d ", info_p->color_type == 2 ? 3 : 1);
+    pdf_printf("/Columns %d ", (int) info_p->width);
+    pdf_printf("/BitsPerComponent %i ", (int) info_p->bit_depth);
+    pdf_printf("/Predictor %d ", 10);   /* actual predictor defined on line basis */
+    pdf_printf(">>\n>>\nstream\n");
+    /* 2nd pass to copy data */
+    endflag = false;
+    if (fseek(fp, 8, SEEK_SET) != 0)
+        pdftex_fail("writepng: fseek in PNG file failed");
+    do {
+        len = spng_getint(fp);
+        type = spng_getint(fp);
+        switch (type) {
+        case SPNG_CHUNK_IDAT:  /* do copy */
+            if (idat == 2)
+                pdftex_fail("writepng: IDAT chunk sequence broken");
+            idat = 1;
+            while (len > 0) {
+                i = (len > pdf_buf_size) ? pdf_buf_size : len;
+                pdfroom(i);
+                fread(&pdf_buf[pdf_ptr], 1, i, fp);
+                pdf_ptr += i;
+                len -= i;
+            }
+            if (fseek(fp, 4, SEEK_CUR) != 0)
+                pdftex_fail("writepng: fseek in PNG file failed");
+            break;
+        case SPNG_CHUNK_IEND:  /* done */
+            pdf_end_stream();
+            endflag = true;
+            break;
+        default:
+            if (idat == 1)
+                idat = 2;
+            if (fseek(fp, len + 4, SEEK_CUR) != 0)
+                pdftex_fail("writepng: fseek in PNG file failed");
+        }
+    } while (endflag == false);
+}
+
+void reopen_png(image_dict * idict)
+{
+    integer width, height, xres, yres;
+    width = img_xsize(idict);   /* do consistency check */
+    height = img_ysize(idict);
+    xres = img_xres(idict);
+    yres = img_yres(idict);
+    read_png_info(idict, IMG_KEEPOPEN);
+    if (width != img_xsize(idict) || height != img_ysize(idict)
+        || xres != img_xres(idict) || yres != img_yres(idict))
+        pdftex_fail("writepng: image dimensions have changed");
+}
+
+void write_png(image_dict * idict)
+{
+    double gamma, checked_gamma;
+    int i;
+    integer palette_objnum = 0;
+    assert(idict != NULL);
+    if (img_file(idict) == NULL)
+        reopen_png(idict);
+    assert(img_png_ptr(idict) != NULL);
+    png_structp png_p = img_png_png_ptr(idict);
+    png_infop info_p = img_png_info_ptr(idict);
+    if (fixed_pdf_minor_version < 5)
+        fixed_image_hicolor = 0;
+    pdf_puts("/Type /XObject\n/Subtype /Image\n");
+    if (img_attr(idict) != NULL && strlen(img_attr(idict)) > 0)
+        pdf_printf("%s\n", img_attr(idict));
+    pdf_printf("/Width %i\n/Height %i\n/BitsPerComponent %i\n",
+               (int) info_p->width,
+               (int) info_p->height, (int) info_p->bit_depth);
+    pdf_puts("/ColorSpace ");
+    checked_gamma = 1.0;
+    if (fixed_image_apply_gamma) {
+        if (png_get_gAMA(png_p, info_p, &gamma)) {
+            checked_gamma = (fixed_gamma / 1000.0) * gamma;
+        } else {
+            checked_gamma =
+                (fixed_gamma / 1000.0) * (1000.0 / fixed_image_gamma);
+        }
+    }
+    /* the switching between |info_p| and |png_p| queries has been trial and error. 
+     */
+    if (fixed_pdf_minor_version > 1 && info_p->interlace_type == PNG_INTERLACE_NONE && (png_p->transformations == 0 || png_p->transformations == 0x2000)        /* gamma */
+        &&!(png_p->color_type == PNG_COLOR_TYPE_GRAY_ALPHA ||
+            png_p->color_type == PNG_COLOR_TYPE_RGB_ALPHA)
+        && (fixed_image_hicolor || (png_p->bit_depth <= 8))
+        && (checked_gamma <= 1.01 && checked_gamma > 0.99)
+        ) {
+        if (img_colorspace(idict) != 0) {
+            pdf_printf("%i 0 R\n", (int) img_colorspace(idict));
+        } else {
+            switch (info_p->color_type) {
+            case PNG_COLOR_TYPE_PALETTE:
+                pdf_create_obj(0, 0);
+                palette_objnum = obj_ptr;
+                pdf_printf("[/Indexed /DeviceRGB %i %i 0 R]\n",
+                           (int) (info_p->num_palette - 1),
+                           (int) palette_objnum);
+                break;
+            case PNG_COLOR_TYPE_GRAY:
+                pdf_puts("/DeviceGray\n");
+                break;
+            default:           /* RGB */
+                pdf_puts("/DeviceRGB\n");
+            };
+        }
+        if (tracefilenames)
+            tex_printf(" (PNG copy)");
+        copy_png(idict);
+        if (palette_objnum > 0) {
+            pdf_begin_dict(palette_objnum, 0);
+            pdf_begin_stream();
+            for (i = 0; (unsigned) i < info_p->num_palette; i++) {
+                pdfroom(3);
+                pdf_buf[pdf_ptr++] = info_p->palette[i].red;
+                pdf_buf[pdf_ptr++] = info_p->palette[i].green;
+                pdf_buf[pdf_ptr++] = info_p->palette[i].blue;
+            }
+            pdf_end_stream();
+        }
+    } else {
+        if (0) {
+            tex_printf(" PNG copy skipped because: ");
+            if (fixed_image_apply_gamma &&
+                (checked_gamma > 1.01 || checked_gamma < 0.99))
+                tex_printf("gamma delta=%lf ", checked_gamma);
+            if (png_p->transformations != PNG_TRANSFORM_IDENTITY)
+                tex_printf("transform=%lu", (long) png_p->transformations);
+            if ((info_p->color_type != PNG_COLOR_TYPE_GRAY)
+                && (info_p->color_type != PNG_COLOR_TYPE_RGB)
+                && (info_p->color_type != PNG_COLOR_TYPE_PALETTE))
+                tex_printf("colortype ");
+            if (fixed_pdf_minor_version <= 1)
+                tex_printf("version=%d ", (int) fixed_pdf_minor_version);
+            if (info_p->interlace_type != PNG_INTERLACE_NONE)
+                tex_printf("interlaced ");
+            if (info_p->bit_depth > 8)
+                tex_printf("bitdepth=%d ", info_p->bit_depth);
+            if (png_get_valid(png_p, info_p, PNG_INFO_tRNS))
+                tex_printf("simple transparancy ");
+        }
+        switch (info_p->color_type) {
+        case PNG_COLOR_TYPE_PALETTE:
+            write_png_palette(idict);
+            break;
+        case PNG_COLOR_TYPE_GRAY:
+            write_png_gray(idict);
+            break;
+        case PNG_COLOR_TYPE_GRAY_ALPHA:
+            if (fixed_pdf_minor_version >= 4)
+                write_png_gray_alpha(idict);
+            else
+                write_png_gray(idict);
+            break;
+        case PNG_COLOR_TYPE_RGB:
+            write_png_rgb(idict);
+            break;
+        case PNG_COLOR_TYPE_RGB_ALPHA:
+            if (fixed_pdf_minor_version >= 4)
+                write_png_rgb_alpha(idict);
+            else
+                write_png_rgb(idict);
+            break;
+        default:
+            pdftex_fail("unsupported type of color_type <%i>",
+                        info_p->color_type);
+        }
+    }
+    pdf_flush();
+    close_and_cleanup_png(idict);
+}
diff --git a/Build/source/texk/web2c/luatexdir/lang/hnjalloc.c b/Build/source/texk/web2c/luatexdir/lang/hnjalloc.c
new file mode 100644
index 00000000000..59d62e2aabb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lang/hnjalloc.c
@@ -0,0 +1,72 @@
+/* LibHnj is dual licensed under LGPL and MPL. Boilerplate for both
+ * licenses follows.
+ */
+
+/* LibHnj - a library for high quality hyphenation and justification
+ * Copyright (C) 1998 Raph Levien, (C) 2001 ALTLinux, Moscow
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, write to the 
+ * Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+ * Boston, MA  02111-1307  USA.
+*/
+
+/*
+ * The contents of this file are subject to the Mozilla Public License
+ * Version 1.0 (the "MPL"); you may not use this file except in
+ * compliance with the MPL.  You may obtain a copy of the MPL at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the MPL is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the MPL
+ * for the specific language governing rights and limitations under the
+ * MPL.
+ *
+ */
+/* wrappers for malloc */
+
+#include <stdlib.h>
+#include <stdio.h>
+
+void *
+hnj_malloc (int size)
+{
+  void *p;
+
+  p = malloc (size);
+  if (p == NULL)
+    {
+      fprintf (stderr, "can't allocate %d bytes\n", size);
+      exit (1);
+    }
+  return p;
+}
+
+void *
+hnj_realloc (void *p, int size)
+{
+  p = realloc (p, size);
+  if (p == NULL)
+    {
+      fprintf (stderr, "can't allocate %d bytes\n", size);
+      exit (1);
+    }
+  return p;
+}
+
+void
+hnj_free (void *p)
+{
+  free (p);
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lang/hnjalloc.h b/Build/source/texk/web2c/luatexdir/lang/hnjalloc.h
new file mode 100644
index 00000000000..db82fb9c758
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lang/hnjalloc.h
@@ -0,0 +1,46 @@
+/* LibHnj is dual licensed under LGPL and MPL. Boilerplate for both
+ * licenses follows.
+ */
+
+/* LibHnj - a library for high quality hyphenation and justification
+ * Copyright (C) 1998 Raph Levien
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, write to the 
+ * Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+ * Boston, MA  02111-1307  USA.
+*/
+
+/*
+ * The contents of this file are subject to the Mozilla Public License
+ * Version 1.0 (the "MPL"); you may not use this file except in
+ * compliance with the MPL.  You may obtain a copy of the MPL at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the MPL is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the MPL
+ * for the specific language governing rights and limitations under the
+ * MPL.
+ *
+ */
+/* wrappers for malloc */
+
+void *
+hnj_malloc (int size);
+
+void *
+hnj_realloc (void *p, int size);
+
+void
+hnj_free (void *p);
+
diff --git a/Build/source/texk/web2c/luatexdir/lang/hyphen.c b/Build/source/texk/web2c/luatexdir/lang/hyphen.c
new file mode 100644
index 00000000000..140cde8d768
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lang/hyphen.c
@@ -0,0 +1,830 @@
+/* Libhnj is dual licensed under LGPL and MPL. Boilerplate for both
+ * licenses follows.
+ */
+
+/* LibHnj - a library for high quality hyphenation and justification
+ * Copyright (C) 1998 Raph Levien, 
+ * 	     (C) 2001 ALTLinux, Moscow (http://www.alt-linux.org), 
+ *           (C) 2001 Peter Novodvorsky (nidd@cs.msu.su)
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Library General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library 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
+ * Library General Public License for more details.
+ *
+ * You should have received a copy of the GNU Library General Public
+ * License along with this library; if not, write to the 
+ * Free Software Foundation, Inc., 59 Temple Place - Suite 330, 
+ * Boston, MA  02111-1307  USA.
+*/
+
+/*
+ * The contents of this file are subject to the Mozilla Public License
+ * Version 1.0 (the "MPL"); you may not use this file except in
+ * compliance with the MPL.  You may obtain a copy of the MPL at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the MPL is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the MPL
+ * for the specific language governing rights and limitations under the
+ * MPL.
+ *
+ */
+#include <stdlib.h> /* for NULL, malloc */
+#include <stdio.h>  /* for fprintf */
+#include <string.h> /* for strdup */
+#include <stdlib.h> /* for malloc used by substring inclusion*/
+
+#define MAXPATHS 40960
+
+#ifdef UNX
+#include <unistd.h> /* for exit */
+#endif
+
+#include <ctype.h>
+
+/*#define VERBOSE*/
+
+#include "hnjalloc.h"
+#include "hyphen.h"
+
+/* SHOULD BE MOVED TO SEPARATE LIBRARY */
+static unsigned char * hnj_strdup(
+  const unsigned char *s
+) {
+  unsigned char *new;
+  int l;
+
+  l = strlen ((char*)s);
+  new = hnj_malloc (l + 1);
+  memcpy (new, s, l);
+  new[l] = 0;
+  return new;
+}
+
+static int is_utf8_follow(
+  unsigned char c
+) {
+  if (c>=0x80 && c<0xC0) return 1;
+  return 0;
+}
+
+/* --------------------------------------------------------------------
+ *
+ * Type definitions
+ *
+ * --------------------------------------------------------------------
+ */
+
+/* a little bit of a hash table implementation. This simply maps strings
+   to state numbers */
+
+typedef struct _HashTab HashTab;
+typedef struct _HashEntry HashEntry;
+typedef struct _HashIter HashIter;
+typedef union  _HashVal HashVal;
+
+/* A cheap, but effective, hack. */
+#define HASH_SIZE 31627
+
+struct _HashTab {
+  HashEntry *entries[HASH_SIZE];
+};
+
+union _HashVal {
+  int state;
+  char* hyppat;
+};
+
+struct _HashEntry {
+  HashEntry *next;
+  unsigned char *key;
+  HashVal u;
+};
+
+struct _HashIter {
+  HashEntry** e;
+  HashEntry*  cur;
+  int         ndx;
+};
+
+/* State machine */
+typedef struct _HyphenState HyphenState;
+typedef struct _HyphenTrans HyphenTrans;
+#define MAX_CHARS 256
+#define MAX_NAME 20
+
+struct _HyphenDict {
+  int num_states;
+  int pat_length;
+  char cset[MAX_NAME];
+  HyphenState *states;
+  HashTab *patterns;
+  HashTab *merged;
+  HashTab *state_num;
+};
+
+struct _HyphenState {
+  char *match;
+  /*char *repl;*/
+  /*signed char replindex;*/
+  /*signed char replcut;*/
+  int fallback_state;
+  int num_trans;
+  HyphenTrans *trans;
+};
+
+struct _HyphenTrans {
+  int uni_ch;
+  int new_state;
+};
+
+
+/* Combine two right-aligned number patterns, 04000 + 020 becomes 04020*/
+static char *combine(
+  char *expr,
+  const char *subexpr
+) {
+  int l1 = strlen(expr);
+  int l2 = strlen(subexpr);
+  int off = l1-l2;
+  int j;
+  /* this works also for utf8 sequences because the substring is identical
+   * to the last substring-length bytes of expr except for the (single byte)
+   * hyphenation encoders
+   */
+  for (j=0; j<l2; j++) {
+    if (expr[off+j]<subexpr[j]) expr[off+j] = subexpr[j];
+  }
+  return expr;
+}
+
+
+/* --------------------------------------------------------------------
+ * ORIGINAL CODE
+ * --------------------------------------------------------------------
+ */
+
+HashIter* new_HashIter(
+  HashTab* h
+) {
+  HashIter* i = hnj_malloc(sizeof(HashIter));
+  i->e = h->entries;
+  i->cur = NULL;
+  i->ndx = -1;
+  return i;
+}
+
+
+int nextHashStealPattern(
+  HashIter*i,
+  unsigned char**word,
+  char **pattern
+) {
+  while (i->cur==NULL) {
+    if (i->ndx >= HASH_SIZE-1) return 0;
+    i->cur = i->e[++i->ndx];
+  }
+  *word = i->cur->key;
+  *pattern = i->cur->u.hyppat;
+  i->cur->u.hyppat = NULL;
+  i->cur = i->cur->next;
+  return 1;
+}
+
+
+int nextHash(
+  HashIter*i,
+  unsigned char**word
+) {
+  while (i->cur==NULL) {
+    if (i->ndx >= HASH_SIZE-1) return 0;
+    i->cur = i->e[++i->ndx];
+  }
+  *word = i->cur->key;
+  i->cur = i->cur->next;
+  return 1;
+}
+
+
+int eachHash(
+  HashIter*i,
+  unsigned char**word,
+           char**pattern
+) {
+  while (i->cur==NULL) {
+    if (i->ndx >= HASH_SIZE-1) return 0;
+    i->cur = i->e[++i->ndx];
+  }
+  *word = i->cur->key;
+  *pattern = i->cur->u.hyppat;
+  i->cur = i->cur->next;
+  return 1;
+}
+
+
+void delete_HashIter(
+  HashIter*i
+) {
+  hnj_free(i);
+}
+
+
+/* a char* hash function from ASU - adapted from Gtk+ */
+static unsigned int hnj_string_hash (
+  const unsigned char *s
+) {
+  const unsigned char *p;
+  unsigned int h=0, g;
+
+  for (p = s; *p != '\0'; p += 1) {
+    h = ( h << 4 ) + *p;
+    if ( ( g = h & 0xf0000000 ) ) {
+      h = h ^ (g >> 24);
+      h = h ^ g;
+    }
+  }
+  return h /* % M */;
+}
+
+
+/* assumes that key is not already present! */
+static void state_insert(
+  HashTab *hashtab,
+  unsigned char *key,
+  int state
+) {
+  int i;
+  HashEntry *e;
+
+  i = hnj_string_hash (key) % HASH_SIZE;
+  e = hnj_malloc (sizeof(HashEntry));
+  e->next = hashtab->entries[i];
+  e->key = key;
+  e->u.state = state;
+  hashtab->entries[i] = e;
+}
+
+
+/* assumes that key is not already present! */
+static void hyppat_insert(
+  HashTab *hashtab,
+  unsigned char *key,
+  char* hyppat
+) {
+  int i;
+  HashEntry *e;
+
+  i = hnj_string_hash (key) % HASH_SIZE;
+  for (e = hashtab->entries[i]; e; e=e->next) {
+    if (strcmp((char*)e->key,(char*)key)==0) {
+      if (e->u.hyppat) hnj_free(e->u.hyppat);
+      e->u.hyppat = hyppat;
+      hnj_free(key);
+      return;
+    }
+  }
+  e = hnj_malloc (sizeof(HashEntry));
+  e->next = hashtab->entries[i];
+  e->key = key;
+  e->u.hyppat = hyppat;
+  hashtab->entries[i] = e;
+}
+
+
+/* return state if found, otherwise -1 */
+static int state_lookup(
+  HashTab *hashtab,
+  const unsigned char *key
+) {
+  int i;
+  HashEntry *e;
+
+  i = hnj_string_hash (key) % HASH_SIZE;
+  for (e = hashtab->entries[i]; e; e = e->next) {
+    if (!strcmp ((char*)key, (char*)e->key)) {
+      return e->u.state;
+    }
+  }
+  return -1;
+}
+
+
+/* return state if found, otherwise -1 */
+static char* hyppat_lookup(
+  HashTab *hashtab,
+  const unsigned char *chars,
+  int l
+) {
+  int i;
+  HashEntry *e;
+  unsigned char key[128]; /* should be ample*/
+  strncpy((char*)key,(char*)chars,l); key[l]=0;
+  i = hnj_string_hash (key) % HASH_SIZE;
+  for (e = hashtab->entries[i]; e; e = e->next) {
+    if (!strcmp ((char*)key, (char*)e->key)) {
+      return e->u.hyppat;
+    }
+  }
+  return NULL;
+}
+
+
+/* Get the state number, allocating a new state if necessary. */
+static int hnj_get_state(
+  HyphenDict *dict,
+  const unsigned char *string,
+  int *state_num
+) {
+  *state_num = state_lookup(dict->state_num, string);
+
+  if (*state_num >= 0)
+    return *state_num;
+
+  state_insert(dict->state_num, hnj_strdup(string), dict->num_states);
+  /* predicate is true if dict->num_states is a power of two */
+  if (!(dict->num_states & (dict->num_states - 1))) {
+    dict->states = hnj_realloc(
+      dict->states,
+      (dict->num_states << 1) * sizeof(HyphenState));
+  }
+  dict->states[dict->num_states].match = NULL;
+  dict->states[dict->num_states].fallback_state = -1;
+  dict->states[dict->num_states].num_trans = 0;
+  dict->states[dict->num_states].trans = NULL;
+  return dict->num_states++;
+}
+
+
+/* add a transition from state1 to state2 through ch - assumes that the
+   transition does not already exist */
+static void hnj_add_trans(
+  HyphenDict *dict,
+  int state1,
+  int state2,
+  int uni_ch
+) {
+  int num_trans;
+  /* TH: this test was a bit too strict, it is quite normal for old
+     patterns to have chars in the range 0-31 or 127-159 (inclusive). 
+     To ease the transition, let's only disallow NUL for now 
+     (this is probably a requirement of the code anyway).
+  */
+  if (uni_ch==0) {
+    fprintf(stderr,"Character out of bounds: u%04x \n",uni_ch);
+    exit(1);
+  }
+  num_trans = dict->states[state1].num_trans;
+  if (num_trans == 0) {
+    dict->states[state1].trans = hnj_malloc(sizeof(HyphenTrans));
+  } else if (!(num_trans & (num_trans - 1))) {
+    dict->states[state1].trans = hnj_realloc(
+      dict->states[state1].trans,
+      (num_trans << 1) * sizeof(HyphenTrans));
+  }
+  dict->states[state1].trans[num_trans].uni_ch = uni_ch;
+  dict->states[state1].trans[num_trans].new_state = state2;
+  dict->states[state1].num_trans++;
+}
+
+
+#ifdef VERBOSE
+
+static unsigned char *get_state_str(
+  int state
+) {
+  int i;
+  HashEntry *e;
+
+  for (i = 0; i < HASH_SIZE; i++)
+    for (e = global->entries[i]; e; e = e->next)
+      if (e->u.state == state)
+	return e->key;
+  return NULL;
+}
+#endif
+
+
+/* I've changed the semantics a bit here: hnj_hyphen_load used to
+   operate on a file, but now the argument is a string buffer.
+ */
+
+static const unsigned char* next_pattern(
+  size_t* length,
+  const unsigned char **buf
+) {
+  const unsigned char *rover = *buf;
+  while (*rover && isspace(*rover)) rover++;
+  const unsigned char *here = rover;
+  while (*rover) {
+    if (isspace(*rover)) {
+      *length = rover-here;
+      *buf = rover;
+      return here;
+    }
+    rover++;
+  }
+  *length = rover-here;
+  *buf = rover;
+  return *length ? here : NULL; /* zero sensed */
+}
+
+static void init_hash(
+  HashTab**h
+) {
+  if (*h) return;
+  int i;
+  *h = hnj_malloc(sizeof(HashTab));
+  for (i = 0; i < HASH_SIZE; i++) (*h)->entries[i] = NULL;
+}
+
+
+static void clear_state_hash(
+  HashTab**h
+) {
+  if (*h==NULL) return;
+  int i;
+  for (i = 0; i < HASH_SIZE; i++) {
+    HashEntry *e, *next;
+    for (e = (*h)->entries[i]; e; e = next) {
+      next = e->next;
+      hnj_free (e->key);
+      hnj_free (e);
+    }
+  }
+  hnj_free(*h);
+  *h=NULL;
+}
+
+
+static void clear_hyppat_hash(
+  HashTab**h
+) {
+  if (*h==NULL) return;
+  int i;
+  for (i = 0; i < HASH_SIZE; i++) {
+    HashEntry *e, *next;
+    for (e = (*h)->entries[i]; e; e = next) {
+      next = e->next;
+      hnj_free(e->key);
+      if (e->u.hyppat) hnj_free(e->u.hyppat);
+      hnj_free(e);
+    }
+  }
+  hnj_free(*h);
+  *h=NULL;
+}
+
+
+static void init_dict(
+  HyphenDict* dict
+) {
+  dict->num_states = 1;
+  dict->pat_length = 0;
+  dict->states = hnj_malloc (sizeof(HyphenState));
+  dict->states[0].match = NULL;
+  dict->states[0].fallback_state = -1;
+  dict->states[0].num_trans = 0;
+  dict->states[0].trans = NULL;
+  dict->patterns  = NULL;
+  dict->merged    = NULL;
+  dict->state_num = NULL;
+  init_hash(&dict->patterns);
+}
+
+
+static void clear_dict(
+  HyphenDict* dict
+) {
+  int state_num;
+  for (state_num = 0; state_num < dict->num_states; state_num++) {
+    HyphenState *hstate = &dict->states[state_num];
+    if (hstate->match) hnj_free (hstate->match);
+    if (hstate->trans) hnj_free (hstate->trans);
+  }
+  hnj_free (dict->states);
+  clear_hyppat_hash(&dict->patterns);
+  clear_hyppat_hash(&dict->merged);
+  clear_state_hash(&dict->state_num);
+}
+
+
+
+HyphenDict* hnj_hyphen_new() {
+  HyphenDict* dict = hnj_malloc (sizeof(HyphenDict));
+  init_dict(dict);
+  return dict;
+}
+
+
+void hnj_hyphen_clear(
+  HyphenDict* dict
+) {
+  clear_dict(dict);
+  init_dict(dict);
+}
+
+
+void hnj_hyphen_free(
+  HyphenDict *dict
+) {
+  clear_dict(dict);
+  hnj_free(dict);
+}
+
+unsigned char* hnj_serialize(
+  HyphenDict* dict
+) {
+  HashIter *v;
+  unsigned char* word;
+           char* pattern;
+  unsigned char* buf = hnj_malloc(dict->pat_length);
+  unsigned char* cur = buf;
+  v = new_HashIter(dict->patterns);
+  while (eachHash(v,&word,&pattern)) {
+    int i=0, e=0;
+    while(word[e+i]) {
+      if (pattern[i]!='0') *cur++ = (unsigned char) pattern[i];
+      *cur++ = word[e+i++];
+      while (is_utf8_follow(word[e+i])) *cur++ = word[i+e++];
+    }
+    if (pattern[i]!='0') *cur++ = (unsigned char) pattern[i];
+    *cur++ = ' ';
+  }
+  delete_HashIter(v);
+  *cur = 0;
+  return buf;
+}
+
+
+void hnj_free_serialize(
+  unsigned char* c
+) {
+  hnj_free(c);
+}
+
+
+/* hyphenation pattern:
+ * signed bytes
+ * 0 indicates end (actually any negative number)
+ * : prio(1+),startpos,length,len1,[replace],len2,[replace]
+ * most basic example is:
+ *  p n 0 0 0
+ * for a hyphenation point between characters
+ */
+
+
+void hnj_hyphen_load(
+  HyphenDict* dict,
+  const unsigned char *f
+) {
+  int state_num, last_state;
+  int i, j = 0;
+  int ch;
+  int found;
+  HashEntry *e;
+  HashIter *v;
+  unsigned char* word;
+           char* pattern;
+  size_t l = 0;
+
+
+  /***************************************/
+
+  const unsigned char* format;
+  const unsigned char* begin = f;
+  while((format = next_pattern(&l,&f))!=NULL) {
+    int i,j,e;
+    /*
+    printf("%s\n",format);
+    char* repl = strnchr(format, '/',l);
+    int replindex = 0;
+    int replcut = 0;
+    if (repl) {
+      int clen = l-(repl-format);
+      l = repl-format;
+      char * index = strnchr(repl + 1, ',',clen);
+      if (index) {
+        char * index2 = strnchr(index + 1, ',',clen-(index-repl));
+        if (index2) {
+          replindex = (signed char) atoi(index + 1) - 1;
+          replcut = (signed char) atoi(index2 + 1);                
+        }
+      } else {
+        hnj_strchomp(repl + 1);
+		replindex = 0;
+        replcut = strlen(buf);
+      }
+      repl = hnj_strdup(repl + 1);
+    }
+    */
+    for (i=0,j=0,e=0; i<l; i++) {
+      if (format[i]>='0'&&format[i]<='9') j++;
+      if (is_utf8_follow(format[i])) e++;
+    }
+    /* l-e   => number of _characters_ not _bytes_*/
+    /* l-e-j => number of pattern characters*/
+    unsigned char *pat = (unsigned char*) malloc(1+l-j);
+             char *org = (         char*) malloc(2+l-e-j);
+			 /* remove hyphenation encoders (digits) from pat*/
+    org[0] = '0';
+    for (i=0,j=0,e=0; i<l; i++) {
+      unsigned char c = format[i];
+      if (is_utf8_follow(c)) {
+        pat[j+e++] = c;
+      } else if (c<'0' || c>'9') {
+        pat[e+j++] = c;
+        org[j]   = '0';
+      } else {
+        org[j]   = c;
+      }
+    }
+    pat[e+j] = 0;
+    org[j+1] = 0;
+    hyppat_insert(dict->patterns,pat,org);
+  }
+  dict->pat_length += (f-begin)+2; /* 2 for spurious spaces*/
+  init_hash(&dict->merged);
+  v = new_HashIter(dict->patterns);
+  while (nextHash(v,&word)) {
+    int   wordsize = strlen((char*)word);
+    int   j,l;
+    for (l=1; l<=wordsize; l++) {
+      if (is_utf8_follow(word[l])) continue; /* Do not clip an utf8 sequence*/
+      for (j=1; j<=l; j++) {
+        int i = l-j;
+        if (is_utf8_follow(word[i])) continue; /* Do not start halfway an utf8 sequence*/
+        char *subpat_pat;
+        if ((subpat_pat = hyppat_lookup(dict->patterns,word+i,j))!=NULL) {
+          char* newpat_pat;
+          if ((newpat_pat = hyppat_lookup(dict->merged,word,l))==NULL) {
+            unsigned char *newword=(unsigned char*)malloc(l+1);
+            strncpy((char*)newword, (char*)word,l); newword[l]=0;
+            int e=0;
+            for (i=0; i<l; i++) if (is_utf8_follow(newword[i])) e++;
+            char *neworg = malloc(l+2-e);
+            sprintf(neworg,"%0*d",l+1-e,0); /* fill with right amount of '0'*/
+            hyppat_insert(dict->merged,newword,combine(neworg,subpat_pat));
+          } else {
+            combine(newpat_pat,subpat_pat);
+          }
+        }
+      }
+    }
+  }
+  delete_HashIter(v);
+
+  init_hash(&dict->state_num);
+  state_insert(dict->state_num, hnj_strdup((unsigned char*)""), 0);
+  v = new_HashIter(dict->merged);
+  while (nextHashStealPattern(v,&word,&pattern)) {
+    static unsigned char mask[] = {0x3F,0x1F,0xF,0x7};
+    int j = strlen((char*)word);
+#ifdef VERBOSE
+    printf ("word %s pattern %s, j = %d\n", word, pattern, j);
+#endif
+    state_num = hnj_get_state( dict, word, &found );
+    dict->states[state_num].match = pattern;
+
+    /* now, put in the prefix transitions */
+    while (found < 0) {
+      j--;
+      last_state = state_num;
+      ch = word[j];
+      if (ch>=0x80) {
+        int i=1;
+        while (is_utf8_follow(word[j-i])) i++;
+        ch = word[j-i] & mask[i];
+        int m = j-i;
+        while (i--) {
+          ch = (ch<<6)+(0x3F & word[j-i]);
+        }
+        j = m;
+      }
+      word[j] = '\0';
+      state_num = hnj_get_state (dict, word, &found);
+      hnj_add_trans (dict, state_num, last_state, ch);
+    }
+  }
+  delete_HashIter(v);
+  clear_hyppat_hash(&dict->merged);
+
+  /***************************************/
+
+  /* put in the fallback states */
+  for (i = 0; i < HASH_SIZE; i++) {
+    for (e = dict->state_num->entries[i]; e; e = e->next) {
+      /* do not do state==0 otherwise things get confused*/
+      if (e->u.state) {
+        for (j = 1; 1; j++) {
+          state_num = state_lookup(dict->state_num, e->key + j);
+          if (state_num >= 0) break;
+        }
+        dict->states[e->u.state].fallback_state = state_num;
+      }
+    }
+  }
+#ifdef VERBOSE
+  for (i = 0; i < HASH_SIZE; i++) {
+    for (e = dict->state_num->entries[i]; e; e = e->next) {
+      printf ("%d string %s state %d, fallback=%d\n", i, e->key, e->u.state,
+        dict->states[e->u.state].fallback_state);
+      for (j = 0; j < dict->states[e->u.state].num_trans; j++) {
+        printf (" u%4x->%d\n", (int)dict->states[e->u.state].trans[j].uni_ch,
+          dict->states[e->u.state].trans[j].new_state);
+      }
+    }
+  }
+#endif
+  clear_state_hash(&dict->state_num);
+}
+
+
+void hnj_hyphen_hyphenate(
+  HyphenDict *dict,
+  halfword first,
+  halfword last,
+  int length,
+  halfword left,
+  halfword right,
+  lang_variables *lan
+) {
+  /* +2 for dots at each end, +1 for points /outside/ characters*/
+  int ext_word_len = length+2;
+  int hyphen_len   = ext_word_len+1;
+  /*char *hyphens = hnj_malloc((hyphen_len*2)+1); */ /* LATER */
+  char *hyphens = hnj_malloc(hyphen_len+1);
+
+  /* Add a '.' to beginning and end to facilitate matching*/
+  set_vlink(begin_point,first);
+  set_vlink(end_point,get_vlink(last));
+  set_vlink(last,end_point);
+
+  int char_num;
+  for (char_num = 0; char_num < hyphen_len; char_num++) {
+	/*  hyphens[char_num*2] = '0';    */ /* LATER */
+	/*  hyphens[char_num*2+1] = '0';    */ /* LATER */
+    hyphens[char_num] = '0';    
+  }
+  /*hyphens[hyphen_len*2] = 0;  */ /* LATER */
+  hyphens[hyphen_len] = 0;
+
+  /* now, run the finite state machine */
+  int state = 0;
+  halfword here;
+  for (char_num=0, here=begin_point; here!=end_point; here=get_vlink(here)) {
+
+    int ch = get_character(here);
+
+    while (state!=-1) {
+	  /*   printf("%*s%s%c",char_num-strlen(get_state_str(state)),"",get_state_str(state),(char)ch);*/
+      HyphenState *hstate = &dict->states[state];
+      int k;
+      for (k = 0; k < hstate->num_trans; k++) {
+        if (hstate->trans[k].uni_ch == ch) {
+          state = hstate->trans[k].new_state;
+		  /*       printf(" state %d\n",state);*/
+          char *match = dict->states[state].match;
+          if (match) {
+            /* +2 because:
+			 *  1 string length is one bigger than offset
+			 *  1 hyphenation starts before first character
+			 */
+            int offset = char_num + 2 - strlen (match);
+			/*         printf ("%*s%s\n", offset,"", match);*/
+            int m;
+            for (m = 0; match[m]; m++) {
+              if (hyphens[offset+m] < match[m]) hyphens[offset+m] = match[m];
+            }
+          }
+          goto try_next_letter;
+        }
+      }
+      state = hstate->fallback_state;
+	  /*   printf (" back to %d\n", state);*/
+    }
+    /* nothing worked, let's go to the next character*/
+    state = 0;
+try_next_letter: ;
+    char_num++;
+  }
+
+  /* restore the correct pointers*/
+  set_vlink(last,get_vlink(end_point));
+
+  /* pattern is ^.^w^o^r^d^.^   word_len=4, ext_word_len=6, hyphens=7
+   * check          ^ ^ ^       so drop first two and stop after word_len-1
+   */
+  for (here=first,char_num=2; here!=left; here=get_vlink(here)) char_num++;
+  for (; here!=right; here=get_vlink(here)) {
+    if (hyphens[char_num] & 1)
+      here = insert_syllable_discretionary(here, lan);
+    char_num++;
+  }
+  hnj_free(hyphens);
+}
diff --git a/Build/source/texk/web2c/luatexdir/lang/texlang.c b/Build/source/texk/web2c/luatexdir/lang/texlang.c
new file mode 100644
index 00000000000..12390ae2fcf
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lang/texlang.c
@@ -0,0 +1,825 @@
+/*
+Copyright (c) 2007 Taco Hoekwater <taco@latex.org>
+
+This file is part of luatex.
+
+luatex 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.
+
+luatex 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 luatex; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+This is texlang.c
+*/
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include <string.h>
+
+#include "nodes.h"
+#include "hyphen.h"
+
+/* functions from the fontforge unicode library */
+
+extern unsigned int *utf82u_strcpy(unsigned int *ubuf,const char *utf8buf);
+extern unsigned int u_strlen(unsigned int *ubuf);
+extern char *utf8_idpb(char *w,unsigned int i);
+
+#define noVERBOSE
+
+#define MAX_TEX_LANGUAGES  32767
+
+static struct tex_language *tex_languages[MAX_TEX_LANGUAGES] = {NULL};
+static int next_lang_id = 0;
+
+struct tex_language *
+new_language (void) {
+  struct tex_language* lang;
+  if (next_lang_id<MAX_TEX_LANGUAGES) {
+	lang = xmalloc(sizeof(struct tex_language));
+	tex_languages[next_lang_id] = lang;
+	lang->id = next_lang_id++;
+	lang->exceptions = 0;
+	lang->patterns = NULL;
+	lang->pre_hyphen_char = '-';
+	lang->post_hyphen_char = 0;
+	return lang;
+  } else {
+	return NULL;
+  }
+}
+
+struct tex_language *
+get_language (int n) {
+  if (n>=0 && n<=MAX_TEX_LANGUAGES )  {
+    if (tex_languages[n]!=NULL) {
+      return tex_languages[n];
+    } else {
+      return new_language();
+    }
+  } else {
+    return NULL;
+  }
+}
+
+void
+set_pre_hyphen_char (integer n, integer v) {
+  struct tex_language *l = get_language((int)n);
+  l->pre_hyphen_char = (int)v;
+}
+
+void
+set_post_hyphen_char (integer n, integer v) {
+  struct tex_language *l = get_language((int)n);
+  l->post_hyphen_char = (int)v;
+}
+
+integer
+get_pre_hyphen_char (integer n) {
+  struct tex_language *l = get_language((int)n);
+  return (integer)l->pre_hyphen_char;
+}
+
+integer
+get_post_hyphen_char (integer n) {
+  struct tex_language *l = get_language((int)n);
+  return (integer)l->post_hyphen_char;
+}
+
+void 
+load_patterns (struct tex_language *lang, unsigned char *buffer) {
+  if (lang==NULL)
+    return;
+  if (lang->patterns==NULL) {
+    lang->patterns = hnj_hyphen_new();
+  }
+  hnj_hyphen_load (lang->patterns,buffer);
+}
+
+void 
+clear_patterns (struct tex_language *lang) {
+  if (lang==NULL)
+    return;
+  if (lang->patterns!=NULL) {
+    hnj_hyphen_clear(lang->patterns);
+  }
+}
+
+void
+load_tex_patterns(int curlang, halfword head) {
+  char *s = tokenlist_to_cstring (head,1, NULL);
+  load_patterns(get_language(curlang),(unsigned char *)s);
+}
+
+
+#define STORE_CHAR(x) { word[w] = x ; if (w<MAX_WORD_LEN) w++; }
+ 
+/* todo change this! */
+
+char *
+clean_hyphenation (char *buffer, char **cleaned) {
+  int items;
+  unsigned char word [MAX_WORD_LEN+1];
+  int w = 0;
+  char *s = buffer;
+  while (*s && !isspace(*s)) {
+    if (*s == '-') {	 /* skip */
+    } else if (*s == '=') {
+      STORE_CHAR('-');
+    } else if (*s == '{') {
+      s++;
+      items=0;
+      while (*s && *s!='}') { s++; }
+      if (*s=='}') { items++; s++; }
+      while (*s && *s!='}') { s++; }
+      if (*s=='}') { items++; s++; }
+      if (*s=='{') { s++; }
+	  while (*s && *s!='}') {STORE_CHAR(*s);  s++; }
+      if (*s=='}') { items++; } else { s--; }
+      if (items!=3) { /* syntax error */
+		*cleaned = NULL;	
+		while (*s && !isspace(*s)) { s++; }
+		return s;
+      }
+    } else {
+      STORE_CHAR(*s); 
+    }
+    s++;
+  }
+  word[w] = 0;
+  *cleaned = xstrdup((char *)word);
+  return s;
+}
+
+void
+load_hyphenation (struct tex_language *lang, unsigned char *buffer) {
+  char *s, *value, *cleaned;
+  lua_State *L = Luas[0];
+  if (lang==NULL)
+    return;
+  if (lang->exceptions==0) {
+    lua_newtable(L);
+    lang->exceptions = luaL_ref(L,LUA_REGISTRYINDEX);
+  }
+  lua_rawgeti(L, LUA_REGISTRYINDEX, lang->exceptions);
+  s = (char *)buffer;
+  while (*s) {
+    while (isspace(*s)) s++;
+    if (*s) {
+      value = s;
+      s = clean_hyphenation(s, &cleaned);
+      if (cleaned!=NULL) {
+		if ((s-value)>0) {
+		  lua_pushstring(L,cleaned);
+		  lua_pushlstring(L,value,(s-value));
+		  lua_rawset(L,-3);
+		}
+		free(cleaned);
+      } else {
+#ifdef VERBOSE
+	fprintf(stderr,"skipping invalid hyphenation exception: %s\n",value);      
+#endif
+      }
+    }
+  }
+}
+
+void 
+clear_hyphenation (struct tex_language *lang) {
+  if (lang==NULL)
+    return;
+  if (lang->exceptions!=0) {
+	luaL_unref(Luas[0],LUA_REGISTRYINDEX,lang->exceptions);
+	lang->exceptions = 0;
+  }
+}
+
+
+void
+load_tex_hyphenation(int curlang, halfword head) {
+  char *s = tokenlist_to_cstring (head,1, NULL);
+  load_hyphenation(get_language(curlang),(unsigned char *)s);
+}
+
+/* TODO: clean this up. The delete_attribute_ref() statements are not very 
+   nice, but needed. Also, in the post-break, it would be nicer to get the 
+   attribute list from vlink(n). No rush, as it is currently not used much. */
+
+halfword insert_discretionary ( halfword t,  halfword pre,  halfword post,  halfword replace) {
+  halfword g, n;
+  n = new_node(disc_node,syllable_disc);
+  try_couple_nodes(n,vlink(t));
+  couple_nodes(t,n);
+  for (g=pre;g!=null;g=vlink(g)) {
+    font(g)=font(replace);
+    if (node_attr(t)!=null) {
+	  delete_attribute_ref(node_attr(g));
+      node_attr(g) = node_attr(t);
+      attr_list_ref(node_attr(t)) += 1; 
+    }
+  }
+  for (g=post;g!=null;g =vlink(g)) {
+    font(g)=font(replace);
+    if (node_attr(t)!=null) {
+	  delete_attribute_ref(node_attr(g));
+      node_attr(g) = node_attr(t);
+      attr_list_ref(node_attr(t)) += 1; 
+    }
+  }
+  for (g=replace;g!=null;g =vlink(g)) {
+    if (node_attr(t)!=null) {
+	  delete_attribute_ref(node_attr(g));
+      node_attr(g) = node_attr(t);
+      attr_list_ref(node_attr(t)) += 1; 
+    }
+  }
+  if (node_attr(t)!=null) {
+	delete_attribute_ref(node_attr(vlink(t)));
+    node_attr(vlink(t)) = node_attr(t);
+    attr_list_ref(node_attr(t)) += 1; 
+  }
+  t = vlink(t);
+  set_disc_field(pre_break(t),pre);
+  set_disc_field(post_break(t),post);
+  set_disc_field(no_break(t),replace);
+  return t;
+}
+
+halfword 
+insert_syllable_discretionary ( halfword t,  lang_variables *lan) {
+  halfword g, n;
+  n = new_node(disc_node,syllable_disc);
+  couple_nodes(n,vlink(t));
+  couple_nodes(t,n);
+  delete_attribute_ref(node_attr(n));
+  if (node_attr(t)!=null) {
+	node_attr(n) = node_attr(t);
+	attr_list_ref(node_attr(t))++ ;
+  } else {
+	node_attr(n) = null;
+  }
+  if (lan->pre_hyphen_char >0) {
+	g = raw_glyph_node();
+	set_to_character(g); 
+	character(g)=lan->pre_hyphen_char;
+	font(g)=font(t);
+	lang_data(g)=lang_data(t);
+	if (node_attr(t)!=null) {
+	  node_attr(g) = node_attr(t);
+	  attr_list_ref(node_attr(t)) ++; 
+	}
+	set_disc_field(pre_break(n),g);
+  }
+
+  if (lan->post_hyphen_char >0) {
+	t = vlink(n);
+	g = raw_glyph_node();
+	set_to_character(g); 
+	character(g)=lan->post_hyphen_char;
+	font(g)=font(t);
+	lang_data(g)=lang_data(t);
+	if (node_attr(t)!=null) {
+	  node_attr(g) = node_attr(t);
+	  attr_list_ref(node_attr(t)) += 1; 
+	}
+	set_disc_field(post_break(n),g);
+  }
+  return n;
+}
+
+halfword insert_word_discretionary ( halfword t,  lang_variables *lan) {
+  halfword pre = null, pos = null;
+  if (lan->pre_hyphen_char >0) pre = insert_character ( null,  lan->pre_hyphen_char);
+  if (lan->post_hyphen_char>0) pos = insert_character ( null,  lan->post_hyphen_char);
+  return insert_discretionary ( t, pre, pos, null);
+}
+
+halfword insert_complex_discretionary ( halfword t, lang_variables *lan, 
+					halfword pre,  halfword pos,  halfword replace) {
+  return insert_discretionary ( t, pre, pos, replace);
+}
+
+
+halfword insert_character ( halfword t,  int c) {
+  halfword p;
+  p=new_node(glyph_node,0);
+  set_to_character(p); 
+  character(p)=c;
+  if (t!=null) {
+    couple_nodes(t,p);
+  }
+  return p;
+}
+
+
+void
+set_disc_field (halfword f, halfword t) {
+  if (t!=null) {
+    couple_nodes(f,t);
+    tlink(f) = tail_of_list(t);
+  }
+}
+
+
+
+char *hyphenation_exception(int exceptions, char *w) {
+  char *ret = NULL;
+  lua_State *L = Luas[0];
+  lua_checkstack(L,2);
+  lua_rawgeti(L,LUA_REGISTRYINDEX,exceptions);
+  if (lua_istable(L,-1)) { /* ?? */
+    lua_pushstring(L,w);    /* word table */
+    lua_rawget(L,-2);
+    if (lua_isstring(L,-1)) {
+      ret = xstrdup((char *)lua_tostring(L,-1));
+    }
+    lua_pop(L,2);
+  } else {
+    lua_pop(L,1);
+  }
+  return ret;
+}
+
+
+char *exception_strings(struct tex_language *lang) {
+  char *value;
+  int size = 0, current =0;
+  size_t l =0;
+  char *ret = NULL;
+  lua_State *L = Luas[0];
+  if (lang->exceptions==0)
+    return NULL;
+  lua_checkstack(L,2);
+  lua_rawgeti(L,LUA_REGISTRYINDEX,lang->exceptions);
+  if (lua_istable(L,-1)) {
+    /* iterate and join */
+    lua_pushnil(L);  /* first key */
+    while (lua_next(L,-2) != 0) {
+      value = (char *)lua_tolstring(L, -1, &l);
+      if (current + 2 + l > size ) {
+	ret = xrealloc(ret, (1.2*size)+current+l+1024);
+	size = (1.2*size)+current+l+1024;
+      }
+      *(ret+current) = ' ';
+      strcpy(ret+current+1,value);
+      current += l+1;
+      lua_pop(L, 1);
+    }
+  }
+  return ret;
+}
+
+
+/* the sequence from |wordstart| to |r| can contain only normal characters */
+/* it could be faster to modify a halfword pointer and return an integer */
+
+halfword find_exception_part(int *j, int *uword, int len) {
+  halfword g = null, gg = null;
+  register int i = *j;
+  i++; /* this puts uword[i] on the '{' */
+  while (i<len && uword[i+1] != '}') {
+    if (g==null) {
+      gg = new_char(0,uword[i+1]);
+      g = gg;
+    } else {
+      halfword s = new_char(0,uword[i+1]);
+      couple_nodes(g,s);
+      g = vlink(g);
+    }
+    i++;
+  }
+  *j = ++i;
+  return gg;
+}
+
+int count_exception_part(int *j, int *uword, int len) {
+  int ret=0;
+  register int i = *j;
+  i++; /* this puts uword[i] on the '{' */
+  while (i<len && uword[i+1] != '}') {
+	ret++;
+    i++;
+  }
+  *j = ++i;
+  return ret;
+}
+
+
+static char *PAT_ERROR[] =  { 
+  "Exception discretionaries should contain three pairs of braced items.", 
+  "No intervening spaces are allowed.", 
+  NULL };
+
+void do_exception (halfword wordstart, halfword r, char *replacement) {
+  int i;
+  halfword t;
+  unsigned len;
+  int clang;
+  lang_variables langdata;
+  int uword[MAX_WORD_LEN+1] = {0};
+  (void)utf82u_strcpy((unsigned int *)uword,replacement);
+  len = u_strlen((unsigned int *)uword); 
+  i = 0;
+  t=wordstart;
+  clang = char_lang(wordstart);
+  langdata.pre_hyphen_char = get_pre_hyphen_char(clang);
+  langdata.post_hyphen_char = get_post_hyphen_char(clang);
+
+  for (i=0;i<len;i++) {
+	if (uword[i+1] == '-') { /* a hyphen follows */
+      while (vlink(t)!=r && (type(t)!=glyph_node || !is_simple_character(t)))
+		t = vlink(t);
+      if (vlink(t)==r)
+		break;
+	  insert_syllable_discretionary(t, &langdata);
+	  t = vlink(t); /* skip the new disc */
+    } else if (uword[i+1] == '=') { 
+      /* do nothing ? */
+      t = vlink(t);
+    } else if (uword[i+1] == '{') {
+      halfword gg, hh, replace = null;
+	  int repl;
+      gg = find_exception_part(&i,uword,len);
+      if (i==len || uword[i+1] != '{') {
+		tex_error ("broken pattern 1", PAT_ERROR);
+	  }
+      hh = find_exception_part(&i,uword,len);
+      if (i==len || uword[i+1] != '{') {
+		tex_error ("broken pattern 2",  PAT_ERROR); 
+	  }
+      repl = count_exception_part(&i,uword,len); 
+      if (i==len) {
+		tex_error ("broken pattern 3",  PAT_ERROR);
+	  }
+      /*i++;  */ /* jump over the last right brace */
+      if (vlink(t)==r)
+		break;
+	  if (repl>0) {
+		halfword q = t;
+		replace = vlink(q);
+		while(repl>0 && q!=null) {
+		  q=vlink(q);
+		  if (type(q)==glyph_node) {
+			repl--;
+		  }
+		}
+		try_couple_nodes(t,vlink(q));
+		vlink(q)=null; 
+	  }
+      t = insert_discretionary(t,gg,hh,replace);
+    } else {
+      t = vlink(t);
+    }
+  }
+}
+
+/* This is a documentation section from the pascal web file. It is not 
+true any more, but I do not have time right now to rewrite it -- Taco
+
+When the line-breaking routine is unable to find a feasible sequence of
+breakpoints, it makes a second pass over the paragraph, attempting to
+hyphenate the hyphenatable words. The goal of hyphenation is to insert
+discretionary material into the paragraph so that there are more
+potential places to break.
+
+The general rules for hyphenation are somewhat complex and technical,
+because we want to be able to hyphenate words that are preceded or
+followed by punctuation marks, and because we want the rules to work
+for languages other than English. We also must contend with the fact
+that hyphens might radically alter the ligature and kerning structure
+of a word.
+
+A sequence of characters will be considered for hyphenation only if it
+belongs to a ``potentially hyphenatable part'' of the current paragraph.
+This is a sequence of nodes $p_0p_1\ldots p_m$ where $p_0$ is a glue node,
+$p_1\ldots p_{m-1}$ are either character or ligature or whatsit or
+implicit kern nodes, and $p_m$ is a glue or penalty or insertion or adjust
+or mark or whatsit or explicit kern node.  (Therefore hyphenation is
+disabled by boxes, math formulas, and discretionary nodes already inserted
+by the user.) The ligature nodes among $p_1\ldots p_{m-1}$ are effectively
+expanded into the original non-ligature characters; the kern nodes and
+whatsits are ignored. Each character |c| is now classified as either a
+nonletter (if |lc_code(c)=0|), a lowercase letter (if
+|lc_code(c)=c|), or an uppercase letter (otherwise); an uppercase letter
+is treated as if it were |lc_code(c)| for purposes of hyphenation. The
+characters generated by $p_1\ldots p_{m-1}$ may begin with nonletters; let
+$c_1$ be the first letter that is not in the middle of a ligature. Whatsit
+nodes preceding $c_1$ are ignored; a whatsit found after $c_1$ will be the
+terminating node $p_m$. All characters that do not have the same font as
+$c_1$ will be treated as nonletters. The |hyphen_char| for that font
+must be between 0 and 255, otherwise hyphenation will not be attempted.
+\TeX\ looks ahead for as many consecutive letters $c_1\ldots c_n$ as
+possible; however, |n| must be less than 64, so a character that would
+otherwise be $c_{64}$ is effectively not a letter. Furthermore $c_n$ must
+not be in the middle of a ligature.  In this way we obtain a string of
+letters $c_1\ldots c_n$ that are generated by nodes $p_a\ldots p_b$, where
+|1<=a<=b+1<=m|. If |n>=l_hyf+r_hyf|, this string qualifies for hyphenation;
+however, |uc_hyph| must be positive, if $c_1$ is uppercase.
+
+The hyphenation process takes place in three stages. First, the candidate
+sequence $c_1\ldots c_n$ is found; then potential positions for hyphens
+are determined by referring to hyphenation tables; and finally, the nodes
+$p_a\ldots p_b$ are replaced by a new sequence of nodes that includes the
+discretionary breaks found.
+
+Fortunately, we do not have to do all this calculation very often, because
+of the way it has been taken out of \TeX's inner loop. For example, when
+the second edition of the author's 700-page book {\sl Seminumerical
+Algorithms} was typeset by \TeX, only about 1.2 hyphenations needed to be
+@^Knuth, Donald Ervin@>
+tried per paragraph, since the line breaking algorithm needed to use two
+passes on only about 5 per cent of the paragraphs.
+
+
+When a word been set up to contain a candidate for hyphenation,
+\TeX\ first looks to see if it is in the user's exception dictionary. If not,
+hyphens are inserted based on patterns that appear within the given word,
+using an algorithm due to Frank~M. Liang.
+@^Liang, Franklin Mark@>
+*/
+
+/* 
+ * This is incompatible with TEX because the first word of a paragraph
+ * can be hyphenated, but most european users seem to agree that
+ * prohibiting hyphenation there was not a the best idea ever.
+ */
+
+halfword find_next_wordstart(halfword r) {
+  register int l;
+  register int start_ok = 1;
+  int mathlevel = 1;
+  while (r!=null) {
+    switch (type(r)) {
+    case glue_node:
+      start_ok = 1;
+      break;
+    case math_node:
+      while (mathlevel>0 ){
+	r = vlink(r);
+	if (r==null)
+	  return r;
+	if (type(r)==math_node) {
+	  if (subtype(r)==before) {
+	    mathlevel++;
+	  } else {
+	    mathlevel--;
+	  }
+	}
+      }
+      break;
+    case glyph_node:
+      if (start_ok && 
+	  is_simple_character(r) &&
+	  (l = get_lc_code(character(r)))>0 &&
+	  (char_uchyph(r) || l == character(r)))
+	return r;
+      /* fall through */
+    default:
+      start_ok = 0;
+      break;
+    }
+    r = vlink(r);
+  }
+  return r;
+}
+
+int valid_wordend( halfword s) {
+  register halfword r = s;
+  register int clang = char_lang(s);
+  if (r==null)
+    return 1;
+  while ((r!=null) &&
+	 ((type(r)==glyph_node && is_simple_character(r) && clang == char_lang(r)) ||
+	  (type(r)==kern_node  && subtype(r)==normal))) {
+    r = vlink(r);
+  }
+  if (r==null ||
+      (type(r)==glyph_node && is_simple_character(r) && clang != char_lang(r)) ||
+      type(r)==glue_node ||
+      type(r)==whatsit_node ||
+      type(r)==ins_node ||
+      type(r)==adjust_node ||
+      type(r)==penalty_node ||
+      (type(r)==kern_node && subtype(r)==explicit))
+    return 1;
+  return 0;
+}
+
+void 
+hnj_hyphenation (halfword head, halfword tail) {
+  int lchar, i;
+  struct tex_language* lang;
+  lang_variables langdata;
+  char utf8word[(4*MAX_WORD_LEN)+1] = {0};
+  int wordlen = 0;
+  char *hy = utf8word;
+  char *replacement = NULL;
+  halfword s, r = head, wordstart = null, save_tail = null, left = null, right = null;
+
+  /* this first movement assures two things: 
+   * a) that we won't waste lots of time on something that has been
+   * handled already (in that case, none of the glyphs match |simple_character|).  
+   * b) that the first word can be hyphenated. if the movement was
+   * not explicit, then the indentation at the start of a paragraph
+   * list would make find_next_wordstart() look too far ahead.
+   */
+ 
+  while (r!=null && (type(r)!=glyph_node || !is_simple_character(r)))
+    r =vlink(r);
+  /* this will make |r| a glyph node with subtype_character */
+  r = find_next_wordstart(r); 
+  if (r==null) 
+    return;
+
+  assert (tail!=null);
+  save_tail = vlink(tail);
+  s = new_penalty(0);
+  couple_nodes(tail, s);
+
+  while (r!=null) { /* could be while(1), but let's be paranoid */
+    wordstart = r;
+    assert (is_simple_character(wordstart));
+    int clang = char_lang(wordstart);
+    int lhmin = char_lhmin(wordstart);
+    int rhmin = char_rhmin(wordstart);
+    langdata.pre_hyphen_char = get_pre_hyphen_char(clang);
+    langdata.post_hyphen_char = get_post_hyphen_char(clang);
+    while (r!=null && 
+		   type(r)==glyph_node && 
+		   is_simple_character(r) && 
+		   clang == char_lang(r) && 
+		   (lchar = get_lc_code(character(r)))>0) {
+      wordlen++;
+      hy = utf8_idpb(hy,character(r));
+      /* this should not be needed  any more */
+      /*if (vlink(r)!=null) alink(vlink(r))=r;*/
+      r = vlink(r);
+    }
+    if (valid_wordend(r) && wordlen>=lhmin+rhmin && (lang=tex_languages[clang])!=NULL) {
+      *hy=0;
+      if (lang->exceptions!=0 && 
+		  (replacement = hyphenation_exception(lang->exceptions,utf8word))!=NULL) {
+#ifdef VERBOSE
+		fprintf(stderr,"replacing %s (c=%d) by %s\n",utf8word,clang,replacement);
+#endif		
+		do_exception(wordstart,r,replacement);
+		free(replacement);
+      } else if (lang->patterns!=NULL) {
+	
+	left = wordstart;
+	for (i=lhmin;i>1;i--) {
+	  left = vlink(left);
+	  while (!is_simple_character(left))
+	    left = vlink(left);	    
+	}
+	right = r;
+	for (i=rhmin;i>0;i--) {
+	  right = alink(right);
+	  while (!is_simple_character(right))
+	    right = alink(right);
+	}
+	
+#ifdef VERBOSE
+	fprintf(stderr,"hyphenate %s (c=%d,l=%d,r=%d) from %c to %c\n",utf8word,
+		clang,lhmin,rhmin,
+		character(left), character(right));
+#endif		
+	(void)hnj_hyphen_hyphenate(lang->patterns,wordstart,r,wordlen,left,right, &langdata); 
+      }
+    }
+    wordlen = 0;
+    hy = utf8word;
+    if (r==null)
+      break;
+    r = find_next_wordstart(r);
+  }
+  flush_node(vlink(tail));
+  vlink(tail) = save_tail;
+}
+
+
+void 
+new_hyphenation (halfword head, halfword tail) {
+  register int callback_id = 0;
+  if (head==null || vlink(head)==null)
+    return;
+  fix_node_list (head); /* TODO: use couple_nodes() in append_tail()!*/
+  callback_id = callback_defined(hyphenate_callback);
+  if (callback_id>0) {
+    lua_State *L = Luas[0];
+    lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+    lua_rawgeti(L,-1, callback_id);
+    if (!lua_isfunction(L,-1)) {
+      lua_pop(L,2);
+      return;
+    }
+    nodelist_to_lua(L,head);
+    nodelist_to_lua(L,tail);
+    if (lua_pcall(L,2,0,0) != 0) {
+      fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+      lua_pop(L,2);
+      lua_error(L);
+      return;
+    } 
+    lua_pop(L,1);
+  } else {
+    hnj_hyphenation(head,tail);
+  }
+}
+
+/* dumping and undumping fonts */
+
+#define dump_string(a)				\
+  if (a!=NULL) {				\
+    x = strlen(a)+1;				\
+    dump_int(x);  dump_things(*a, x);		\
+  } else {					\
+    x = 0; dump_int(x);				\
+  }
+
+
+void dump_one_language (int i) {
+  char *s = NULL;
+  unsigned x = 0;
+  struct tex_language *lang;
+  lang = tex_languages[i];
+  dump_int(lang->id);
+  dump_int(lang->pre_hyphen_char);
+  dump_int(lang->post_hyphen_char);
+  if (lang->patterns!=NULL) {
+    s = (char *)hnj_serialize(lang->patterns);
+  }
+  dump_string(s);
+  if (s!=NULL) {
+    free(s);
+    s = NULL;
+  }
+  if (lang->exceptions!=0)
+   s = exception_strings(lang);
+  dump_string(s);
+  if (s!=NULL) {
+    free(s);
+  }
+  free (lang);
+}
+
+void dump_language_data (void) {
+  int i;
+  dump_int(next_lang_id);
+  for (i=0;i<next_lang_id;i++) {
+    if (tex_languages[i]) {
+      dump_int(1);
+      dump_one_language(i);
+    } else {
+      dump_int(0);
+    }
+  }
+}
+
+
+void undump_one_language (int i) {
+  char *s = NULL;
+  unsigned x = 0;
+  struct tex_language *lang = get_language(i);
+  undump_int(x); lang->id = x;
+  undump_int(x); lang->pre_hyphen_char = x;
+  undump_int(x); lang->post_hyphen_char = x;
+  /* patterns */
+  undump_int (x);
+  if (x>0) {
+    s = xmalloc(x); 
+    undump_things(*s,x);
+    load_patterns(lang,(unsigned char *)s);
+    free(s);
+  }
+  /* exceptions */
+  undump_int (x);
+  if (x>0) {
+    s = xmalloc(x); 
+    undump_things(*s,x);
+    load_hyphenation(lang,(unsigned char *)s);
+    free(s);
+  }
+}
+
+void undump_language_data (void) {
+  int i;
+  unsigned x, numlangs;
+  undump_int(numlangs);
+  for (i=0;i<numlangs;i++) {
+    undump_int(x);
+    if (x==1) {
+      undump_one_language(i);
+    }
+  }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/.indent.pro b/Build/source/texk/web2c/luatexdir/lua/.indent.pro
new file mode 100644
index 00000000000..e9e690f1ba8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/.indent.pro
@@ -0,0 +1,12 @@
+/* $Id$ */
+--k-and-r-style
+--blank-lines-after-procedures
+--line-length 80
+--procnames-start-lines
+--no-space-after-function-call-names
+--dont-break-procedure-type
+--space-after-cast
+/* this does not work in indent 2.2.6 :-( */
+--no-tabs
+/* this is new in indent 2.2.9 */
+--preprocessor-indentation 2
diff --git a/Build/source/texk/web2c/luatexdir/lua/lcallbacklib.c b/Build/source/texk/web2c/luatexdir/lua/lcallbacklib.c
new file mode 100644
index 00000000000..fa207420dfb
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lcallbacklib.c
@@ -0,0 +1,463 @@
+/* $Id: lcallbacklib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+extern int do_run_callback (int special, char *values, va_list vl);
+
+int callback_set[total_callbacks] = {0};
+
+static const char *const callbacknames[] = {
+  "", /* empty on purpose */
+  "find_write_file",
+  "find_output_file",
+  "find_image_file",
+  "find_format_file",
+  "find_read_file",      "open_read_file",
+  "find_ocp_file",       "read_ocp_file",
+  "find_vf_file",        "read_vf_file",
+  "find_data_file",      "read_data_file",
+  "find_font_file",      "read_font_file",
+  "find_map_file",       "read_map_file",
+  "find_enc_file",       "read_enc_file",
+  "find_type1_file",     "read_type1_file",
+  "find_truetype_file",  "read_truetype_file",
+  "find_opentype_file",  "read_opentype_file",
+  "find_sfd_file",       "read_sfd_file",
+  "find_pk_file",        "read_pk_file",
+  "show_error_hook",
+  "process_input_buffer",
+  "start_page_number",  "stop_page_number",
+  "start_run",          "stop_run",
+  "define_font",
+  "token_filter",
+  "pre_output_filter",
+  "buildpage_filter",
+  "hpack_filter",  "vpack_filter",
+  "char_exists", 
+  "hyphenate", 
+  "ligaturing",
+  "kerning",
+  "pre_linebreak_filter", 
+  "linebreak_filter", 
+  "post_linebreak_filter", 
+  NULL };
+
+int callback_callbacks_id = 0;
+
+void 
+get_lua_boolean  (char *table, char *name, boolean *target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_getglobal(Luas[0],table);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isboolean(Luas[0],-1)) {
+      *target = (lua_toboolean(Luas[0],-1));
+    } else if (lua_isnumber(Luas[0],-1)) {
+      *target = (lua_tonumber(Luas[0],-1)==0 ? 0 : 1);
+    }
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+void 
+get_saved_lua_boolean (int r, char *name, boolean *target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_rawgeti(Luas[0],LUA_REGISTRYINDEX,r);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isboolean(Luas[0],-1)) {
+      *target = lua_toboolean(Luas[0],-1);
+    } else if (lua_isnumber(Luas[0],-1)) {
+      *target = (lua_tonumber(Luas[0],-1)==0 ? 0 : 1);
+    } 
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+void 
+get_lua_number (char *table, char *name, integer *target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_getglobal(Luas[0],table);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isnumber(Luas[0],-1)) {
+      *target = lua_tonumber(Luas[0],-1);
+    }
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+void 
+get_saved_lua_number (int r, char *name, integer *target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_rawgeti(Luas[0],LUA_REGISTRYINDEX,r);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isnumber(Luas[0],-1)) {
+      *target = lua_tonumber(Luas[0],-1);
+    } 
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+
+void 
+get_lua_string (char *table, char *name, char **target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_getglobal(Luas[0],table);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isstring(Luas[0],-1)) {
+      *target = (char *)lua_tostring(Luas[0],-1);
+    }
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+void 
+get_saved_lua_string (int r, char *name, char **target) {
+  int stacktop;
+  stacktop = lua_gettop(Luas[0]);  
+  luaL_checkstack(Luas[0],2,"out of stack space");
+  lua_rawgeti(Luas[0],LUA_REGISTRYINDEX,r);
+  if (lua_istable(Luas[0],-1)) {
+    lua_getfield(Luas[0],-1,name);
+    if (lua_isstring(Luas[0],-1)) {
+      *target = (char *)lua_tostring(Luas[0],-1);
+    } 
+  }
+  lua_settop(Luas[0],stacktop);
+  return;
+}
+
+
+#define CALLBACK_BOOLEAN        'b'
+#define CALLBACK_INTEGER        'd'
+#define CALLBACK_LINE           'l'
+#define CALLBACK_STRNUMBER      's'
+#define CALLBACK_STRING         'S'
+#define CALLBACK_CHARNUM        'c'
+
+int 
+run_saved_callback (int r, char *name, char *values, ...) {
+  va_list args;
+  int ret = 0;
+  lua_State *L = Luas[0];
+  int stacktop = lua_gettop(L);  
+  va_start(args,values);
+  luaL_checkstack(L,2,"out of stack space");
+  lua_rawgeti(L,LUA_REGISTRYINDEX,r);
+  lua_pushstring(L,name);
+  lua_rawget(L,-2);
+  if (lua_isfunction(L,-1)) {
+    ret = do_run_callback(2,values,args);
+  }
+  va_end(args);
+  lua_settop(L,stacktop);
+  return ret;
+}
+
+
+int
+run_and_save_callback (int i, char *values, ...) {
+  va_list args;
+  int ret = 0;
+  lua_State *L = Luas[0];
+  int stacktop = lua_gettop(L);
+  va_start(args,values);
+  luaL_checkstack(L,2,"out of stack space");
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1,i);
+  if (lua_isfunction(L,-1)) {
+    ret = do_run_callback(1,values,args);
+  }
+  va_end(args);
+  if (ret>0) {
+    ret = luaL_ref(L,LUA_REGISTRYINDEX);
+  }
+  lua_settop(L,stacktop);
+  return ret;
+}
+
+
+int
+run_callback (int i, char *values, ...) {
+  va_list args;
+  int ret = 0;
+  lua_State *L = Luas[0];
+  int stacktop = lua_gettop(L);
+  va_start(args,values);
+  luaL_checkstack(L,2,"out of stack space");
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1, i);
+  if (lua_isfunction(L,-1)) {
+    ret = do_run_callback(0,values,args);
+  }
+  va_end(args);
+  lua_settop(L,stacktop);
+  return ret;
+}
+
+int
+do_run_callback (int special, char *values, va_list vl) {
+  int ret, len;
+  int narg,nres;
+  char *s;
+  char cs;
+  int *bufloc;
+  char *ss = NULL;
+  int retval = 0;
+  lua_State *L = Luas[0];
+  if (special==2) { /* copy the enclosing table */
+    luaL_checkstack(L,1,"out of stack space");
+    lua_pushvalue(L,-2);
+  }
+  for (narg = 0; *values; narg++) {
+    luaL_checkstack(L,1,"out of stack space");
+    switch (*values++) {
+    case CALLBACK_CHARNUM: /* an ascii char! */ 
+	  cs = (char)va_arg(vl, int);
+	  lua_pushlstring(L,&cs, 1);
+      break;
+    case CALLBACK_STRING: /* C string */ 
+	  s = va_arg(vl, char *);
+      lua_pushstring(L, s);
+      break;
+    case CALLBACK_INTEGER: /* int */ 
+      lua_pushnumber(L, va_arg(vl, int));
+      break;
+    case CALLBACK_STRNUMBER: /* TeX string */ 
+      s = makeclstring(va_arg(vl, int),&len);
+      lua_pushlstring(L, s,len);
+      break;
+    case CALLBACK_BOOLEAN: /* boolean */ 
+      lua_pushboolean(L, va_arg(vl, int));
+      break;
+    case CALLBACK_LINE: /* a buffer section, with implied start */ 
+      lua_pushlstring(L, (char *)(buffer+first), va_arg(vl, int));
+      break;
+    case '-': 
+      narg--;
+      break;
+    case '>': 
+      goto ENDARGS;
+    default :
+      ;
+    }
+  }
+ ENDARGS:
+  nres = strlen(values);
+  if (special==1) {
+    nres++;
+  }
+  if (special==2) {
+    narg++;
+  }
+  if(lua_pcall(L,narg,nres,0) != 0) {
+    /* Can't be more precise here, could be called before 
+	 * TeX initialization is complete 
+	 */
+    fprintf(stderr,"This went wrong: %s\n",lua_tostring(L,-1));
+	error();
+    return 0;
+  };
+  if (nres==0) {
+    return 1;
+  }
+  nres = -nres;
+  while (*values) {
+    switch (*values++) {
+    case CALLBACK_BOOLEAN: 
+      if (!lua_isboolean(L,nres)) {
+		fprintf(stderr,"Expected a boolean, not: %s\n", lua_typename(L,lua_type(L,nres)));
+		goto EXIT;
+      }
+      int b = lua_toboolean(L,nres);
+      *va_arg(vl, boolean *) = (boolean)b;
+      break;
+    case CALLBACK_INTEGER: 
+      if (!lua_isnumber(L,nres)) {
+		fprintf(stderr,"Expected a number, not: %s\n", lua_typename(L,lua_type(L,nres)));
+		goto EXIT;
+      }
+      b = lua_tonumber(L,nres);
+      *va_arg(vl, int *) = b;
+      break;
+    case CALLBACK_LINE:  /* TeX line */
+      if (!lua_isstring(L,nres)) {
+		if (!lua_isnil(L,nres))
+		  fprintf(stderr,"Expected a string for (l), not: %s\n", 
+				  lua_typename(L,lua_type(L,nres))); 
+		goto EXIT;
+      }
+      s = (char *)lua_tolstring(L,nres, (size_t *)&len);
+      if (s!=NULL) { /* |len| can be zero */
+		bufloc = va_arg(vl, int *);
+		ret = *bufloc;
+		check_buffer_overflow (ret+len);
+		while (len--) {
+		  buffer[(*bufloc)++] = *s++;
+		}
+		while ((*bufloc)-1>ret && buffer[(*bufloc)-1] == ' ')
+		  (*bufloc)--;
+      } else {
+		bufloc = 0;
+	  }
+      break;
+    case CALLBACK_STRNUMBER:  /* TeX string */
+      if (!lua_isstring(L,nres)) {
+		if (!lua_isnil(L,nres)) {
+		  fprintf(stderr,"Expected a string for (s), not: %s\n", 
+				  lua_typename(L,lua_type(L,nres)));
+		  goto EXIT;
+		}
+      }
+	  s = (char *)lua_tolstring(L,nres,(size_t *)&len);
+      if (s==NULL) /* |len| can be zero */
+		*va_arg(vl, int *) = 0;
+      else {
+		*va_arg(vl, int *) = maketexlstring(s,len);
+      }
+      break;
+    case CALLBACK_STRING:  /* C string aka buffer */
+      if (!lua_isstring(L,nres)) {
+		if (!lua_isnil(L,nres)) {
+		  fprintf(stderr,"Expected a string for (S), not: %s\n", 
+				  lua_typename(L,lua_type(L,nres)));
+		  goto EXIT;
+		}
+      }
+	  s = (char *)lua_tolstring(L,nres,(size_t *)&len);
+
+      if (s==NULL) /* |len| can be zero */
+		*va_arg(vl, int *) = 0;
+      else {
+		ss = xmalloc(len+1);
+        (void)memcpy(ss,s,(len+1));
+		*va_arg(vl, char **) = ss;
+      }
+      break;
+    default: 
+      fprintf(stdout,"invalid return value type");
+      goto EXIT;
+    }
+    nres++;
+  }
+  retval = 1;
+ EXIT:
+  return retval;
+}
+
+void
+destroy_saved_callback (int i) {
+  luaL_unref(Luas[0],LUA_REGISTRYINDEX,i);
+}
+
+static int callback_register (lua_State *L) {
+  int cb;
+  char *s;
+  if (!lua_isstring(L,1) || 
+      ((!lua_isfunction(L,2)) && !lua_isnil(L,2))) {
+    lua_pushnil(L);
+    lua_pushstring(L,"Invalid arguments to callback.register.");
+    return 2;
+  }
+  s = (char *)lua_tostring(L,1);
+  for(cb=0;cb<total_callbacks;cb++) {
+    if (strcmp(callbacknames[cb],s)==0) 
+      break;
+  }
+  if (cb==total_callbacks) {
+    lua_pushnil(L);
+    lua_pushstring(L,"No such callback exists.");
+    return 2;
+  }
+  if (lua_isfunction(L,2)) {
+    callback_set[cb]=cb;
+  } else {
+    callback_set[cb]=0;
+  }
+  luaL_checkstack(L,2,"out of stack space");
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id); /* push the table */
+  lua_pushvalue(L,2);    /* the function or nil */
+  lua_rawseti(L,-2,cb);
+  lua_rawseti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_pushnumber(L,cb);
+  return 1;
+}
+
+static int callback_find (lua_State *L) {
+  int cb;
+  char * s;
+  if (!lua_isstring(L,1)) {
+    lua_pushnil(L);
+    lua_pushstring(L,"Invalid arguments to callback.find.");
+    return 2;
+  }
+  s = (char *)lua_tostring(L,1);
+  for(cb=0;cb<total_callbacks;cb++) {
+    if (strcmp(callbacknames[cb],s)==0) 
+      break;
+  }
+  if (cb==total_callbacks) {
+    lua_pushnil(L);
+    lua_pushstring(L,"No such callback exists.");
+    return 2;
+  }
+  luaL_checkstack(L,2,"out of stack space");
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id); /* push the table */
+  lua_rawgeti(L,-1,cb);
+  return 1;
+}
+
+
+static int callback_listf (lua_State *L) {
+  int i;
+  luaL_checkstack(L,3,"out of stack space");
+  lua_newtable(L);
+  for (i=1; callbacknames[i]; i++) {
+    lua_pushstring(L,callbacknames[i]);
+    if (callback_defined(i)) {
+      lua_pushboolean(L,1);
+    } else {
+      lua_pushboolean(L,0);
+    }
+    lua_rawset(L,-3);
+  }
+  return 1;
+}
+
+static const struct luaL_reg callbacklib [] = {
+  {"find",    callback_find},
+  {"register",callback_register},
+  {"list",    callback_listf},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_callback (lua_State *L) 
+{
+  luaL_register(L, "callback", callbacklib);
+  luaL_checkstack(L,1,"out of stack space");
+  lua_newtable(L);
+  callback_callbacks_id = luaL_ref(L,LUA_REGISTRYINDEX);
+  return 1;
+}
+
+
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/lfontlib.c b/Build/source/texk/web2c/luatexdir/lua/lfontlib.c
new file mode 100644
index 00000000000..13632527082
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lfontlib.c
@@ -0,0 +1,213 @@
+/* $Id: lfontlib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+/* this function is in vfovf.c for the moment */
+extern int make_vf_table(lua_State *L, char *name, scaled s);
+
+static int 
+font_read_tfm (lua_State *L) {
+  internalfontnumber f;
+  scaled s;
+  int k;
+  char *cnom;
+  if(lua_isstring(L, 1)) {
+    cnom = (char *)lua_tostring(L, 1);
+    if(lua_isnumber(L, 2)) {
+      s = (integer)lua_tonumber(L,2);
+	  if (strlen(cnom)) {
+		f = new_font();
+		if (read_tfm_info(f, cnom, "", s)) {
+		  k =  font_to_lua(L,f);
+		  delete_font(f);
+		  return k;
+		} else {
+		  delete_font(f);
+		  lua_pushstring(L, "font loading failed");
+		  lua_error(L);
+		}
+      } else {
+		lua_pushstring(L, "expected tfm name as first argument");
+		lua_error(L);
+      }
+    } else {
+      lua_pushstring(L, "expected an integer size as second argument");
+      lua_error(L);
+    }
+  } else {
+    lua_pushstring(L, "expected tfm name as first argument");
+    lua_error(L);
+  }
+  return 2; /* not reached */
+}
+
+
+static int 
+font_read_vf (lua_State *L) {
+  scaled s;
+  char *cnom;
+  if(lua_isstring(L, 1)) {
+    cnom = (char *)lua_tostring(L, 1);
+	if (strlen(cnom)) {
+	  if(lua_isnumber(L, 2)) {
+		s = lua_tonumber(L,2);
+		return make_vf_table(L,cnom,s);
+	  } else {
+		lua_pushstring(L, "expected an integer size as second argument");
+		lua_error(L);
+		return 2;
+	  }
+	}
+  }
+  lua_pushstring(L, "expected vf name as first argument"); 
+  lua_error(L);
+  return 2; /* not reached */
+}
+
+static int 
+tex_current_font (lua_State *L) {
+  int i;
+  i = (int)luaL_optinteger(L,1,0);
+  if (i>0) {
+	if (is_valid_font(i)) {
+	  zset_cur_font(i);
+	  return 0;
+	} else {
+	  lua_pushstring(L, "expected a valid font id");
+	  lua_error(L);
+	  return 2; /* not reached */
+	}
+  } else {
+	lua_pushnumber(L,get_cur_font());
+	return 1;
+  }
+}
+
+static int 
+tex_max_font (lua_State *L) {
+  lua_pushnumber(L,max_font_id());
+  return 1;
+}
+
+
+static int 
+tex_each_font_next (lua_State *L) {
+  int i,m; /* id */
+  m = lua_tonumber(L,1);
+  i = lua_tonumber(L,2);
+  i++;
+  while(i<=m && !is_valid_font(i))
+    i++; 
+  if (i>m) {
+    lua_pushnil(L);
+    return 1;
+  } else {
+    lua_pushnumber(L, i);
+    font_to_lua (L, i);
+    return 2;
+  }
+}
+
+static int 
+tex_each_font (lua_State *L) {
+  lua_pushcclosure(L, tex_each_font_next, 0);
+  lua_pushnumber(L, max_font_id());
+  lua_pushnumber(L, 0);
+  return 3;
+}
+
+static int 
+frozenfont (lua_State *L) {
+  int i;
+  i = (int)luaL_checkinteger(L,1);
+  if (i) {
+    if (is_valid_font(i)) {
+      if (font_touched(i) || font_used(i)) {
+	lua_pushboolean(L,1);
+      } else {
+	lua_pushboolean(L,0);
+      }
+    } else {
+      lua_pushnil(L);
+    }
+    return 1;	
+  } else {
+    lua_pushstring(L, "expected an integer argument"); 
+    lua_error(L);
+  }
+  return 0; /* not reached */
+}
+
+
+static int 
+setfont (lua_State *L) {
+  int i;
+  i = (int)luaL_checkinteger(L,-2);
+  if (i) {
+    luaL_checktype(L,-1,LUA_TTABLE);
+    if (is_valid_font(i)) {
+      if (! (font_touched(i) || font_used(i))) {
+	font_from_lua (L,i) ;
+      } else {
+	lua_pushstring(L, "that font has been accessed already, changing it is forbidden");
+	lua_error(L);
+      }
+    } else {
+      lua_pushstring(L, "that integer id is not a valid font");
+      lua_error(L);
+    }
+  }
+  return 0;
+}
+
+
+static int 
+deffont (lua_State *L) {
+  int i;
+  luaL_checktype(L,-1,LUA_TTABLE);
+
+  i = new_font();
+  if(font_from_lua (L,i)) {
+    lua_pushnumber(L,i);
+    return 1;
+  } else {
+    lua_pop(L,1); /* pop the broken table */
+    delete_font(i);
+    lua_pushstring(L, "font creation failed");
+    lua_error(L);
+  }  
+  return 0; /* not reached */
+}
+
+static int 
+getfont (lua_State *L) {
+  int i;
+  i = (int)luaL_checkinteger(L,-1);
+  if (i && is_valid_font(i) &&  font_to_lua (L, i))
+    return 1;
+  lua_pushnil(L);
+  return 1;
+}
+
+
+static const struct luaL_reg fontlib [] = {
+  {"read_tfm",      font_read_tfm},
+  {"read_vf",       font_read_vf},
+  {"current",       tex_current_font},
+  {"max",           tex_max_font},
+  {"each",          tex_each_font},
+  {"getfont",       getfont},
+  {"setfont",       setfont},
+  {"define",        deffont},
+  {"frozen",        frozenfont},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_font (lua_State *L) 
+{
+  luaL_register(L, "font", fontlib);
+  make_table(L,"fonts","getfont","setfont");
+  return 1;
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/limglib.c b/Build/source/texk/web2c/luatexdir/lua/limglib.c
new file mode 100644
index 00000000000..fd75e49799a
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/limglib.c
@@ -0,0 +1,714 @@
+/* $Id: limglib.c 1098 2008-03-09 10:28:19Z hhenkel $ */
+
+#include <stdio.h>
+#include <string.h>
+#include <assert.h>
+#include <../lua51/lua.h>
+#include <../lua51/lauxlib.h>
+#include <ptexlib.h>
+#include "../image/image.h"
+#include "../luatex-api.h"
+
+/**********************************************************************/
+
+#ifdef DEBUG
+static void stackDump(lua_State * L, char *s)
+{
+    int i;
+    int top = lua_gettop(L);
+    printf("\n=== stackDump <%s>: ", s);
+    for (i = 1; i <= top; i++) {        /* repeat for each level */
+        int t = lua_type(L, i);
+        printf("%d: ", i);
+        switch (t) {
+        case LUA_TSTRING:      /* strings */
+            printf("`%s'", lua_tostring(L, i));
+            break;
+        case LUA_TBOOLEAN:     /* booleans */
+            printf(lua_toboolean(L, i) ? "true" : "false");
+            break;
+        case LUA_TNUMBER:      /* numbers */
+            printf("%g", lua_tonumber(L, i));
+            break;
+        default:               /* other values */
+            printf("%s", lua_typename(L, t));
+            break;
+        }
+        printf("  ");           /* put a separator */
+    }
+    printf("\n");
+}
+#endif
+
+/**********************************************************************/
+
+typedef enum { P__ZERO, P_ATTR, P_COLORDEPTH, P_COLORSPACE, P_DEPTH, P_FILENAME,
+    P_FILEPATH, P_HEIGHT, P_IMAGETYPE, P_INDEX, P_OBJNUM, P_PAGE, P_PAGEBOX,
+    P_TOTALPAGES, P_TRANSFORM, P_WIDTH, P_XRES, P_XSIZE, P_YRES, P_YSIZE,
+    P__SENTINEL
+} parm_idx;
+
+typedef struct {
+    const char *name;           /* parameter name */
+    parm_idx idx;               /* index within img_parms array */
+} parm_struct;
+
+parm_struct img_parms[] = {
+    {NULL, P__ZERO},            /* dummy; lua indices run from 1 */
+    {"attr", P_ATTR},
+    {"colordepth", P_COLORDEPTH},
+    {"colorspace", P_COLORSPACE},
+    {"depth", P_DEPTH},
+    {"filename", P_FILENAME},
+    {"filepath", P_FILEPATH},
+    {"height", P_HEIGHT},
+    {"imagetype", P_IMAGETYPE},
+    {"index", P_INDEX},
+    {"objnum", P_OBJNUM},
+    {"page", P_PAGE},
+    {"pagebox", P_PAGEBOX},
+    {"pages", P_TOTALPAGES},
+    {"transform", P_TRANSFORM},
+    {"width", P_WIDTH},
+    {"xres", P_XRES},
+    {"xsize", P_XSIZE},
+    {"yres", P_YRES},
+    {"ysize", P_YSIZE},
+    {NULL, P__SENTINEL}
+};
+
+#define imgtype_max 4
+const char *imgtype_s[] = { "none", "pdf", "png", "jpg", "jbig2", NULL };
+
+#define pagebox_max 5
+const char *pdfboxspec_s[] =
+    { "none", "media", "crop", "bleed", "trim", "art", NULL };
+
+/**********************************************************************/
+
+static void image_to_lua(lua_State * L, image * a)
+{                               /* key user ... */
+    int i, j;
+    image_dict *d = img_dict(a);
+    assert(d != NULL);
+    lua_pushvalue(L, -1);       /* k k u ... */
+    lua_gettable(L, LUA_ENVIRONINDEX);  /* i? k u ... */
+    if (!lua_isnumber(L, -1))   /* !i k u ... */
+        luaL_error(L, "image_to_lua not a valid image key: %s",
+                   lua_tostring(L, -2));
+    i = lua_tointeger(L, -1);   /* i k u ... */
+    lua_pop(L, 2);              /* u ... */
+    switch (i) {
+    case P_WIDTH:
+        if (is_wd_running(a))
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_width(a));
+        break;
+    case P_HEIGHT:
+        if (is_ht_running(a))
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_height(a));
+        break;
+    case P_DEPTH:
+        if (is_dp_running(a))
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_depth(a));
+        break;
+    case P_TRANSFORM:
+        lua_pushinteger(L, img_transform(a));
+        break;
+        /* now follow all image_dict entries */
+    case P_FILENAME:
+        if (img_filename(d) == NULL || strlen(img_filename(d)) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushstring(L, img_filename(d));
+        break;
+    case P_FILEPATH:
+        if (img_filepath(d) == NULL || strlen(img_filepath(d)) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushstring(L, img_filepath(d));
+        break;
+    case P_ATTR:
+        if (img_attr(d) == NULL || strlen(img_attr(d)) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushstring(L, img_attr(d));
+        break;
+    case P_PAGE:
+        if (img_pagename(d) != NULL && strlen(img_pagename(d)) != 0)
+            lua_pushstring(L, img_pagename(d));
+        else
+            lua_pushinteger(L, img_pagenum(d));
+        break;
+    case P_TOTALPAGES:
+        lua_pushinteger(L, img_totalpages(d));
+        break;
+    case P_XSIZE:
+        lua_pushinteger(L, img_xsize(d));
+        break;
+    case P_YSIZE:
+        lua_pushinteger(L, img_ysize(d));
+        break;
+    case P_XRES:
+        lua_pushinteger(L, img_xres(d));
+        break;
+    case P_YRES:
+        lua_pushinteger(L, img_yres(d));
+        break;
+    case P_COLORSPACE:
+        if (img_colorspace(d) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_colorspace(d));
+        break;
+    case P_COLORDEPTH:
+        if (img_colordepth(d) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_colordepth(d));
+        break;
+    case P_IMAGETYPE:
+        j = img_type(d);
+        if (j >= 0 && j <= imgtype_max) {
+            if (j == IMAGE_TYPE_NONE)
+                lua_pushnil(L);
+            else
+                lua_pushstring(L, imgtype_s[j]);
+        } else
+            assert(0);
+        break;
+    case P_PAGEBOX:
+        j = img_pagebox(d);
+        if (j >= 0 && j <= pagebox_max) {
+            if (j == PDF_BOX_SPEC_NONE)
+                lua_pushnil(L);
+            else
+                lua_pushstring(L, pdfboxspec_s[j]);
+        } else
+            assert(0);
+        break;
+    case P_OBJNUM:
+        if (img_objnum(d) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_objnum(d));
+        break;
+    case P_INDEX:
+        if (img_index(d) == 0)
+            lua_pushnil(L);
+        else
+            lua_pushinteger(L, img_index(d));
+        break;
+    default:
+        assert(0);
+    }                           /* v u ... */
+}
+
+static void lua_to_image(lua_State * L, image * a)
+{                               /* value key table ... */
+    int i;
+    image_dict *d = img_dict(a);
+    assert(d != NULL);
+    lua_pushvalue(L, -2);       /* k v k t ... */
+    lua_gettable(L, LUA_ENVIRONINDEX);  /* i? v k t ... */
+    if (!lua_isnumber(L, -1))   /* !i v k t ... */
+        luaL_error(L, "lua_to_image not a valid image key: %s",
+                   lua_tostring(L, -3));
+    i = lua_tointeger(L, -1);   /* i v k t ... */
+    lua_pop(L, 1);              /* v k t ... */
+    switch (i) {
+    case P_WIDTH:
+        if (img_is_refered(a))
+            luaL_error(L, "image.width is now read-only");
+        if (lua_isnil(L, -1))
+            set_wd_running(a);
+        else if (lua_type(L, -1) == LUA_TNUMBER)
+            img_width(a) = lua_tointeger(L, -1);
+        else if (lua_type(L, -1) == LUA_TSTRING)
+            img_width(a) = dimen_to_number(L, (char *) lua_tostring(L, -1));
+        else
+            luaL_error(L,
+                       "image.width needs integer or nil value or dimension string");
+        img_unset_scaled(a);
+        break;
+    case P_HEIGHT:
+        if (img_is_refered(a))
+            luaL_error(L, "image.height is now read-only");
+        if (lua_isnil(L, -1))
+            set_ht_running(a);
+        else if (lua_type(L, -1) == LUA_TNUMBER)
+            img_height(a) = lua_tointeger(L, -1);
+        else if (lua_type(L, -1) == LUA_TSTRING)
+            img_height(a) = dimen_to_number(L, (char *) lua_tostring(L, -1));
+        else
+            luaL_error(L,
+                       "image.height needs integer or nil value or dimension string");
+        img_unset_scaled(a);
+        break;
+    case P_DEPTH:
+        if (img_is_refered(a))
+            luaL_error(L, "image.depth is now read-only");
+        if (lua_isnil(L, -1))
+            set_dp_running(a);
+        else if (lua_type(L, -1) == LUA_TNUMBER)
+            img_depth(a) = lua_tointeger(L, -1);
+        else if (lua_type(L, -1) == LUA_TSTRING)
+            img_depth(a) = dimen_to_number(L, (char *) lua_tostring(L, -1));
+        else
+            luaL_error(L,
+                       "image.depth needs integer or nil value or dimension string");
+        img_unset_scaled(a);
+        break;
+    case P_TRANSFORM:
+        if (img_is_refered(a))
+            luaL_error(L, "image.transform is now read-only");
+        if (lua_isnumber(L, -1))
+            img_transform(a) = lua_tointeger(L, -1);
+        else
+            luaL_error(L, "image.transform needs integer value");
+        img_unset_scaled(a);
+        break;
+        /* now follow all image_dict entries */
+    case P_FILENAME:
+        if (img_state(d) >= DICT_FILESCANNED)
+            luaL_error(L, "image.filename is now read-only");
+        if (lua_isstring(L, -1)) {
+            if (img_filename(d) != NULL)
+                xfree(img_filename(d));
+            img_filename(d) = xstrdup(lua_tostring(L, -1));
+        } else
+            luaL_error(L, "image.filename needs string value");
+        break;
+    case P_ATTR:
+        if (img_state(d) >= DICT_FILESCANNED)
+            luaL_error(L, "image.attr is now read-only");
+        if (lua_isstring(L, -1) || lua_isnil(L, -1)) {
+            if (img_attr(d) != NULL)
+                xfree(img_attr(d));
+            if (lua_isstring(L, -1))
+                img_attr(d) = xstrdup(lua_tostring(L, -1));
+        } else
+            luaL_error(L, "image.attr needs string or nil value");
+        break;
+    case P_PAGE:
+        if (img_state(d) >= DICT_FILESCANNED)
+            luaL_error(L, "image.page is now read-only");
+        if (lua_type(L, -1) == LUA_TSTRING) {
+            if (img_pagename(d) != NULL)
+                xfree(img_pagename(d));
+            img_pagename(d) = xstrdup(lua_tostring(L, -1));
+            img_pagenum(d) = 0;
+        } else if (lua_type(L, -1) == LUA_TNUMBER) {
+            img_pagenum(d) = lua_tointeger(L, -1);
+            if (img_pagename(d) != NULL)
+                xfree(img_pagename(d));
+            img_pagename(d) = NULL;
+        } else
+            luaL_error(L, "image.page needs integer or string value");
+        break;
+    case P_COLORSPACE:
+        if (img_state(d) >= DICT_FILESCANNED)
+            luaL_error(L, "image.colorspace is now read-only");
+        if (lua_isnil(L, -1))
+            img_colorspace(d) = 0;
+        else if (lua_isnumber(L, -1))
+            img_colorspace(d) = lua_tointeger(L, -1);
+        else
+            luaL_error(L, "image.colorspace needs integer or nil value");
+        break;
+    case P_PAGEBOX:
+        if (img_state(d) >= DICT_FILESCANNED)
+            luaL_error(L, "image.pagebox is now read-only");
+        if (lua_isnil(L, -1))
+            img_pagebox(d) = PDF_BOX_SPEC_NONE;
+        else if (lua_isstring(L, -1))
+            img_pagebox(d) = luaL_checkoption(L, -1, "none", pdfboxspec_s);
+        else
+            luaL_error(L, "image.pagebox needs string or nil value");
+        break;
+    case P_FILEPATH:
+    case P_TOTALPAGES:
+    case P_XSIZE:
+    case P_YSIZE:
+    case P_XRES:
+    case P_YRES:
+    case P_IMAGETYPE:
+    case P_OBJNUM:
+    case P_INDEX:
+    case P_COLORDEPTH:
+        luaL_error(L, "image.%s is a read-only variable", img_parms[i].name);
+        break;
+    default:
+        assert(0);
+    }                           /* v k t ... */
+}
+
+/**********************************************************************/
+
+void fix_image_size(lua_State * L, image * a)
+{
+    if (!img_is_scaled(a) || is_wd_running(a) || is_ht_running(a)
+        || is_dp_running(a)) {
+        if (img_is_refered(a))
+            luaL_error(L, "image is read-only");
+        scale_img(a);
+    }
+}
+
+void copy_image(lua_State * L, lua_Number scale)
+{
+    image *a, **aa, *b, **bb;
+    if (lua_gettop(L) != 1)
+        luaL_error(L, "img.copy() needs exactly 1 argument");
+    aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);    /* a */
+    lua_pop(L, 1);              /* - */
+    a = *aa;
+    bb = (image **) lua_newuserdata(L, sizeof(image *));        /* b */
+    luaL_getmetatable(L, TYPE_IMG);     /* m b */
+    lua_setmetatable(L, -2);    /* b */
+    b = *bb = new_image();
+    if (!is_wd_running(a))
+        img_width(b) = zround(img_width(a) * scale);
+    if (!is_ht_running(a))
+        img_height(b) = zround(img_height(a) * scale);
+    if (!is_dp_running(a))
+        img_depth(b) = zround(img_depth(a) * scale);
+    img_transform(b) = img_transform(a);
+    img_dict(b) = img_dict(a);
+    if (img_dictref(a) != LUA_NOREF) {
+        lua_rawgeti(L, LUA_GLOBALSINDEX, img_dictref(a));       /* ad b */
+        img_dictref(b) = luaL_ref(L, LUA_GLOBALSINDEX); /* b */
+    } else
+        assert(img_state(img_dict(a)) >= DICT_REFERED);
+}
+
+/**********************************************************************/
+
+static int l_new_image(lua_State * L)
+{
+    image *a, **aa;
+    if (lua_gettop(L) > 1)
+        luaL_error(L, "img.new() needs maximum 1 argument");
+    if (lua_gettop(L) == 1 && !lua_istable(L, 1))
+        luaL_error(L, "img.new() needs table as optional argument");    /* (t) */
+    aa = (image **) lua_newuserdata(L, sizeof(image *));        /* i (t) */
+    luaL_getmetatable(L, TYPE_IMG);     /* m i (t) */
+    lua_setmetatable(L, -2);    /* i (t) */
+    a = *aa = new_image();
+    image_dict **add = (image_dict **) lua_newuserdata(L, sizeof(image_dict *));        /* ad i (t) */
+    luaL_getmetatable(L, TYPE_IMG_DICT);        /* m ad i (t) */
+    lua_setmetatable(L, -2);    /* ad i (t) */
+    img_dict(a) = *add = new_image_dict();
+    img_dictref(a) = luaL_ref(L, LUA_GLOBALSINDEX);     /* i (t) */
+    if (lua_gettop(L) != 1) {   /* i t, else just i */
+        lua_insert(L, -2);      /* t i */
+        lua_pushnil(L);         /* n t i (1st key for iterator) */
+        while (lua_next(L, -2) != 0) {  /* v k t i */
+            lua_to_image(L, a); /* v k t i */
+            lua_pop(L, 1);      /* k t i */
+        }                       /* t i */
+        lua_pop(L, 1);          /* i */
+    }                           /* i */
+    return 1;                   /* i */
+}
+
+static int l_copy_image(lua_State * L)
+{
+    if (lua_gettop(L) != 1)
+        luaL_error(L, "img.copy() needs exactly 1 argument");
+    if (lua_istable(L, 1))
+        l_new_image(L);         /* image --- if everything worked well */
+    else
+        copy_image(L, 1.0);     /* image */
+    return 1;                   /* image */
+}
+
+static int l_scan_image(lua_State * L)
+{
+    image *a, **aa;
+    if (lua_gettop(L) != 1)
+        luaL_error(L, "img.scan() needs exactly 1 argument");
+    if (lua_istable(L, 1))
+        l_new_image(L);         /* image --- if everything worked well */
+    aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);    /* image */
+    a = *aa;
+    image_dict *ad = img_dict(a);
+    if (img_state(ad) == DICT_NEW) {
+        read_img(ad, get_pdf_minor_version(), get_pdf_inclusion_errorlevel());
+        img_unset_scaled(a);
+    }
+    fix_image_size(L, a);
+    return 1;                   /* image */
+}
+
+/* these should go into some header file... */
+#define obj_type_ximage 8
+#define obj_aux(a)      obj_tab[a].int4 /* auxiliary pointer */
+#define obj_data_ptr    obj_aux /* pointer to |pdf_mem| */
+
+static halfword img_to_node(image * a, integer ref)
+{
+    image_dict *ad = img_dict(a);
+    assert(ad != NULL);
+    assert(img_objnum(ad) != 0);
+    halfword n = new_node(whatsit_node, pdf_refximage_node);
+    pdf_ximage_ref(n) = ref;
+    pdf_width(n) = img_width(a);
+    pdf_height(n) = img_height(a);
+    pdf_depth(n) = img_depth(a);
+    return n;
+}
+
+typedef enum { WR_WRITE, WR_IMMEDIATEWRITE, WR_NODE } wrtype_e;
+const char *wrtype_s[] =
+    { "img.write()", "img.immediatewrite()", "img.node()" };
+
+extern void lua_nodelib_push_fast(lua_State * L, halfword n);
+
+static void write_image_or_node(lua_State * L, wrtype_e writetype)
+{
+    image *a, **aa;
+    halfword n;
+    if (lua_gettop(L) != 1)
+        luaL_error(L, "%s needs exactly 1 argument", wrtype_s[writetype]);
+    if (lua_istable(L, 1))
+        l_new_image(L);         /* image --- if everything worked well */
+    aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);    /* image */
+    a = *aa;
+    image_dict *ad = img_dict(a);
+    assert(ad != NULL);
+    if (img_state(ad) == DICT_NEW) {
+        read_img(ad, get_pdf_minor_version(), get_pdf_inclusion_errorlevel());
+        img_unset_scaled(a);
+    }
+    fix_image_size(L, a);
+    check_pdfoutput(maketexstring(wrtype_s[writetype]), true);
+    flush_str(last_tex_string);
+    integer ref = img_to_array(a);
+    if (img_objnum(ad) == 0) {  /* not strictly needed here, could be delayed until out_image() */
+        pdf_ximage_count++;
+        pdf_create_obj(obj_type_ximage, pdf_ximage_count);
+        img_objnum(ad) = obj_ptr;
+        img_index(ad) = pdf_ximage_count;
+        obj_data_ptr(obj_ptr) = ref;
+    }
+    switch (writetype) {
+    case WR_WRITE:
+        n = img_to_node(a, ref);
+        new_tail_append(n);
+        break;                  /* image */
+    case WR_IMMEDIATEWRITE:
+        check_pdfminorversion();        /* does initialization stuff */
+        pdf_begin_dict(img_objnum(ad), 0);
+        write_img(ad);
+        break;                  /* image */
+    case WR_NODE:              /* image */
+        lua_pop(L, 1);          /* - */
+        n = img_to_node(a, ref);
+        lua_nodelib_push_fast(L, n);
+        break;                  /* node */
+    default:
+        assert(0);
+    }
+    if (img_state(ad) < DICT_REFERED)
+        img_state(ad) = DICT_REFERED;
+    img_set_refered(a);         /* now image may not be freed by gc */
+}
+
+static int l_write_image(lua_State * L)
+{
+    write_image_or_node(L, WR_WRITE);
+    return 1;                   /* image */
+}
+
+static int l_immediatewrite_image(lua_State * L)
+{
+    write_image_or_node(L, WR_IMMEDIATEWRITE);
+    return 1;                   /* image */
+}
+
+static int l_image_node(lua_State * L)
+{
+    write_image_or_node(L, WR_NODE);
+    return 1;                   /* node */
+}
+
+static int l_image_keys(lua_State * L)
+{
+    parm_struct *p = img_parms + 1;
+    if (lua_gettop(L) != 0)
+        luaL_error(L, "img.keys() goes without argument");
+    lua_newtable(L);            /* t */
+    for (; p->name != NULL; p++) {
+        lua_pushinteger(L, (int) p->idx);       /* k t */
+        lua_pushstring(L, p->name);     /* v k t */
+        lua_settable(L, -3);    /* t */
+    }
+    return 1;
+}
+
+static int l_image_types(lua_State * L)
+{
+    int i;
+    char **p;
+    if (lua_gettop(L) != 0)
+        luaL_error(L, "img.types() goes without argument");
+    lua_newtable(L);            /* t */
+    for (i = 1, p = (char **) (imgtype_s + 1); *p != NULL; p++, i++) {
+        lua_pushinteger(L, (int) i);    /* k t */
+        lua_pushstring(L, *p);  /* v k t */
+        lua_settable(L, -3);    /* t */
+    }
+    return 1;
+}
+
+static int l_image_boxes(lua_State * L)
+{
+    int i;
+    char **p;
+    if (lua_gettop(L) != 0)
+        luaL_error(L, "img.boxes() goes without argument");
+    lua_newtable(L);            /* t */
+    for (i = 1, p = (char **) (pdfboxspec_s + 1); *p != NULL; p++, i++) {
+        lua_pushinteger(L, (int) i);    /* k t */
+        lua_pushstring(L, *p);  /* v k t */
+        lua_settable(L, -3);    /* t */
+    }
+    return 1;
+}
+
+static const struct luaL_Reg imglib[] = {
+    {"new", l_new_image},
+    {"copy", l_copy_image},
+    {"scan", l_scan_image},
+    {"write", l_write_image},
+    {"immediatewrite", l_immediatewrite_image},
+    {"node", l_image_node},
+    {"keys", l_image_keys},
+    {"types", l_image_types},
+    {"boxes", l_image_boxes},
+    {NULL, NULL}                /* sentinel */
+};
+
+/**********************************************************************/
+/* Metamethods for image */
+
+static int m_img_get(lua_State * L)
+{
+    image **aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);    /* k u */
+    image_to_lua(L, *aa);       /* v u */
+    return 1;
+}
+
+static int m_img_set(lua_State * L)
+{
+    image **aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);    /* value key user */
+    lua_to_image(L, *aa);       /* v k u */
+    return 0;
+}
+
+static int m_img_mul(lua_State * L)
+{
+    image **aa;
+    lua_Number scale;
+    if (lua_isnumber(L, 1)) {   /* u? n */
+        aa = (image **) luaL_checkudata(L, 2, TYPE_IMG);        /* u n */
+        lua_insert(L, -2);      /* n a */
+    } else if (lua_isnumber(L, 2)) {    /* n u? */
+        aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);        /* n a */
+    }                           /* n a */
+    scale = lua_tonumber(L, 2); /* n a */
+    lua_pop(L, 1);              /* a */
+    copy_image(L, scale);       /* b */
+    return 1;
+}
+
+static int m_img_print(lua_State * L)
+{
+    image **aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);
+    image_dict *d = img_dict(*aa);
+    if (img_pagename(d) != NULL && strlen(img_pagename(d)) != 0)
+        lua_pushfstring(L, "<img{filename=\"%s\", page=\"%s\"}>",
+                        img_filename(d), img_pagename(d));
+    else
+        lua_pushfstring(L, "<img{filename=\"%s\", page=%d}>", img_filename(d),
+                        img_pagenum(d));
+    return 1;
+}
+
+static int m_img_gc(lua_State * L)
+{
+    image *a, **aa;
+    aa = (image **) luaL_checkudata(L, 1, TYPE_IMG);
+    a = *aa;
+#ifdef DEBUG
+    printf("\n===== IMG GC ===== a=%d ad=%d\n", a, img_dict(a));
+#endif
+    luaL_unref(L, LUA_GLOBALSINDEX, img_dictref(a));
+    if (!img_is_refered(a))
+        xfree(a);
+    return 0;
+}
+
+static const struct luaL_Reg img_m[] = {
+    {"__index", m_img_get},
+    {"__newindex", m_img_set},
+    {"__mul", m_img_mul},
+    {"__tostring", m_img_print},
+    {"__gc", m_img_gc},         /* finalizer */
+    {NULL, NULL}                /* sentinel */
+};
+
+/**********************************************************************/
+/* Metamethods for image_dict */
+
+static int m_img_dict_gc(lua_State * L)
+{
+    image_dict *ad, **add;
+    add = (image_dict **) luaL_checkudata(L, 1, TYPE_IMG_DICT);
+    ad = *add;
+#ifdef DEBUG
+    printf("\n===== IMG_DICT GC FREE ===== ad=%d\n", ad);
+#endif
+    if (img_state(ad) < DICT_REFERED)
+        free_image_dict(ad);
+    return 0;
+}
+
+static const struct luaL_Reg img_dict_m[] = {
+    {"__gc", m_img_dict_gc},    /* finalizer */
+    {NULL, NULL}                /* sentinel */
+};
+
+/**********************************************************************/
+
+void preset_environment(lua_State * L, parm_struct * p)
+{
+    int i;
+    lua_newtable(L);            /* t */
+    for (i = 1, ++p; p->name != NULL; i++, p++) {
+        assert(i == (int) p->idx);
+        lua_pushstring(L, p->name);     /* k t */
+        lua_pushinteger(L, (int) p->idx);       /* v k t */
+        lua_settable(L, -3);    /* t */
+    }
+    lua_replace(L, LUA_ENVIRONINDEX);   /* - */
+}
+
+int luaopen_img(lua_State * L)
+{
+    preset_environment(L, img_parms);
+    luaL_newmetatable(L, TYPE_IMG);
+    luaL_register(L, NULL, img_m);
+    luaL_newmetatable(L, TYPE_IMG_DICT);
+    luaL_register(L, NULL, img_dict_m);
+    luaL_register(L, "img", imglib);
+    return 1;
+}
+
+/**********************************************************************/
diff --git a/Build/source/texk/web2c/luatexdir/lua/lkpselib.c b/Build/source/texk/web2c/luatexdir/lua/lkpselib.c
new file mode 100644
index 00000000000..5ec4dfed869
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lkpselib.c
@@ -0,0 +1,272 @@
+/* $Id: lkpselib.c 1061 2008-02-20 09:51:04Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include <kpathsea/expand.h>
+#include <kpathsea/variable.h>
+#include <kpathsea/tex-glyph.h>
+#include <kpathsea/readable.h>
+
+static const int filetypes[] = {
+  kpse_gf_format,
+  kpse_pk_format,
+  kpse_any_glyph_format,
+  kpse_tfm_format, 
+  kpse_afm_format, 
+  kpse_base_format, 
+  kpse_bib_format, 
+  kpse_bst_format, 
+  kpse_cnf_format,
+  kpse_db_format,
+  kpse_fmt_format,
+  kpse_fontmap_format,
+  kpse_mem_format,
+  kpse_mf_format, 
+  kpse_mfpool_format, 
+  kpse_mft_format, 
+  kpse_mp_format, 
+  kpse_mppool_format, 
+  kpse_mpsupport_format,
+  kpse_ocp_format,
+  kpse_ofm_format, 
+  kpse_opl_format,
+  kpse_otp_format,
+  kpse_ovf_format,
+  kpse_ovp_format,
+  kpse_pict_format,
+  kpse_tex_format,
+  kpse_texdoc_format,
+  kpse_texpool_format,
+  kpse_texsource_format,
+  kpse_tex_ps_header_format,
+  kpse_troff_font_format,
+  kpse_type1_format, 
+  kpse_vf_format,
+  kpse_dvips_config_format,
+  kpse_ist_format,
+  kpse_truetype_format,
+  kpse_type42_format,
+  kpse_web2c_format,
+  kpse_program_text_format,
+  kpse_program_binary_format,
+  kpse_miscfonts_format,
+  kpse_web_format,
+  kpse_cweb_format,
+  kpse_enc_format,
+  kpse_cmap_format,
+  kpse_sfd_format,
+  kpse_opentype_format,
+  kpse_pdftex_config_format,
+  kpse_lig_format,
+  kpse_texmfscripts_format };
+
+static const char *const filetypenames[] = {
+  "gf",
+  "pk",
+  "bitmap font",
+  "tfm", 
+  "afm", 
+  "base", 
+  "bib", 
+  "bst", 
+  "cnf",
+  "ls-R",
+  "fmt",
+  "map",
+  "mem",
+  "mf", 
+  "mfpool", 
+  "mft", 
+  "mp", 
+  "mppool", 
+  "MetaPost support",
+  "ocp",
+  "ofm", 
+  "opl",
+  "otp",
+  "ovf",
+  "ovp",
+  "graphic/figure",
+  "tex",
+  "TeX system documentation",
+  "texpool",
+  "TeX system sources",
+  "PostScript header",
+  "Troff fonts",
+  "type1 fonts", 
+  "vf",
+  "dvips config",
+  "ist",
+  "truetype fonts",
+  "type42 fonts",
+  "web2c files",
+  "other text files",
+  "other binary files",
+  "misc fonts",
+  "web",
+  "cweb",
+  "enc files",
+  "cmap files",
+  "subfont definition files",
+  "opentype fonts",
+  "pdftex config",
+  "lig files",
+  "texmfscripts",
+  NULL };
+
+/* set to 1 by the |program_name| function */
+
+int program_name_set  = 0;
+
+#define TEST_PROGRAM_NAME_SET do {					\
+    if (! program_name_set) {						\
+      lua_pushstring(L, "Please call kpse.set_program_name() before using the library"); \
+      return lua_error(L);						\
+    }									\
+  } while (0)
+
+static int find_file (lua_State *L) {
+  int i;
+  char *st;
+  int ftype = kpse_tex_format;
+  int mexist = 0;
+  TEST_PROGRAM_NAME_SET;
+  if (!lua_isstring(L,1)) {
+    lua_pushstring(L, "not a file name");
+    lua_error(L);
+  }  
+  st = (char *)lua_tostring(L,1);
+  i = lua_gettop(L);  
+  while (i>1) {
+    if (lua_isboolean (L,i)) {
+      mexist = lua_toboolean (L,i);
+    } else if (lua_isnumber (L,i)) {
+      mexist = lua_tonumber (L,i) ;
+    } else if (lua_isstring(L,i)) {
+      int op = luaL_checkoption(L, i, NULL, filetypenames);
+      ftype = filetypes[op];
+    }
+    i--;
+  }
+  if (ftype==kpse_pk_format ||
+      ftype==kpse_gf_format ||
+      ftype==kpse_any_glyph_format) {
+    /* ret.format, ret.name, ret.dpi */
+    kpse_glyph_file_type ret;
+    lua_pushstring(L, kpse_find_glyph (st,mexist, ftype, &ret));
+  } else {
+    if (mexist>0) 
+      mexist = 1;
+    if (mexist<0) 
+      mexist = 0;
+    lua_pushstring(L, kpse_find_file (st,ftype,mexist));
+  }
+  return 1;
+}
+
+static int show_path (lua_State *L) {
+  int op = luaL_checkoption(L, -1, "tex", filetypenames);
+  int user_format = filetypes[op];
+  TEST_PROGRAM_NAME_SET;
+  if (!kpse_format_info[user_format].type) /* needed if arg was numeric */
+    kpse_init_format (user_format);
+  lua_pushstring (L, kpse_format_info[user_format].path);
+  return 1;
+}
+
+
+static int expand_path (lua_State *L) {
+  const char *st = luaL_checkstring(L,1);
+  TEST_PROGRAM_NAME_SET;
+  lua_pushstring(L, kpse_path_expand(st));
+  return 1;
+}
+
+static int expand_braces (lua_State *L) {
+  const char *st = luaL_checkstring(L,1);
+  TEST_PROGRAM_NAME_SET;
+  lua_pushstring(L, kpse_brace_expand(st));
+  return 1;
+}
+
+static int expand_var (lua_State *L) {
+  const char *st = luaL_checkstring(L,1);
+  TEST_PROGRAM_NAME_SET;
+  lua_pushstring(L, kpse_var_expand(st));
+  return 1;
+}
+
+static int var_value (lua_State *L) {
+  const char *st = luaL_checkstring(L,1);
+  TEST_PROGRAM_NAME_SET;
+  lua_pushstring(L, kpse_var_value(st));
+  return 1;
+}
+
+/* Engine support is a bit of a problem, because we do not want
+ * to interfere with the normal format discovery of |luatex|.
+ * Current approach: run |os.setenv()| if you have to.
+ */
+
+extern int luainit;
+
+static int set_program_name (lua_State *L) {
+  const char *exe_name  = luaL_checkstring(L,1);
+  const char *prog_name = luaL_optstring(L,2,exe_name);
+  if (! program_name_set) {
+    kpse_set_program_name(exe_name, prog_name);
+    program_name_set  = 1;
+  } else {
+    kpse_reset_program_name(prog_name);
+  }
+  /* fix up the texconfig entry */
+  lua_checkstack(L,3);
+  lua_getglobal(L,"texconfig");
+  if (lua_istable(L,-1)) {
+    lua_pushstring(L,"kpse_init");
+    lua_pushboolean(L,0);
+    lua_rawset(L,-3);
+  }
+  lua_pop(L,1);
+  return 0;
+}
+
+static int init_prog (lua_State *L) {
+  const char *prefix   = luaL_checkstring(L,1);
+  unsigned dpi         = luaL_checkinteger(L,2);
+  const char *mode     = luaL_checkstring(L,3);
+  const char *fallback = luaL_optstring(L,4,NULL);
+  TEST_PROGRAM_NAME_SET;
+  kpse_init_prog(prefix,dpi,mode,fallback);
+  return 0;
+}
+
+static int readable_file (lua_State *L) {
+  const char *name   = luaL_checkstring(L,1);
+  TEST_PROGRAM_NAME_SET;
+  lua_pushstring(L,(char *)kpse_readable_file (name));
+  return 1;
+}
+
+
+static const struct luaL_reg kpselib [] = {
+  {"set_program_name", set_program_name},
+  {"init_prog", init_prog},
+  {"readable_file", readable_file},
+  {"find_file", find_file},
+  {"expand_path", expand_path},
+  {"expand_var", expand_var},
+  {"expand_braces",expand_braces},
+  {"var_value",var_value},
+  {"show_path",show_path},
+  {NULL, NULL}  /* sentinel */
+};
+
+
+int
+luaopen_kpse (lua_State *L) 
+{
+  luaL_register(L,"kpse",kpselib);
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/llanglib.c b/Build/source/texk/web2c/luatexdir/lua/llanglib.c
new file mode 100644
index 00000000000..63e8c45dec8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/llanglib.c
@@ -0,0 +1,219 @@
+/*
+Copyright (c) 2007 Taco Hoekwater <taco@latex.org>
+
+This file is part of luatex.
+
+luatex 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.
+
+luatex 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 luatex; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+This is llanglib.c 
+*/
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "nodes.h"
+
+#define LANG_METATABLE "luatex.lang"
+
+#define check_islang(L,b) (struct tex_language **)luaL_checkudata(L,b,LANG_METATABLE)
+
+static int 
+lang_new (lua_State *L) {
+  struct tex_language **lang;
+  if (lua_gettop(L)==0) {
+    lang = lua_newuserdata(L, sizeof(struct tex_language *));
+    *lang = new_language();
+    if (!*lang) {
+      lua_pushstring(L,"lang.new(): no room for a new language");
+      return lua_error(L);
+    }
+  } else {
+    lang = lua_newuserdata(L, sizeof(struct tex_language *));
+    *lang = get_language(lua_tonumber(L,1));
+  }
+  luaL_getmetatable(L,LANG_METATABLE);
+  lua_setmetatable(L,-2);
+  return 1;
+}
+
+static int 
+lang_id (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  lua_pushnumber(L,(*lang_ptr)->id);
+  return 1;
+}
+
+static int 
+lang_patterns (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  if (lua_gettop(L)!=1) {
+	if (!lua_isstring(L,2)) {
+	  lua_pushstring(L,"lang.patterns(): argument should be a string");
+	  return lua_error(L);
+	}
+	load_patterns(*lang_ptr, (unsigned char *)lua_tostring(L,2));
+	return 0;
+  } else {
+	if ((*lang_ptr)->patterns!=NULL) {
+	  lua_pushstring(L,(char *)hnj_serialize((*lang_ptr)->patterns));
+	} else {
+	  lua_pushnil(L);
+	}
+	return 1;
+  }
+}
+
+static int 
+lang_clear_patterns (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  clear_patterns(*lang_ptr);
+  return 0;
+}
+
+
+static int 
+lang_hyphenation (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  if (lua_gettop(L)!=1) {
+	if(!lua_isstring(L,2)) {
+	  lua_pushstring(L,"lang.hyphenation(): argument should be a string");
+	  return lua_error(L);
+	}
+	load_hyphenation(*lang_ptr,(unsigned char *)lua_tostring(L,2));
+	return 0;
+  } else {
+	if ((*lang_ptr)->exceptions!=0) {
+	  lua_pushstring(L,exception_strings(*lang_ptr));
+	} else {
+	  lua_pushnil(L);
+	}
+	return 1;
+  }
+}
+
+static int 
+lang_pre_hyphen_char (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  if (lua_gettop(L)!=1) {
+	if(!lua_isnumber(L,2)) {
+	  lua_pushstring(L,"lang.prehyphenchar(): argument should be a character number");
+	  return lua_error(L);
+	}
+	(*lang_ptr)->pre_hyphen_char = lua_tonumber(L,2);
+	return 0;
+  } else {
+	lua_pushnumber(L,(*lang_ptr)->pre_hyphen_char);
+	return 1;
+  }
+}
+
+static int 
+lang_post_hyphen_char (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  if (lua_gettop(L)!=1) {
+	if(!lua_isnumber(L,2)) {
+	  lua_pushstring(L,"lang.posthyphenchar(): argument should be a character number");
+	  return lua_error(L);
+	}
+	(*lang_ptr)->post_hyphen_char = lua_tonumber(L,2);
+	return 0;
+  } else {
+	lua_pushnumber(L,(*lang_ptr)->post_hyphen_char);
+	return 1;
+  }
+}
+
+static int 
+lang_clear_hyphenation (lua_State *L) {
+  struct tex_language **lang_ptr;
+  lang_ptr = check_islang(L,1);
+  clear_hyphenation(*lang_ptr);
+  return 0;
+}
+
+
+static int 
+do_lang_clean (lua_State *L) {
+  char *cleaned;
+  if (!lua_isstring(L,1)) {
+    lua_pushstring(L,"lang.clean(): argument should be a string");
+    return lua_error(L);
+  }
+  (void)clean_hyphenation((char *)lua_tostring(L,1),&cleaned);
+  lua_pushstring(L,cleaned);
+  return 1;
+}
+
+static int 
+do_lang_hyphenate (lua_State *L) {
+  halfword *h,*t;
+  h = check_isnode(L,1);
+  if (lua_isuserdata(L,2)) {
+	t = check_isnode(L,2);
+	lua_pop(L,1);
+  } else {
+	t = h;
+	while (vlink(*t)!=null)
+	  *t = vlink(*t);
+  }
+  hnj_hyphenation(*h,*t);
+  lua_pushboolean(L,1);
+  return 1;
+}
+
+
+static const struct luaL_reg langlib_d [] = {
+  {"clear_patterns",    lang_clear_patterns},
+  {"clear_hyphenation", lang_clear_hyphenation},
+  {"patterns",          lang_patterns},
+  {"hyphenation",       lang_hyphenation},
+  {"prehyphenchar",     lang_pre_hyphen_char}, 
+  {"posthyphenchar",    lang_post_hyphen_char},
+  {"id",                lang_id},
+  {NULL, NULL}  /* sentinel */
+};
+
+
+static const struct luaL_reg langlib[] = {
+  {"clear_patterns",    lang_clear_patterns},
+  {"clear_hyphenation", lang_clear_hyphenation},
+  {"patterns",          lang_patterns},
+  {"hyphenation",       lang_hyphenation},
+  {"prehyphenchar",     lang_pre_hyphen_char}, 
+  {"posthyphenchar",    lang_post_hyphen_char},
+  {"id",                lang_id},
+  {"clean",             do_lang_clean},
+  {"hyphenate",         do_lang_hyphenate},
+  {"new",               lang_new},
+  {NULL, NULL}                /* sentinel */
+};
+
+
+int 
+luaopen_lang (lua_State *L) {
+  luaL_newmetatable(L,LANG_METATABLE);
+  lua_pushvalue(L, -1);  /* push metatable */
+  lua_setfield(L, -2, "__index");  /* metatable.__index = metatable */
+  luaL_register(L, NULL, langlib_d);  /* dict methods */
+  luaL_register(L, "lang", langlib);
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/llualib.c b/Build/source/texk/web2c/luatexdir/lua/llualib.c
new file mode 100644
index 00000000000..0d13500a9b7
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/llualib.c
@@ -0,0 +1,229 @@
+
+/* $Id: llualib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#define LOAD_BUF_SIZE 256
+#define UINT_MAX32 0xFFFFFFFF
+
+typedef struct {
+  unsigned char* buf;
+  int size;
+  int done;
+  int alloc;
+} bytecode;
+
+static bytecode *lua_bytecode_registers = NULL;
+
+int luabytecode_max = -1;
+unsigned int luabytecode_bytes = 0;
+
+void dump_luac_registers (void) {
+  int k,n;
+  bytecode b;
+  dump_int(luabytecode_max);
+  if (lua_bytecode_registers != NULL) {
+    n = 0;
+    for (k=0;k<=luabytecode_max;k++) {
+      if (lua_bytecode_registers[k].size != 0)
+	n++;
+    }
+    dump_int(n);
+    for (k=0;k<=luabytecode_max;k++) {
+      b = lua_bytecode_registers[k];
+      if (b.size != 0) {
+	dump_int(k);
+	dump_int(b.size);
+	do_zdump ((char *)b.buf,1,(b.size), DUMP_FILE);
+      }
+    }
+  }
+}
+
+void undump_luac_registers (void) {
+  int k,n;
+  unsigned int i;
+  bytecode b;
+  undump_int(luabytecode_max);
+  if (luabytecode_max>=0) {
+	i = (luabytecode_max+1);
+	if ((int)(UINT_MAX32/sizeof(bytecode)+1)<=i) {
+	  lua_fatal_error("Corrupt format file");
+	}
+    lua_bytecode_registers = xmalloc(i*sizeof(bytecode));
+	luabytecode_bytes  = i*sizeof(bytecode);
+    for (i=0;i<=luabytecode_max;i++) {
+      lua_bytecode_registers[i].done = 0;
+      lua_bytecode_registers[i].size = 0;
+      lua_bytecode_registers[i].buf = NULL;
+    }
+    undump_int(n);
+    for (i=0;i<n;i++) {
+      undump_int(k);
+      undump_int(b.size);
+      b.buf=xmalloc(b.size);
+	  luabytecode_bytes += b.size;
+      memset(b.buf, 0, b.size);
+      do_zundump ((char *)b.buf,1, b.size, DUMP_FILE);
+      lua_bytecode_registers[k].size = b.size;
+      lua_bytecode_registers[k].alloc = b.size;
+      lua_bytecode_registers[k].buf = b.buf;
+    }
+  }
+}
+
+static void
+bytecode_register_shadow_set (lua_State* L, int k){
+  /* the stack holds the value to be set */
+  lua_pushstring(L,"bytecode_shadow"); /* lua.bytecode_shadow */
+  lua_rawget(L,LUA_REGISTRYINDEX);
+  if (lua_istable(L, -1)) {
+    lua_pushvalue(L,-2);
+    lua_rawseti(L,-2,k);
+  }
+  lua_pop(L,1); /* pop table or nil */
+  lua_pop(L,1); /* pop value */
+}
+
+
+static int
+bytecode_register_shadow_get (lua_State* L, int k){
+  /* the stack holds the value to be set */
+  int ret = 0;
+  lua_pushstring(L,"bytecode_shadow");
+  lua_rawget(L,LUA_REGISTRYINDEX);
+  if (lua_istable(L, -1)) {
+    lua_rawgeti(L,-1,k);
+    if (!lua_isnil(L,-1))
+      ret = 1;
+    lua_insert(L,-3); /* store the value or nil, deeper down  */
+    lua_pop(L,1); /* pop the value or nil at top */
+  }
+  lua_pop(L,1); /* pop table or nil */
+  return ret;
+}
+
+
+int writer(lua_State* L, const void* b, size_t size, void* B) {
+  bytecode* buf = (bytecode*)B;
+  if (buf->size + size > buf->alloc) {
+    buf->buf   = xrealloc(buf->buf,buf->alloc+size+LOAD_BUF_SIZE);
+    buf->alloc = buf->alloc+size+LOAD_BUF_SIZE;
+  }
+  memcpy(buf->buf+buf->size, b, size);
+  buf->size += size;
+  luabytecode_bytes += size;
+  return 0;
+}
+
+const char* reader(lua_State* L, void* ud, size_t* size) {
+  bytecode* buf = (bytecode*)ud;
+  if (buf->done == buf->size) {
+    *size = 0;
+    buf->done = 0;
+    return NULL;
+  }
+  *size = buf->size;
+  buf->done = buf->size;
+  return (const char*)buf->buf;
+}
+
+int get_bytecode (lua_State *L) {
+  int k;
+  k = (int)luaL_checkinteger(L,-1);
+  if (k<0) {
+    lua_pushnil(L);
+  } else if (!bytecode_register_shadow_get(L,k)) {
+    if (k<=luabytecode_max && lua_bytecode_registers[k].buf != NULL) {
+      if(lua_load(L,reader,(void *)(lua_bytecode_registers+k),"bytecode")) {
+	lua_error(L);
+	lua_pushnil(L);
+      } else {
+	lua_pushvalue(L,-1);
+	bytecode_register_shadow_set(L,k);
+      }
+    } else {
+      lua_pushnil(L);
+    }
+  }
+  return 1;
+}
+
+int set_bytecode (lua_State *L) {
+  int k, ltype;
+  unsigned int i;
+  k = (int)luaL_checkinteger(L,-2);
+  i = k+1;
+  if ((int)(UINT_MAX32/sizeof(bytecode)+1)<i) {
+    lua_pushstring(L, "value too large");
+    lua_error(L);
+  }
+  if (k<0) {
+    lua_pushstring(L, "negative values not allowed");
+    lua_error(L);
+  }
+  ltype = lua_type(L,-1);
+  if (ltype != LUA_TFUNCTION && ltype != LUA_TNIL){
+    lua_pushstring(L, "unsupported type");
+    lua_error(L);
+  }
+  if (k>luabytecode_max) {
+	i = sizeof(bytecode)*(k+1);
+    lua_bytecode_registers = xrealloc(lua_bytecode_registers,i);
+	if (luabytecode_max==-1) {
+	  luabytecode_bytes += sizeof(bytecode)*(k+1);
+	} else {
+	  luabytecode_bytes += sizeof(bytecode)*(k+1-luabytecode_max);
+	}
+    for (i=(luabytecode_max+1);i<=k;i++) {
+      lua_bytecode_registers[i].buf=NULL;
+      lua_bytecode_registers[i].size=0;
+      lua_bytecode_registers[i].done=0;
+    }
+    luabytecode_max = k;
+  }
+  if (lua_bytecode_registers[k].buf != NULL) {
+    xfree(lua_bytecode_registers[k].buf);
+	luabytecode_bytes -= lua_bytecode_registers[k].size;
+    lua_bytecode_registers[k].buf = NULL;
+    lua_bytecode_registers[k].size=0;
+    lua_bytecode_registers[k].done=0;
+    lua_pushnil(L);
+    bytecode_register_shadow_set(L,k);
+  }
+  if (ltype == LUA_TFUNCTION) {
+    lua_bytecode_registers[k].buf=xmalloc(LOAD_BUF_SIZE);
+    lua_bytecode_registers[k].alloc = LOAD_BUF_SIZE;
+    memset(lua_bytecode_registers[k].buf, 0, LOAD_BUF_SIZE);
+    lua_dump(L,writer,(void *)(lua_bytecode_registers+k));
+  }
+  lua_pop(L,1);
+  return 0;
+}
+
+static const struct luaL_reg lualib [] = {
+  {"getbytecode", get_bytecode},
+  {"setbytecode", set_bytecode},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_lua (lua_State *L, int n, char *fname) 
+{
+  luaL_register(L, "lua", lualib);
+  make_table(L,"bytecode","getbytecode","setbytecode");
+  lua_newtable(L);
+  lua_setfield(L, LUA_REGISTRYINDEX, "bytecode_shadow");
+  lua_pushinteger(L, n);
+  lua_setfield(L, -2, "id");
+  lua_pushstring(L, "0.1");
+  lua_setfield(L, -2, "version");
+  if (fname == NULL) {
+	lua_pushnil(L);
+  } else {
+	lua_pushstring(L, fname);
+  }
+  lua_setfield(L, -2, "startupfile");
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/lmplib.c b/Build/source/texk/web2c/luatexdir/lua/lmplib.c
new file mode 100644
index 00000000000..a194f9a55d8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lmplib.c
@@ -0,0 +1,1251 @@
+/* $Id$ */
+
+#include <stdlib.h>
+#include <string.h>
+#include <unistd.h>
+
+#ifndef pdfTeX
+#include <lua.h>
+#include <lauxlib.h>
+#include <lualib.h>
+#else
+#include <../lua51/lua.h>
+#include <../lua51/lauxlib.h>
+#include <../lua51/lualib.h>
+#endif
+
+#include "mplib.h"
+#include "mpmp.h"
+#include "mppsout.h" /* for mp_edge_object */
+
+#define MPLIB_METATABLE     "MPlib"
+#define MPLIB_FIG_METATABLE "MPlib.fig"
+#define MPLIB_GR_METATABLE  "MPlib.gr"
+
+#define mplib_init_S(a) do {											\
+    lua_pushliteral(L,#a);                                              \
+	mplib_##a##_ptr = (char *)lua_tostring(L,-1);						\
+    mplib_##a##_index = luaL_ref (L,LUA_REGISTRYINDEX);					\
+  } while (0)
+
+#define mplib_push_S(a) do {									\
+    lua_rawgeti(L,LUA_REGISTRYINDEX,mplib_##a##_index);			\
+  } while (0)
+
+#define mplib_is_S(a,i) (mplib_##a##_ptr==(char *)lua_tostring(L,i))
+
+#define mplib_make_S(a)													\
+  static int mplib_##a##_index = 0;										\
+  static char *mplib_##a##_ptr = NULL
+
+static int mplib_type_Ses[mp_special_code+1] = {0}; /* [0] is not used */
+
+mplib_make_S(fill);
+mplib_make_S(outline);
+mplib_make_S(text);
+mplib_make_S(special);
+mplib_make_S(start_bounds);
+mplib_make_S(stop_bounds);
+mplib_make_S(start_clip);
+mplib_make_S(stop_clip);
+
+mplib_make_S(left_type);
+mplib_make_S(right_type);
+mplib_make_S(x_coord);
+mplib_make_S(y_coord);
+mplib_make_S(left_x);
+mplib_make_S(left_y);
+mplib_make_S(right_x);
+mplib_make_S(right_y);
+
+mplib_make_S(color);
+mplib_make_S(dash);
+mplib_make_S(depth);
+mplib_make_S(dsize);
+mplib_make_S(font);
+mplib_make_S(height);
+mplib_make_S(htap);
+mplib_make_S(linecap);
+mplib_make_S(linejoin);
+mplib_make_S(miterlimit);
+mplib_make_S(path);
+mplib_make_S(pen);
+mplib_make_S(postscript);
+mplib_make_S(prescript);
+mplib_make_S(transform);
+mplib_make_S(type);
+mplib_make_S(width);
+
+void mplib_init_Ses(lua_State *L) {
+  mplib_init_S(fill);
+  mplib_init_S(outline);
+  mplib_init_S(text);
+  mplib_init_S(start_bounds);
+  mplib_init_S(stop_bounds);
+  mplib_init_S(start_clip);
+  mplib_init_S(stop_clip);
+  mplib_init_S(special);  
+
+  mplib_type_Ses[mp_fill_code]         = mplib_fill_index;
+  mplib_type_Ses[mp_stroked_code]      = mplib_outline_index;
+  mplib_type_Ses[mp_text_code]         = mplib_text_index;
+  mplib_type_Ses[mp_start_bounds_code] = mplib_start_bounds_index;
+  mplib_type_Ses[mp_stop_bounds_code]  = mplib_stop_bounds_index;
+  mplib_type_Ses[mp_start_clip_code]   = mplib_start_clip_index;
+  mplib_type_Ses[mp_stop_clip_code]    = mplib_stop_clip_index;
+  mplib_type_Ses[mp_special_code]      = mplib_special_index;
+
+  mplib_init_S(left_type);
+  mplib_init_S(right_type);
+  mplib_init_S(x_coord);
+  mplib_init_S(y_coord);
+  mplib_init_S(left_x);
+  mplib_init_S(left_y);
+  mplib_init_S(right_x);
+  mplib_init_S(right_y);
+
+  mplib_init_S(color);
+  mplib_init_S(dash);
+  mplib_init_S(depth);
+  mplib_init_S(dsize);
+  mplib_init_S(font);
+  mplib_init_S(height);
+  mplib_init_S(htap);
+  mplib_init_S(linecap);
+  mplib_init_S(linejoin);
+  mplib_init_S(miterlimit);
+  mplib_init_S(path);
+  mplib_init_S(pen);
+  mplib_init_S(postscript);
+  mplib_init_S(prescript);
+  mplib_init_S(transform);
+  mplib_init_S(type);
+  mplib_init_S(width);
+}
+
+
+
+
+#define xfree(A) if ((A)!=NULL) { free((A)); A = NULL; }
+
+#define is_mp(L,b) (MP *)luaL_checkudata(L,b,MPLIB_METATABLE)
+#define is_fig(L,b) (struct mp_edge_object **)luaL_checkudata(L,b,MPLIB_FIG_METATABLE)
+#define is_gr_object(L,b) (struct mp_graphic_object **)luaL_checkudata(L,b,MPLIB_GR_METATABLE)
+
+/* Enumeration string arrays */
+
+static const char *interaction_options[] = 
+  { "unknown","batch","nonstop","scroll","errorstop", NULL};
+
+static const char *mplib_filetype_names[] = 
+  {"term", "error", "mp", "log", "ps", "mem", "tfm", "map", "pfb", "enc", NULL};
+
+/* only "endpoint" and "explicit" actually happen in paths, 
+   as well as "open" in elliptical pens */
+
+static const char *knot_type_enum[]  = 
+  { "endpoint", "explicit", "given", "curl", "open", "end_cycle"  };
+
+/* object fields */
+
+static const char *fill_fields[] = 
+  { "type", "path", "htap", "pen", "color", "linejoin", "miterlimit", 
+    "prescript", "postscript", NULL };
+
+static const  char *stroked_fields[] = 
+  { "type", "path", "pen", "color", "linejoin", "miterlimit", "linecap", "dash", 
+    "prescript", "postscript", NULL };
+
+static const char *text_fields[] = 
+  { "type", "text", "dsize", "font", "color", "width", "height", "depth", "transform", 
+    "prescript", "postscript", NULL };
+
+static const char *special_fields[] = 
+  { "type", "prescript", NULL };
+
+static const char *start_bounds_fields[] = 
+  { "type", "path", NULL };
+
+static const char *start_clip_fields[] = 
+  { "type", "path", NULL };
+
+static const char *stop_bounds_fields[] = 
+  { "type", NULL };
+
+static const char *stop_clip_fields[] = 
+  { "type", NULL };
+
+static const char *no_fields[] =  
+  { NULL };
+
+typedef enum {  
+  P_ERROR_LINE,  P_HALF_LINE,   P_MAX_LINE,    P_MAIN_MEMORY, 
+  P_HASH_SIZE,   P_HASH_PRIME,  P_PARAM_SIZE,  P_IN_OPEN,     P_RANDOM_SEED, 
+  P_INTERACTION, P_INI_VERSION, P_TROFF_MODE,  P_PRINT_NAMES, P_MEM_NAME, 
+  P_JOB_NAME,    P_FIND_FILE,   P__SENTINEL
+} mplib_parm_idx;
+
+typedef struct {
+    const char *name;           /* parameter name */
+    mplib_parm_idx idx;         /* parameter index */
+} mplib_parm_struct;
+
+static mplib_parm_struct mplib_parms[] = {
+  {"error_line",        P_ERROR_LINE   },
+  {"half_error_line",   P_HALF_LINE    },
+  {"max_print_line",    P_MAX_LINE     },
+  {"main_memory",       P_MAIN_MEMORY  },
+  {"hash_size",         P_HASH_SIZE    },
+  {"hash_prime",        P_HASH_PRIME   },
+  {"param_size",        P_PARAM_SIZE   },
+  {"max_in_open",       P_IN_OPEN      },
+  {"random_seed",       P_RANDOM_SEED  },
+  {"interaction",       P_INTERACTION  },
+  {"ini_version",       P_INI_VERSION  },
+  {"troff_mode",        P_TROFF_MODE   },
+  {"print_found_names", P_PRINT_NAMES  },
+  {"mem_name",          P_MEM_NAME     },
+  {"job_name",          P_JOB_NAME     },
+  {"find_file",         P_FIND_FILE    },
+  {NULL,                P__SENTINEL    }
+};
+
+typedef struct _FILE_ITEM {
+  FILE *f;
+} _FILE_ITEM ;
+
+typedef struct _FILE_ITEM File;
+
+#define make_stream_buf(A) char *A; size_t A##_size; size_t A##_used
+
+#define free_stream_buf(A) xfree(mplib_data->A); mplib_data->A##_size = 0; mplib_data->A##_used = 0
+
+typedef struct _MPLIB_INSTANCE_DATA {
+  void *term_file_ptr;
+  void *err_file_ptr;
+  void *log_file_ptr;
+  void *ps_file_ptr;
+  make_stream_buf(term_out);
+  make_stream_buf(error_out);
+  make_stream_buf(log_out);
+  make_stream_buf(ps_out);
+  char *input_data;
+  char *input_data_ptr;
+  size_t input_data_len;
+  struct mp_edge_object *edges ;
+  lua_State *LL;
+} _MPLIB_INSTANCE_DATA;
+
+typedef struct _MPLIB_INSTANCE_DATA mplib_instance;
+
+static mplib_instance *mplib_get_data (MP mp) {
+  return (mplib_instance *)mp->userdata;
+}
+
+static mplib_instance *mplib_make_data (void) {
+  mplib_instance *mplib_data = malloc(sizeof(mplib_instance));
+  memset(mplib_data,0,sizeof(mplib_instance));
+  return mplib_data ;
+}
+
+
+/* Start by defining all the callback routines for the library 
+ * except |run_make_mpx| and |run_editor|.
+ */
+
+
+char *mplib_find_file (MP mp, const char *fname, const char *fmode, int ftype)  {
+  mplib_instance *mplib_data = mplib_get_data(mp);
+  lua_State *L = mplib_data->LL;
+  lua_checkstack(L,4);
+  lua_getfield(L,LUA_REGISTRYINDEX,"mplib_file_finder");
+  if (lua_isfunction(L,-1)) {
+    char *s = NULL, *x = NULL;
+    lua_pushstring(L, fname);
+    lua_pushstring(L, fmode);
+    if (ftype >= mp_filetype_text) {
+      lua_pushnumber(L, ftype-mp_filetype_text);
+    } else {
+      lua_pushstring(L, mplib_filetype_names[ftype]);
+    }
+    if(lua_pcall(L,3,1,0) != 0) {
+      fprintf(stdout,"Error in mp.find_file: %s\n", (char *)lua_tostring(L,-1));
+      return NULL;
+    }
+    x = (char *)lua_tostring(L,-1);
+    if (x!=NULL)
+      s = strdup(x);
+	lua_pop(L,1); /* pop the string */
+	return s;
+  } else {
+    lua_pop(L,1);
+  }
+  if (fmode[0] != 'r' || (! access (fname,R_OK)) || ftype) {  
+     return strdup(fname);
+  }
+  return NULL;
+}
+
+static int 
+mplib_find_file_function (lua_State *L) {
+  if (! (lua_isfunction(L,-1)|| lua_isnil(L,-1) )) {
+    return 1; /* error */
+  }
+  lua_pushstring(L, "mplib_file_finder");
+  lua_pushvalue(L,-2);
+  lua_rawset(L,LUA_REGISTRYINDEX);
+  return 0;
+}
+
+void *mplib_open_file(MP mp, const char *fname, const char *fmode, int ftype)  {
+  File *ff = malloc(sizeof (File));
+  if (ff) {
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    ff->f = NULL;
+    if (ftype==mp_filetype_terminal) {
+      if (fmode[0] == 'r') {
+		ff->f = stdin;
+      } else {
+		xfree(mplib_data->term_file_ptr); 
+		ff->f = malloc(1);
+		mplib_data->term_file_ptr = ff->f;
+      }
+    } else if (ftype==mp_filetype_error) {
+      xfree(mplib_data->err_file_ptr); 
+      ff->f = malloc(1);
+      mplib_data->err_file_ptr = ff->f;
+    } else if (ftype == mp_filetype_log) {
+      xfree(mplib_data->log_file_ptr); 
+      ff->f = malloc(1);
+      mplib_data->log_file_ptr = ff->f;
+    } else if (ftype == mp_filetype_postscript) {
+      xfree(mplib_data->ps_file_ptr); 
+      ff->f = malloc(1);
+      mplib_data->ps_file_ptr = ff->f;
+    } else { 
+      char realmode[3];
+      char *f = mplib_find_file(mp, fname,fmode,ftype);
+	  if (f==NULL)
+		return NULL;
+	  realmode[0] = *fmode;
+	  realmode[1] = 'b';
+	  realmode[2] = 0;
+      ff->f = fopen(f, realmode);
+      if ((fmode[0] == 'r') && (ff->f == NULL)) {
+		free(ff);
+		return NULL;  
+      }
+    }
+    return ff;
+  }
+  return NULL;
+}
+
+static int 
+mplib_get_char (void *f, mplib_instance *mplib_data) {
+  int c;
+  if (f==stdin && mplib_data->input_data != NULL) {
+	if (mplib_data->input_data_len==0) {
+	  if (mplib_data->input_data_ptr!=NULL)
+		mplib_data->input_data_ptr = NULL;
+	  else
+		mplib_data->input_data = NULL;
+	  c = EOF;
+	} else {
+	  mplib_data->input_data_len--;
+	  c = *(mplib_data->input_data_ptr)++;
+      }
+  } else {
+	c = fgetc(f);
+  }
+  return c;
+}
+
+static void
+mplib_unget_char (void *f, mplib_instance *mplib_data, int c) {
+  if (f==stdin && mplib_data->input_data_ptr != NULL) {
+	mplib_data->input_data_len++;	
+	mplib_data->input_data_ptr--;
+  } else {
+	ungetc(c,f);
+  }
+}
+
+
+char *mplib_read_ascii_file (MP mp, void *ff, size_t *size) {
+  char *s = NULL;
+  if (ff!=NULL) {
+	int c;
+	size_t len = 0, lim = 128;
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    FILE *f = ((File *)ff)->f;
+    if (f==NULL)
+      return NULL;
+    *size = 0;
+    c = mplib_get_char(f,mplib_data);
+    if (c==EOF)
+      return NULL;
+    s = malloc(lim); 
+    if (s==NULL) return NULL;
+    while (c!=EOF && c!='\n' && c!='\r') { 
+      if (len==lim) {
+	s =realloc(s, (lim+(lim>>2)));
+	if (s==NULL) return NULL;
+	lim+=(lim>>2);
+      }
+      s[len++] = c;
+      c = mplib_get_char(f,mplib_data);
+    }
+    if (c=='\r') {
+      c = mplib_get_char(f,mplib_data);
+      if (c!=EOF && c!='\n')
+	mplib_unget_char(f,mplib_data,c);
+    }
+    s[len] = 0;
+    *size = len;
+  }
+  return s;
+}
+
+#define APPEND_STRING(a,b) do {						\
+    if ((mplib_data->a##_used+strlen(b))>=mplib_data->a##_size) {	\
+      mplib_data->a##_size += 256+(mplib_data->a##_size)/5+strlen(b);	\
+      mplib_data->a = realloc(mplib_data->a,mplib_data->a##_size);	\
+    }									\
+    (void)strcpy(mplib_data->a+mplib_data->a##_used,b);			\
+    mplib_data->a##_used += strlen(b);					\
+  } while (0)
+
+void mplib_write_ascii_file (MP mp, void *ff, const char *s) {
+  if (ff!=NULL) {
+    void *f = ((File *)ff)->f;
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    if (f!=NULL) {
+      if (f==mplib_data->term_file_ptr) {
+	APPEND_STRING(term_out,s);
+      } else if (f==mplib_data->err_file_ptr) {
+	APPEND_STRING(error_out,s);
+      } else if (f==mplib_data->log_file_ptr) {
+	APPEND_STRING(log_out,s);
+      } else if (f==mplib_data->ps_file_ptr) {
+        APPEND_STRING(ps_out,s);
+      } else {
+	fprintf((FILE *)f,s);
+      }
+    }
+  }
+}
+
+void mplib_read_binary_file (MP mp, void *ff, void **data, size_t *size) {
+  (void)mp;
+  if (ff!=NULL) {
+    size_t len = 0;
+    FILE *f = ((File *)ff)->f;
+    if (f!=NULL) 
+      len = fread(*data,1,*size,f);
+    *size = len;
+  }
+}
+
+void mplib_write_binary_file (MP mp, void *ff, void *s, size_t size) {
+  (void)mp;
+  if (ff!=NULL) {
+    FILE *f = ((File *)ff)->f;
+    if (f!=NULL)
+      fwrite(s,size,1,f);
+  }
+}
+
+
+void mplib_close_file (MP mp, void *ff) {
+  if (ff!=NULL) {
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    void *f = ((File *)ff)->f;
+    if (f != NULL && f != mplib_data->term_file_ptr && f != mplib_data->err_file_ptr
+	&& f != mplib_data->log_file_ptr && f != mplib_data->ps_file_ptr) {
+      fclose(f);
+    }
+    free(ff);
+  }
+}
+
+int mplib_eof_file (MP mp, void *ff) {
+  if (ff!=NULL) {
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    FILE *f = ((File *)ff)->f;
+    if (f==NULL)
+      return 1;
+    if (f==stdin && mplib_data->input_data != NULL) {	
+      return (mplib_data->input_data_len==0);
+    }
+    return feof(f);
+  }
+  return 1;
+}
+
+void mplib_flush_file (MP mp, void *ff) {
+  (void)mp;
+  (void)ff;
+  return ;
+}
+
+#define APPEND_TO_EDGES(a) do {							\
+    if (mplib_data->edges==NULL) {						\
+      mplib_data->edges = hh;							\
+    } else {											\
+      struct mp_edge_object *p = mplib_data->edges;		\
+      while (p->_next!=NULL) { p = p->_next; }			\
+      p->_next = hh;									\
+    }													\
+} while (0)
+
+void mplib_shipout_backend (MP mp, int h) {
+  struct mp_edge_object *hh = mp_gr_export(mp, h);
+  if (hh) {
+    mplib_instance *mplib_data = mplib_get_data(mp);
+    APPEND_TO_EDGES(hh); 
+  }
+}
+
+
+static void 
+mplib_setup_file_ops(struct MP_options * options) {
+  options->find_file         = mplib_find_file;
+  options->open_file         = mplib_open_file;
+  options->close_file        = mplib_close_file;
+  options->eof_file          = mplib_eof_file;
+  options->flush_file        = mplib_flush_file;
+  options->write_ascii_file  = mplib_write_ascii_file;
+  options->read_ascii_file   = mplib_read_ascii_file;
+  options->write_binary_file = mplib_write_binary_file;
+  options->read_binary_file  = mplib_read_binary_file;
+  options->shipout_backend   = mplib_shipout_backend;
+}
+
+static int 
+mplib_new (lua_State *L) {
+  MP *mp_ptr;
+  mp_ptr = lua_newuserdata(L, sizeof(MP *));
+  if (mp_ptr) {
+	int i;
+	mplib_instance *mplib_data;
+	struct MP_options * options; /* instance options */
+    options = mp_options();
+    mplib_setup_file_ops(options);
+    mplib_data = mplib_make_data();
+    mplib_data->LL = L;
+    options->userdata = (void *)mplib_data;
+    options->noninteractive = 1; /* required ! */
+    options->print_found_names = 0;
+    if (lua_type(L,1)==LUA_TTABLE) {
+      for (i=0;mplib_parms[i].name!=NULL;i++) {
+	lua_getfield(L,1,mplib_parms[i].name);
+	if (lua_isnil(L,-1)) {
+          lua_pop(L,1);
+	  continue; /* skip unset */
+	}
+        switch(mplib_parms[i].idx) {
+	case P_ERROR_LINE: 
+	  options->error_line = lua_tointeger(L,-1);
+          break;
+	case P_HALF_LINE:   
+	  options->half_error_line = lua_tointeger(L,-1);
+          break;
+	case P_MAX_LINE:
+	  options->max_print_line = lua_tointeger(L,-1);
+          break;
+	case P_MAIN_MEMORY:
+	  options->main_memory = lua_tointeger(L,-1);
+          break;
+	case P_HASH_SIZE:
+	  options->hash_size = lua_tointeger(L,-1);
+          break;
+	case P_HASH_PRIME:
+	  options->hash_prime = lua_tointeger(L,-1);
+          break;
+	case P_PARAM_SIZE:
+	  options->param_size = lua_tointeger(L,-1);
+          break;
+	case P_IN_OPEN:
+	  options->max_in_open = lua_tointeger(L,-1);
+          break;
+	case P_RANDOM_SEED:
+	  options->random_seed = lua_tointeger(L,-1);
+          break;
+	case P_INTERACTION:
+          options->interaction = luaL_checkoption(L,-1,"errorstopmode", interaction_options);
+	  break;
+	case P_INI_VERSION:
+	  options->ini_version = lua_toboolean(L,-1);
+          break;
+	case P_TROFF_MODE:
+	  options->troff_mode = lua_toboolean(L,-1);
+          break;
+	case P_PRINT_NAMES:
+	  options->print_found_names = lua_toboolean(L,-1);
+          break;
+	  /*	  
+	case P_COMMAND_LINE:
+	  options->command_line = strdup((char *)lua_tostring(L,-1));
+          break;
+	  */
+	case P_MEM_NAME:
+	  options->mem_name = strdup((char *)lua_tostring(L,-1));
+          break;
+	case P_JOB_NAME:
+	  options->job_name = strdup((char *)lua_tostring(L,-1));
+          break;
+	case P_FIND_FILE:  
+	  if(mplib_find_file_function(L)) { /* error here */
+	    fprintf(stdout,"Invalid arguments to mp.new({find_file=...})\n");
+	  }
+	  break;
+        default:
+	  break;
+	}
+        lua_pop(L,1);
+      }
+    }
+    *mp_ptr = mp_new(options);
+    xfree(options->command_line);
+    xfree(options->mem_name);
+    xfree(options->job_name);
+    free(options);
+    if (*mp_ptr) {
+      luaL_getmetatable(L,MPLIB_METATABLE);
+      lua_setmetatable(L,-2);
+      return 1;
+    }
+  }
+  lua_pushnil(L);
+  return 1;
+}
+
+static int
+mplib_collect (lua_State *L) {
+  MP *mp_ptr = is_mp(L,1);
+  xfree(*mp_ptr);
+  return 0;
+}
+
+static int
+mplib_tostring (lua_State *L) {
+  MP *mp_ptr = is_mp(L,1);
+  if (*mp_ptr!=NULL) {
+    lua_pushfstring(L,"<MP %p>",*mp_ptr);
+     return 1;
+  }
+  return 0;
+}
+
+static int 
+mplib_wrapresults(lua_State *L, mplib_instance *mplib_data, int h) {
+   lua_checkstack(L,5);
+   lua_newtable(L);
+   if (mplib_data->term_out != NULL) {
+     lua_pushstring(L,mplib_data->term_out);
+     lua_setfield(L,-2,"term");
+     free_stream_buf(term_out);
+   }
+   if (mplib_data->error_out != NULL) {
+     lua_pushstring(L,mplib_data->error_out);
+     lua_setfield(L,-2,"error");
+     free_stream_buf(error_out);
+   } 
+   if (mplib_data->log_out != NULL ) {
+     lua_pushstring(L,mplib_data->log_out);
+     lua_setfield(L,-2,"log");
+     free_stream_buf(log_out);
+   }
+   if (mplib_data->edges != NULL ) {
+     struct mp_edge_object **v;
+     struct mp_edge_object *p = mplib_data->edges;
+     int i = 1;
+     lua_newtable(L);
+     while (p!=NULL) { 
+       v = lua_newuserdata (L, sizeof(struct mp_edge_object *));
+       *v = p;
+       luaL_getmetatable(L,MPLIB_FIG_METATABLE);
+       lua_setmetatable(L,-2);
+       lua_rawseti(L,-2,i); i++;
+       p = p->_next;
+     }
+     lua_setfield(L,-2,"fig");
+     mplib_data->edges = NULL;
+   }
+   lua_pushnumber(L,h);
+   lua_setfield(L,-2,"status");
+   return 1;
+}
+
+static int
+mplib_execute (lua_State *L) {
+  MP *mp_ptr = is_mp(L,1);
+  if (*mp_ptr!=NULL && lua_isstring(L,2)) {
+    int h;
+    mplib_instance *mplib_data = mplib_get_data(*mp_ptr);
+    mplib_data->input_data = (char *)lua_tolstring(L,2, &(mplib_data->input_data_len));
+    mplib_data->input_data_ptr = mplib_data->input_data;
+    if ((*mp_ptr)->run_state==0) {
+      h = mp_initialize(*mp_ptr);
+    }
+    h = mp_execute(*mp_ptr);
+    if (mplib_data->input_data_len!=0) {
+      mplib_data->input_data = NULL;
+	  mplib_data->input_data_ptr = NULL;
+      mplib_data->input_data_len=0;
+    }
+    return mplib_wrapresults(L, mplib_data, h);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int
+mplib_finish (lua_State *L) {
+  MP *mp_ptr = is_mp(L,1);
+  if (*mp_ptr!=NULL) {
+    mplib_instance *mplib_data = mplib_get_data(*mp_ptr);
+    int h = mp_finish(*mp_ptr);
+    return mplib_wrapresults(L, mplib_data, h);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int 
+mplib_statistics (lua_State *L) {
+  MP *mp_ptr = is_mp(L,1);
+  if (*mp_ptr!=NULL) {
+	lua_newtable(L);
+	lua_pushnumber(L, mp_memory_usage (*mp_ptr));
+	lua_setfield(L,-2,"main_memory");
+	lua_pushnumber(L, mp_hash_usage (*mp_ptr));
+	lua_setfield(L,-2,"hash_size");
+	lua_pushnumber(L, mp_param_usage (*mp_ptr));
+	lua_setfield(L,-2,"param_size");
+	lua_pushnumber(L, mp_open_usage (*mp_ptr));
+	lua_setfield(L,-2,"max_in_open");
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+/* figure methods */
+
+static int
+mplib_fig_collect (lua_State *L) {
+  struct mp_edge_object **hh = is_fig(L,1);
+  if (*hh!=NULL) {
+    mp_gr_toss_objects (*hh);
+    *hh=NULL;
+  }
+  return 0;
+}
+
+static int
+mplib_fig_body (lua_State *L) {
+  int i = 1;
+  struct mp_graphic_object **v;
+  struct mp_graphic_object *p;
+  struct mp_edge_object **hh = is_fig(L,1);
+  lua_newtable(L);
+  p = (*hh)->body;
+  while (p!=NULL) {
+    v = lua_newuserdata (L, sizeof(struct mp_graphic_object *));
+    *v = p;
+    luaL_getmetatable(L,MPLIB_GR_METATABLE);
+    lua_setmetatable(L,-2);
+    lua_rawseti(L,-2,i); i++;
+    p = p->_link_field;
+  }
+  (*hh)->body = NULL; /* prevent double free */
+  return 1;
+}
+
+static int
+mplib_fig_copy_body (lua_State *L) {
+  int i = 1;
+  struct mp_graphic_object **v;
+  struct mp_graphic_object *p;
+  struct mp_edge_object **hh = is_fig(L,1);
+  lua_newtable(L);
+  p = (*hh)->body;
+  while (p!=NULL) {
+    v = lua_newuserdata (L, sizeof(struct mp_graphic_object *));
+    *v = mp_gr_copy_object((*hh)->_parent,p);
+    luaL_getmetatable(L,MPLIB_GR_METATABLE);
+    lua_setmetatable(L,-2);
+    lua_rawseti(L,-2,i); i++;
+    p = p->_link_field;
+  }
+  return 1;
+}
+
+
+static int
+mplib_fig_tostring (lua_State *L) {
+  struct mp_edge_object **hh = is_fig(L,1);
+  lua_pushfstring(L,"<figure %p>",*hh);
+  return 1;
+}
+
+
+
+static int 
+mp_wrapped_shipout (struct mp_edge_object *hh, int prologues, int procset) {
+  MP mp = hh->_parent;
+  if (setjmp(mp->jump_buf)) {
+    return 0;
+  }
+  mp_gr_ship_out(hh,prologues,procset);
+  return 1;
+}
+
+static int
+mplib_fig_postscript (lua_State *L) {
+  struct mp_edge_object **hh = is_fig(L,1);
+  int prologues = luaL_optnumber(L,2,-1);
+  int procset = luaL_optnumber(L,3,-1);
+  mplib_instance *mplib_data = mplib_get_data((*hh)->_parent);
+  if (mplib_data->ps_out == NULL) {
+    if (mp_wrapped_shipout(*hh,prologues, procset)) {
+      if (mplib_data->ps_out!=NULL ) {
+	lua_pushstring(L, mplib_data->ps_out);
+	free_stream_buf(ps_out);
+      } else {
+	lua_pushnil(L);
+      }
+      return 1;
+    } else {
+      lua_pushnil(L);
+      lua_pushstring(L,mplib_data->log_out);
+      xfree(mplib_data->ps_out); 
+      return 2;
+    }
+  }
+  lua_pushnil(L);
+  return 1;
+}
+
+static int
+mplib_fig_filename (lua_State *L) {
+  struct mp_edge_object **hh = is_fig(L,1);
+  if (*hh!= NULL) { 
+	char *s = (*hh)->_filename;
+	lua_pushstring(L,s);
+  } else {
+	lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+static int
+mplib_fig_bb (lua_State *L) {
+  struct mp_edge_object **hh = is_fig(L,1);
+  lua_newtable(L);
+  lua_pushnumber(L, (double)(*hh)->_minx/65536.0);
+  lua_rawseti(L,-2,1);
+  lua_pushnumber(L, (double)(*hh)->_miny/65536.0);
+  lua_rawseti(L,-2,2);
+  lua_pushnumber(L, (double)(*hh)->_maxx/65536.0);
+  lua_rawseti(L,-2,3);
+  lua_pushnumber(L, (double)(*hh)->_maxy/65536.0);
+  lua_rawseti(L,-2,4);
+  return 1;
+}
+
+/* object methods */
+
+static int
+mplib_gr_collect (lua_State *L) {
+  struct mp_graphic_object **hh = is_gr_object(L,1);
+  if (*hh!=NULL) {
+    mp_gr_toss_object(*hh);
+    *hh=NULL;
+  }
+  return 0;
+}
+
+static int
+mplib_gr_tostring (lua_State *L) {
+  struct mp_graphic_object **hh = is_gr_object(L,1);
+  lua_pushfstring(L,"<object %p>",*hh);
+  return 1;
+}
+
+
+static int
+mplib_gr_fields (lua_State *L) {
+  const char **fields;
+  const char *f;
+  int i = 1;
+  struct mp_graphic_object **hh = is_gr_object(L,1);
+  if (*hh) {
+    switch ((*hh)->_type_field) {
+    case mp_fill_code:         fields = fill_fields;         break;
+    case mp_stroked_code:      fields = stroked_fields;      break;
+    case mp_text_code:         fields = text_fields;         break;
+    case mp_special_code:      fields = special_fields;      break;
+    case mp_start_clip_code:   fields = start_clip_fields;   break;
+    case mp_start_bounds_code: fields = start_bounds_fields; break;
+    case mp_stop_clip_code:    fields = stop_clip_fields;    break;
+    case mp_stop_bounds_code:  fields = stop_bounds_fields;  break;
+    default:                   fields = no_fields;
+    }
+    lua_newtable(L);
+    for (f = *fields; f != NULL; f++) {
+      lua_pushstring(L,f);
+      lua_rawseti(L,-2,i); i++;
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+#define mplib_push_number(L,x) lua_pushnumber(L,(lua_Number)(x)/65536.0)
+
+#define MPLIB_PATH 0
+#define MPLIB_PEN 1
+
+static void 
+mplib_push_path (lua_State *L, struct mp_knot *h, int is_pen) {
+  struct mp_knot *p; /* for scanning the path */
+  int i=1;
+  p=h;
+  if (p!=NULL) {
+    lua_newtable(L);
+    do {  
+      lua_createtable(L,0,6);
+      if (!is_pen) {
+        if (p->left_type_field != mp_explicit) {
+	  mplib_push_S(left_type);
+	  lua_pushstring(L,knot_type_enum[p->left_type_field]);
+	  lua_rawset(L,-3);
+	}
+	if (p->right_type_field != mp_explicit) {
+	  mplib_push_S(right_type);
+	  lua_pushstring(L,knot_type_enum[p->right_type_field]);
+	  lua_rawset(L,-3);
+	}
+      }
+      mplib_push_S(x_coord);
+      mplib_push_number(L,p->x_coord_field);
+      lua_rawset(L,-3);
+      mplib_push_S(y_coord);
+      mplib_push_number(L,p->y_coord_field);
+      lua_rawset(L,-3);
+      mplib_push_S(left_x);
+      mplib_push_number(L,p->left_x_field);
+      lua_rawset(L,-3);
+      mplib_push_S(left_y);
+      mplib_push_number(L,p->left_y_field);
+      lua_rawset(L,-3);
+      mplib_push_S(right_x);
+      mplib_push_number(L,p->right_x_field);
+      lua_rawset(L,-3);
+      mplib_push_S(right_y);
+      mplib_push_number(L,p->right_y_field);
+      lua_rawset(L,-3);
+      lua_rawseti(L,-2,i); i++;
+      if ( p->right_type_field==mp_endpoint ) { 
+	return;
+      }
+      p=p->next_field;
+    } while (p!=h) ;
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+#define set_color_objects(pq)				\
+  object_color_model = pq->color_model_field;		\
+  object_color_a = pq->color_field._a_val;		\
+  object_color_b = pq->color_field._b_val;		\
+  object_color_c = pq->color_field._c_val;		\
+  object_color_d = pq->color_field._d_val; 
+
+
+static void 
+mplib_push_color (lua_State *L, struct mp_graphic_object *p ) {
+  int object_color_model;
+  int object_color_a, object_color_b, object_color_c, object_color_d ; 
+  if (p!=NULL) {
+    if (p->_type_field == mp_fill_code) {
+      mp_fill_object *h = (mp_fill_object *)p;
+      set_color_objects(h);
+    } else if (p->_type_field == mp_stroked_code) {
+      mp_stroked_object *h = (mp_stroked_object *)p;
+      set_color_objects(h);
+    } else {
+      mp_text_object *h = (mp_text_object *)p;
+      set_color_objects(h);
+    }
+    lua_newtable(L);
+    if (object_color_model >= mp_grey_model) {
+      mplib_push_number(L,object_color_a);
+      lua_rawseti(L,-2,1);
+      if (object_color_model >= mp_rgb_model) {
+	mplib_push_number(L,object_color_b);
+	lua_rawseti(L,-2,2);
+	mplib_push_number(L,object_color_c);
+	lua_rawseti(L,-2,3);
+	if (object_color_model == mp_cmyk_model) {	
+	  mplib_push_number(L,object_color_d);
+	  lua_rawseti(L,-2,4);
+	}
+      }
+    }
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+/* the dash scale is not exported, the field has no external value */
+static void 
+mplib_push_dash (lua_State *L, struct mp_stroked_object *h ) {
+  mp_dash_object *d;
+  if (h!=NULL && h->dash_p_field != NULL) {
+    d  = h->dash_p_field;
+    lua_newtable(L);
+    mplib_push_number(L,d->offset_field);
+    lua_setfield(L,-2,"offset");
+    if (d->array_field!=NULL ) {
+      int i = 0;
+      lua_newtable(L);
+      while (*(d->array_field+i) != -1) {
+	mplib_push_number(L, *(d->array_field+1));
+	i++;
+	lua_rawseti(L,-2,i);
+      }
+      lua_setfield(L,-2,"dashes");
+    }
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_push_transform (lua_State *L, struct mp_text_object *h ) {
+  int i = 1;
+  if (h!=NULL) {
+    lua_createtable(L,6,0);
+    mplib_push_number(L,h->tx_field);
+    lua_rawseti(L,-2,i); i++;
+    mplib_push_number(L,h->ty_field);
+    lua_rawseti(L,-2,i); i++;
+    mplib_push_number(L,h->txx_field);
+    lua_rawseti(L,-2,i); i++;
+    mplib_push_number(L,h->tyx_field);
+    lua_rawseti(L,-2,i); i++;
+    mplib_push_number(L,h->txy_field);
+    lua_rawseti(L,-2,i); i++;
+    mplib_push_number(L,h->tyy_field);
+    lua_rawseti(L,-2,i); i++;
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+#define FIELD(A) (mplib_is_S(A,2))
+
+static void 
+mplib_fill_field (lua_State *L, struct mp_fill_object *h) {
+  if (FIELD(path)) {
+    mplib_push_path(L, h->path_p_field, MPLIB_PATH);
+  } else if (FIELD(htap)) {
+    mplib_push_path(L, h->htap_p_field, MPLIB_PATH);
+  } else if (FIELD(pen)) {
+    mplib_push_path(L, h->pen_p_field, MPLIB_PEN);
+  } else if (FIELD(color)) {
+    mplib_push_color(L,(mp_graphic_object *)h);
+  } else if (FIELD(linejoin)) {
+    lua_pushnumber(L,h->ljoin_field);
+  } else if (FIELD(miterlimit)) {
+    mplib_push_number(L,h->miterlim_field);
+  } else if (FIELD(prescript)) {
+    lua_pushstring(L,h->pre_script_field);
+  } else if (FIELD(postscript)) {
+    lua_pushstring(L,h->post_script_field);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_stroked_field (lua_State *L, struct mp_stroked_object *h) {
+  if (FIELD(path)) {
+    mplib_push_path(L, h->path_p_field, MPLIB_PATH);
+  } else if (FIELD(pen)) {
+    mplib_push_path(L, h->pen_p_field, MPLIB_PEN);
+  } else if (FIELD(color)) {
+    mplib_push_color(L, (mp_graphic_object *)h);
+  } else if (FIELD(dash)) {
+    mplib_push_dash(L,h);
+  } else if (FIELD(linecap)) {
+    lua_pushnumber(L,h->lcap_field);
+  } else if (FIELD(linejoin)) {
+    lua_pushnumber(L,h->ljoin_field);
+  } else if (FIELD(miterlimit)) {
+    mplib_push_number(L,h->miterlim_field);
+  } else if (FIELD(prescript)) {
+    lua_pushstring(L,h->pre_script_field);
+  } else if (FIELD(postscript)) {
+    lua_pushstring(L,h->post_script_field);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_text_field (lua_State *L, struct mp_text_object *h) {
+  if (FIELD(text)) {
+    lua_pushstring(L,h->text_p_field);
+  } else if (FIELD(dsize)) {
+    mplib_push_number(L,(h->font_dsize_field/16));
+  } else if (FIELD(font)) {
+    lua_pushstring(L,h->font_name_field);
+  } else if (FIELD(color)) {
+    mplib_push_color(L,(mp_graphic_object *)h);
+  } else if (FIELD(width)) {
+    mplib_push_number(L,h->width_field);
+  } else if (FIELD(height)) {
+    mplib_push_number(L,h->height_field);
+  } else if (FIELD(depth)) {
+    mplib_push_number(L,h->depth_field);
+  } else if (FIELD(transform)) {
+    mplib_push_transform(L,h);
+  } else if (FIELD(prescript)) {
+    lua_pushstring(L,h->pre_script_field);
+  } else if (FIELD(postscript)) {
+    lua_pushstring(L,h->post_script_field);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_special_field (lua_State *L, struct mp_special_object *h) {
+  if (FIELD(prescript)) {
+    lua_pushstring(L,h->pre_script_field);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_start_bounds_field (lua_State *L, struct mp_bounds_object *h) {
+  if (FIELD(path)) {
+    mplib_push_path(L,h->path_p_field, MPLIB_PATH);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static void 
+mplib_start_clip_field (lua_State *L, struct mp_clip_object *h) {
+  if (FIELD(path)) {
+    mplib_push_path(L,h->path_p_field,  MPLIB_PATH);
+  } else {
+    lua_pushnil(L);
+  }
+}
+
+static int
+mplib_gr_index (lua_State *L) {
+  struct mp_graphic_object **hh = is_gr_object(L,1);
+  if (*hh) {
+    struct mp_graphic_object *h = *hh;
+    if (mplib_is_S(type,2)) {
+      lua_rawgeti(L,LUA_REGISTRYINDEX,mplib_type_Ses[h->_type_field]);
+    } else {
+      switch (h->_type_field) {
+      case mp_fill_code:         mplib_fill_field(L,(mp_fill_object *)h);           break;
+      case mp_stroked_code:      mplib_stroked_field(L,(mp_stroked_object *)h);     break;
+      case mp_text_code:         mplib_text_field(L,(mp_text_object *)h);           break;
+      case mp_special_code:      mplib_special_field(L,(mp_special_object *)h);     break;
+      case mp_start_clip_code:   mplib_start_clip_field(L,(mp_clip_object *)h);     break;
+      case mp_start_bounds_code: mplib_start_bounds_field(L,(mp_bounds_object *)h); break;
+	/* case mp_stop_clip_code:    */
+	/* case mp_stop_bounds_code:  */
+      default:                   lua_pushnil(L);
+      }    
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+static const struct luaL_reg mplib_meta[] = {
+  {"__gc",               mplib_collect}, 
+  {"__tostring",         mplib_tostring},
+  {NULL, NULL}                /* sentinel */
+};
+
+static const struct luaL_reg mplib_fig_meta[] = {
+  {"__gc",               mplib_fig_collect    },
+  {"__tostring",         mplib_fig_tostring   },
+  {"objects",            mplib_fig_body       },
+  {"copy_objects",       mplib_fig_copy_body  },
+  {"filename",           mplib_fig_filename   },
+  {"postscript",         mplib_fig_postscript },
+  {"boundingbox",        mplib_fig_bb         },
+  {NULL, NULL}                /* sentinel */
+};
+
+static const struct luaL_reg mplib_gr_meta[] = {
+  {"__gc",               mplib_gr_collect  },
+  {"__tostring",         mplib_gr_tostring },
+  {"__index",            mplib_gr_index    },
+  {"fields",             mplib_gr_fields   },
+  {NULL, NULL}                /* sentinel */
+};
+
+
+static const struct luaL_reg mplib_d [] = {
+  {"execute",            mplib_execute },
+  {"finish",             mplib_finish },
+  {"statistics",         mplib_statistics },
+  {NULL, NULL}  /* sentinel */
+};
+
+
+static const struct luaL_reg mplib_m[] = {
+  {"new",                 mplib_new},
+  {NULL, NULL}                /* sentinel */
+};
+
+
+int 
+luaopen_mp (lua_State *L) {
+  mplib_init_Ses(L);
+  luaL_newmetatable(L,MPLIB_GR_METATABLE);
+  lua_pushvalue(L, -1); /* push metatable */
+  lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */
+  luaL_register(L, NULL, mplib_gr_meta);  /* object meta methods */
+  lua_pop(L,1);
+
+  luaL_newmetatable(L,MPLIB_FIG_METATABLE);
+  lua_pushvalue(L, -1); /* push metatable */
+  lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */
+  luaL_register(L, NULL, mplib_fig_meta);  /* figure meta methods */
+  lua_pop(L,1);
+
+  luaL_newmetatable(L,MPLIB_METATABLE);
+  lua_pushvalue(L, -1); /* push metatable */
+  lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */
+  luaL_register(L, NULL, mplib_meta);  /* meta methods */
+  luaL_register(L, NULL, mplib_d);  /* dict methods */
+  luaL_register(L, "mplib", mplib_m); /* module functions */
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/lnodelib.c b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
new file mode 100644
index 00000000000..de269d5d9c8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lnodelib.c
@@ -0,0 +1,1967 @@
+/* $Id: lnodelib.c 1056 2008-02-19 15:42:17Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "nodes.h"
+
+#define init_luaS_index(a) do {                                         \
+    lua_pushliteral(L,#a);                                              \
+    luaS_##a##_ptr = (char *)lua_tostring(L,-1);                        \
+    luaS_##a##_index = luaL_ref (L,LUA_REGISTRYINDEX);                  \
+  } while (0)
+
+#define make_luaS_index(a)                                              \
+  static int luaS_##a##_index = 0;                                      \
+  static char * luaS_##a##_ptr = NULL
+
+#define luaS_index(a)	luaS_##a##_index
+
+#define luaS_ptr_eq(a,b) (a==luaS_##b##_ptr)
+
+#define NODE_METATABLE  "luatex_node"
+
+make_luaS_index(luatex_node);
+
+halfword *check_isnode (lua_State *L, int ud) {
+  register halfword *p = lua_touserdata(L, ud);
+  if (p != NULL) { 
+    if (lua_getmetatable(L, ud)) {
+	  lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(luatex_node));
+	  lua_gettable(L, LUA_REGISTRYINDEX); 
+      if (lua_rawequal(L, -1, -2)) { 
+        lua_pop(L, 2);
+        return p;
+      }
+    }
+  }
+  luaL_typerror(L, ud, NODE_METATABLE); 
+  return NULL; 
+}
+
+/* This routine finds the numerical value of a string (or number) at
+   lua stack index |n|. If it is not a valid node type, returns -1 */
+
+static 
+int do_get_node_type_id (lua_State *L, int n, node_info *data) {
+  register int j;
+  if (lua_type(L,n)==LUA_TSTRING) {
+    char *s = (char *)lua_tostring(L,n);
+	for (j=0;data[j].id!=-1;j++) {
+	  if (strcmp(s,data[j].name)==0)
+		return j;
+    }
+  } else if (lua_type(L,n)==LUA_TNUMBER) {
+    register int i = lua_tointeger(L,n);
+	if (data[i].id==i)
+	  return i;
+	for (j=0;data[j].id!=-1;j++) {
+	  if (data[j].id==i)
+		return j;
+    }
+  }
+  return -1;
+}
+
+#define get_node_type_id(L,n)    do_get_node_type_id(L,n,node_data)
+#define get_node_subtype_id(L,n) do_get_node_type_id(L,n,whatsit_node_data)
+
+static 
+int get_valid_node_type_id (lua_State *L, int n) {
+  int i = get_node_type_id(L,n);
+  if (i==-1) {
+    if (lua_type(L,n)==LUA_TSTRING) {
+      lua_pushfstring(L, "Invalid node type id: %s",(char *)lua_tostring(L,n));
+    } else {
+      lua_pushfstring(L, "Invalid node type id: %d",(int)lua_tonumber(L,n));
+    }
+    return lua_error(L);
+  }
+  return i;
+}
+
+static 
+int get_valid_node_subtype_id (lua_State *L, int n) {
+  int i = get_node_subtype_id(L,n);
+  if (i==-1) {
+    if (lua_type(L,n)==LUA_TSTRING) {
+      lua_pushfstring(L, "Invalid whatsit node id: %s",(char *)lua_tostring(L,n));
+    } else {
+      lua_pushfstring(L, "Invalid whatsit node id: %d",(int)lua_tonumber(L,n));
+    }
+    return lua_error(L);
+  }
+  return i;
+}
+
+
+
+/* Creates a userdata object for a number found at the stack top, 
+  if it is representing a node (i.e. an pointer into |varmem|). 
+  It replaces the stack entry with the new userdata, or pushes
+  |nil| if the number is |null|, or if the index is definately out of
+  range. This test could be improved.
+*/
+
+void
+lua_nodelib_push(lua_State *L) {
+  halfword n;
+  halfword *a;
+  n = -1;
+  if (lua_isnumber(L,-1)) {
+    n = lua_tointeger(L,-1);
+  }
+  lua_pop(L,1);
+  if ((n==null) || (n<0) || (n>var_mem_max)) {
+    lua_pushnil(L);
+  } else {
+    a = lua_newuserdata(L, sizeof(halfword));
+    *a = n;
+	lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(luatex_node));
+	lua_gettable(L, LUA_REGISTRYINDEX); 
+    lua_setmetatable(L,-2);
+  }
+  return;
+}
+
+void
+lua_nodelib_push_fast(lua_State *L, halfword n) {
+  halfword *a;
+  a = lua_newuserdata(L, sizeof(halfword));
+  *a = n;
+  lua_rawgeti(L,LUA_REGISTRYINDEX,luaS_index(luatex_node));
+  lua_gettable(L, LUA_REGISTRYINDEX); 
+  lua_setmetatable(L,-2);
+  return;
+}
+
+
+/* converts type strings to type ids */
+
+static int
+lua_nodelib_id (lua_State *L) {
+  integer i = get_node_type_id(L,1);
+  if (i>=0) {
+    lua_pushnumber(L,i);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+static int
+lua_nodelib_subtype (lua_State *L) {
+  integer i = get_node_subtype_id(L,1);
+  if (i>=0) {
+    lua_pushnumber(L,i);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+/* converts id numbers to type names */
+
+static int
+lua_nodelib_type (lua_State *L) {
+  integer i = get_node_type_id(L,1);
+  if (i>=0) {
+    lua_pushstring(L,node_data[i].name);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+/* allocate a new node */
+
+static int
+lua_nodelib_new(lua_State *L) {
+  int i,j;
+  halfword n  = null;
+  i = get_valid_node_type_id(L,1);
+
+  if (i==whatsit_node) {
+    j = -1;
+    if (lua_gettop(L)>1) {  j = get_valid_node_subtype_id(L,2);  }
+    if (j<0) {
+      lua_pushstring(L, "Creating a whatsit requires the subtype number as a second argument");
+      lua_error(L);
+    }
+  } else {
+    j = 0;
+    if (lua_gettop(L)>1) { j = lua_tointeger(L,2); }
+  }
+  n = new_node(i,j);
+  lua_nodelib_push_fast(L,n);
+  return 1;
+}
+
+
+/* Free a node.
+   This function returns the 'next' node, because that may be helpful */
+
+static int
+lua_nodelib_free(lua_State *L) {
+  halfword *n;
+  halfword p;
+  if (lua_gettop(L)<1) {
+    lua_pushnil(L);
+    return 1;
+  } else if(lua_isnil(L,1)) {
+    return 1; /* the nil itself */
+  }
+  n = check_isnode(L,1);
+  p = vlink(*n); 
+  flush_node(*n); 
+  lua_pushnumber(L,p);
+  lua_nodelib_push(L);
+  return 1;
+}
+
+/* Free a node list */
+
+static int
+lua_nodelib_flush_list(lua_State *L) {
+  halfword *n_ptr;
+  if ((lua_gettop(L)<1) || lua_isnil(L,1))
+    return 0;
+  n_ptr = check_isnode(L,1);
+  flush_node_list(*n_ptr); 
+  return 0;
+}
+
+/* find prev, and fix backlinks */
+
+#define set_t_to_prev(head,current)		\
+  t = head;					\
+  while (vlink(t)!=current && t != null) {	\
+    if (vlink(t)!=null)				\
+      alink(vlink(t)) = t;			\
+    t = vlink(t);				\
+  }
+
+/* remove a node from a list */
+
+
+static int
+lua_nodelib_remove (lua_State *L) {
+  halfword head, current, t;
+  if (lua_gettop(L)<2) {
+    lua_pushstring(L,"Not enough arguments for node.remove()");
+    lua_error(L);
+  }
+  head = *(check_isnode(L,1));
+  if (lua_isnil(L,2)) {
+    return 2; /* the arguments, as they are */
+  }
+  current = *(check_isnode(L,2));
+
+  if (head == current) {
+    if (alink(head)!=null && vlink(current)!=null) {
+      alink(vlink(current)) = alink(head);
+    }
+    head  = vlink(current);
+    current = head;
+  } else {  /* head != current */
+    t = alink(current);
+    if (t==null || vlink(t)!=current) {
+      set_t_to_prev(head,current);
+      if (t==null) { /* error! */
+	lua_pushstring(L,"Attempt to node.remove() a non-existing node");
+	lua_error(L);
+      }
+    }
+    /* t is now the previous node */
+    vlink(t) = vlink(current);
+    if (vlink(current)!=null) {
+      alink(vlink(current))  = t;
+    }
+    current  = vlink(current);
+  }
+  lua_pushnumber(L,head);
+  lua_nodelib_push(L);  
+  lua_pushnumber(L,current);
+  lua_nodelib_push(L);  
+  return 2;
+}
+
+/* Insert a node in a list */
+
+static int
+lua_nodelib_insert_before (lua_State *L) {
+  halfword head, current, n, t;
+  if (lua_gettop(L)<3) {
+    lua_pushstring(L,"Not enough arguments for node.insert_before()");
+    lua_error(L);
+  }
+  if (lua_isnil(L,3)) {
+    lua_pop(L,1);
+    return 2;
+  } else {
+    n = *(check_isnode(L,3));
+  }
+  if (lua_isnil(L,1)) { /* no head */
+    vlink(n) = null;
+    alink(n) = null;
+    lua_nodelib_push_fast(L,n);  
+    lua_pushvalue(L,-1);
+    return 2;  
+  } else {
+    head = *(check_isnode(L,1));
+  }
+  if (lua_isnil(L,2)) {
+    current = tail_of_list(head);
+  } else {
+    current = *(check_isnode(L,2));
+  }
+  t = alink(current);
+  if (t==null || vlink(t)!=current) {
+    set_t_to_prev(head,current);
+    if (t==null) { /* error! */
+      lua_pushstring(L,"Attempt to node.insert_before() a non-existing node");
+      lua_error(L);
+    }
+  }
+  couple_nodes(t,n);
+  couple_nodes(n,current);
+  if (head==current) {
+    lua_nodelib_push_fast(L,n);
+  } else {
+    lua_nodelib_push_fast(L,head);
+  }
+  lua_nodelib_push_fast(L,n); 
+  return 2; 
+}
+
+
+static int
+lua_nodelib_insert_after (lua_State *L) {
+  halfword head, current, n;
+  if (lua_gettop(L)<3) {
+    lua_pushstring(L,"Not enough arguments for node.insert_after()");
+    lua_error(L);
+  }
+  if (lua_isnil(L,3)) {
+    lua_pop(L,1);
+    return 2;
+  } else {
+    n = *(check_isnode(L,3));
+  }
+  if (lua_isnil(L,1)) { /* no head */
+    vlink(n) = null;
+    alink(n) = null;
+    lua_nodelib_push_fast(L,n);    
+    lua_pushvalue(L,-1);
+    return 2;  
+  } else {
+    head = *(check_isnode(L,1));
+  }
+  if (lua_isnil(L,2)) {
+    current = head;
+    while (vlink(current)!=null)  
+      current = vlink(current);
+  } else {
+    current = *(check_isnode(L,2));
+  }
+  try_couple_nodes(n,vlink(current));
+  couple_nodes(current, n);
+
+  lua_pop(L,2);
+  lua_nodelib_push_fast(L,n);    
+  return 2; 
+}
+
+
+/* Copy a node list */
+
+static int
+lua_nodelib_copy_list (lua_State *L) {
+  halfword *n;
+  halfword m;
+  if (lua_isnil(L,1))
+    return 1; /* the nil itself */
+  n = check_isnode(L,1);
+  m = copy_node_list(*n);
+  lua_nodelib_push_fast(L,m);
+  return 1;
+}
+
+/* (Deep) copy a node */
+
+static int
+lua_nodelib_copy(lua_State *L) {
+  halfword *n;
+  halfword m;
+  if (lua_isnil(L,1))
+    return 1; /* the nil itself */
+  n = check_isnode(L,1);
+  m = copy_node(*n);
+  lua_nodelib_push_fast(L,m);
+  return 1;
+}
+
+/* output (write) a node to tex's processor */
+
+static int
+lua_nodelib_append(lua_State *L) {
+  halfword *n;
+  halfword m;
+  int i, j;
+  j = lua_gettop(L);
+  for (i=1;i<=j;i++) {
+	n = check_isnode(L,i);
+	m = copy_node_list(*n);
+	new_tail_append(m);
+	while (vlink(m)!= null) {
+	  m = vlink(m);
+	  new_tail_append(m);
+	}
+  }
+  return 0;
+}
+
+static int
+lua_nodelib_last_node(lua_State *L) {
+  halfword m;
+  m = pop_tail();
+  lua_pushnumber(L,m);
+  lua_nodelib_push(L);
+  return 1;
+}
+
+
+
+/* build a hbox */
+
+static int
+lua_nodelib_hpack(lua_State *L) {
+  halfword n, p;
+  char *s;
+  integer w  = 0;
+  int m = 1;
+  n = *(check_isnode(L,1));
+  if (lua_gettop(L)>1) {
+    w = lua_tointeger(L,2);
+    if (lua_gettop(L)>2 && lua_type(L,3)==LUA_TSTRING) {
+      s = (char *)lua_tostring(L,3);
+      if (strcmp(s,"additional")==0) {
+	m = 1;
+      } else {
+	m = lua_tonumber(L,3);
+      }
+    }
+  }
+  p = hpack(n,w,m);
+  lua_nodelib_push_fast(L,p);
+  return 1;
+}
+
+/* This function is similar to |get_node_type_id|, for field
+   identifiers.  It has to do some more work, because not all
+   identifiers are valid for all types of nodes.
+*/
+
+/* this inlining is an optimisation trick. it would be even faster to
+   compare string pointers on the lua stack, but that would require a
+   lot of code reworking that I don't have time for right now.
+*/
+
+
+make_luaS_index(id);
+make_luaS_index(next);
+make_luaS_index(char);
+make_luaS_index(font);
+make_luaS_index(attr);
+make_luaS_index(prev);
+make_luaS_index(lang);
+make_luaS_index(subtype);
+make_luaS_index(left);
+make_luaS_index(right);
+make_luaS_index(uchyph);
+make_luaS_index(components);
+make_luaS_index(xoffset);
+make_luaS_index(yoffset);
+
+
+void initialize_luaS_indexes(lua_State *L) {
+  init_luaS_index(id);
+  init_luaS_index(next);
+  init_luaS_index(char);
+  init_luaS_index(font);
+  init_luaS_index(attr);
+  init_luaS_index(prev);
+  init_luaS_index(lang);
+  init_luaS_index(subtype);
+  init_luaS_index(left);
+  init_luaS_index(right);
+  init_luaS_index(uchyph);
+  init_luaS_index(components);
+  init_luaS_index(xoffset);
+  init_luaS_index(yoffset);
+}
+
+static int
+get_node_field_id (lua_State *L, int n, int node ) {
+  register int t = type(node);
+  register char *s = (char *)lua_tostring(L,n);
+  if      (luaS_ptr_eq(s,next))               { return 0;  } 
+  else if (luaS_ptr_eq(s,id))                 { return 1;  }
+  else if (luaS_ptr_eq(s,attr) && 
+		   nodetype_has_attributes(t))        { return 3 ; } 
+  else if (t==glyph_node) {                    
+	if      (luaS_ptr_eq(s,subtype))          { return  2; }
+	else if (luaS_ptr_eq(s,font))             { return  5; }
+	else if (luaS_ptr_eq(s,char))             { return  4; }
+	else if (luaS_ptr_eq(s,prev))             { return -1; }
+	else if (luaS_ptr_eq(s,lang))             { return  6; }
+	else if (luaS_ptr_eq(s,left))             { return  7; }
+	else if (luaS_ptr_eq(s,right))            { return  8; }
+	else if (luaS_ptr_eq(s,uchyph))           { return  9; }
+	else if (luaS_ptr_eq(s,components))       { return 10; }
+	else if (luaS_ptr_eq(s,xoffset))          { return 11; }
+	else if (luaS_ptr_eq(s,yoffset))          { return 12; }
+  }
+  else if (luaS_ptr_eq(s,prev))               { return -1; }
+  else if (luaS_ptr_eq(s,subtype))            { return 2;  }
+  else {
+	int j;
+	char **fields = node_data[t].fields;
+	if (t==whatsit_node)
+	  fields = whatsit_node_data[subtype(node)].fields;
+	for (j=0;fields[j]!=NULL;j++) {
+	  if (strcmp(s,fields[j])==0) {
+		return j+3;
+	  }
+	}
+  }
+  return -2;
+}
+
+
+static int
+get_valid_node_field_id (lua_State *L, int n, int node ) {
+  int i = get_node_field_id(L,n,node);
+  if (i==-2) {
+	char *s = (char *)lua_tostring(L,n); 
+	lua_pushfstring(L, "Invalid field id %s for node type %s (%d)" , s, node_data[type(node)].name,subtype(node));
+    lua_error(L);
+  }
+  return i;
+}
+
+static int
+lua_nodelib_has_field (lua_State *L) {
+  int i= -2;
+  if (!lua_isnil(L,1)) {
+    i = get_node_field_id(L,2,*(check_isnode(L,1)));
+  }
+  lua_pushboolean(L,(i!=-2));
+  return 1;
+}
+
+
+/* fetch the list of valid node types */
+
+static int
+do_lua_nodelib_types (lua_State *L, node_info *data) {
+  int i;
+  lua_newtable(L);
+  for (i=0;data[i].id!=-1;i++) {
+    lua_pushstring(L,data[i].name);
+    lua_rawseti(L,-2,data[i].id);
+  }
+  return 1;
+}
+
+static int 
+lua_nodelib_types (lua_State *L) {
+  return do_lua_nodelib_types (L, node_data);
+}
+
+static int 
+lua_nodelib_whatsits (lua_State *L) {
+  return do_lua_nodelib_types (L, whatsit_node_data);
+}
+
+
+/* fetch the list of valid fields */
+
+static int
+lua_nodelib_fields (lua_State *L) {
+  int i = -1;
+  char ** fields;
+  int t = get_valid_node_type_id(L,1);
+  if (t==whatsit_node ) {
+    t = get_valid_node_subtype_id(L,2);
+    fields = whatsit_node_data[t].fields;
+  } else {
+    fields = node_data[t].fields;
+  }
+  lua_checkstack(L,2);
+  lua_newtable(L);
+  lua_pushstring(L,"next");
+  lua_rawseti(L,-2,0);
+  lua_pushstring(L,"id");
+  lua_rawseti(L,-2,1);
+  lua_pushstring(L,"subtype");
+  lua_rawseti(L,-2,2);
+  if (fields!=NULL) {
+    lua_pushstring(L,"prev");
+    lua_rawseti(L,-2,-1);
+    for (i=0;fields[i]!=NULL;i++) {
+      lua_pushstring(L,fields[i]);
+      lua_rawseti(L,-2,(i+3));
+    }
+  }
+  return 1;
+}
+
+/* find the end of a list */
+
+static int
+lua_nodelib_tail (lua_State *L) {
+  halfword *n;
+  halfword t;
+  if (lua_isnil(L,1))
+    return 1; /* the nil itself */
+  n = check_isnode(L,1);
+  t=*n;
+  if (t==null)
+    return 1; /* the old userdata */
+  alink(t) = null;
+  while (vlink(t)!=null) {
+    alink(vlink(t)) = t;
+    t = vlink(t);
+  }
+  lua_nodelib_push_fast(L,t);
+  return 1;
+}
+
+/* a few utility functions for attribute stuff */
+
+static int
+lua_nodelib_has_attribute (lua_State *L) {
+  halfword *n;
+  int i, val ;
+  if (lua_isnil(L,1))
+    return 1; /* the nil itself */
+  n = check_isnode(L,1);
+  i = lua_tointeger(L,2);
+  val = luaL_optinteger(L,3,-1);
+  if((val = has_attribute(*n,i,val))>=0) {
+    lua_pushnumber(L,val);
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int
+lua_nodelib_set_attribute (lua_State *L) {
+  halfword *n;
+  int i, val;
+  if (lua_gettop(L)==3) {
+    i = lua_tointeger(L,2);
+    val = lua_tointeger(L,3);
+    n = check_isnode(L,1);
+    if (val<0) {
+      (void)unset_attribute(*n,i,val);
+    } else {
+      set_attribute(*n,i,val);
+    }
+  } else {
+    lua_pushstring(L,"incorrect number of arguments");
+    lua_error(L);
+  }
+  return 0;
+}
+
+
+static int
+lua_nodelib_unset_attribute (lua_State *L) {
+  halfword *n;
+  int i, val, ret;
+  if (lua_gettop(L)<=3) {
+    i = luaL_checknumber(L,2);
+    val = luaL_optnumber(L,3,-1); 
+    n = check_isnode(L,1);
+    ret = unset_attribute(*n,i,val);
+    if(ret>=0) {
+      lua_pushnumber(L,ret);
+    } else {
+      lua_pushnil(L);
+    }
+    return 1;
+  } else {
+    lua_pushstring(L,"incorrect number of arguments");
+    return lua_error(L);
+  }
+}
+
+
+/* iteration */
+
+static int nodelib_aux_nil (lua_State *L) {
+  lua_pushnil(L);
+  return 1;
+}
+
+static int 
+nodelib_aux_next_filtered (lua_State *L) {
+  register halfword t; /* traverser */
+  register int i = lua_tointeger(L,lua_upvalueindex(1));
+  if (lua_isnil(L,2)) { /* first call */
+    t = *check_isnode(L,1);
+  } else {
+    t = *check_isnode(L,2);
+    t = vlink(t);
+  }
+  while (t!=null && type(t)!=i) { t = vlink(t); }
+  if (t==null) {
+    lua_pushnil(L);
+  } else {
+    lua_nodelib_push_fast(L,t);   
+  }
+  return 1;
+}
+
+
+static int 
+lua_nodelib_traverse_filtered (lua_State *L) {
+  halfword n;
+  if (lua_isnil(L,2)) {
+    lua_pushcclosure(L, nodelib_aux_nil, 0);
+    return 1;
+  }
+  n = *(check_isnode(L,2));
+  lua_pop(L,1); /* the node, integer remains */
+  lua_pushcclosure(L, nodelib_aux_next_filtered, 1);
+  lua_nodelib_push_fast(L,n);
+  lua_pushnil(L);
+  return 3;
+}
+
+static int 
+nodelib_aux_next (lua_State *L) {
+  register halfword t; /* traverser */
+  if (lua_isnil(L,2)) { /* first call */
+    t = *check_isnode(L,1);
+  } else {
+    t = *check_isnode(L,2);
+    t = vlink(t);
+  }
+  if (t==null) {
+    lua_pushnil(L);
+  } else {
+    lua_nodelib_push_fast(L,t);   
+  }
+  return 1;
+}
+
+static int 
+lua_nodelib_traverse (lua_State *L) {
+  halfword n;
+  if (lua_isnil(L,1)) {
+    lua_pushcclosure(L, nodelib_aux_nil, 0);
+    return 1;
+  }
+  n = *(check_isnode(L,1));
+  lua_pushcclosure(L, nodelib_aux_next, 0);
+  lua_nodelib_push_fast(L,n);
+  lua_pushnil(L);
+  return 3;
+;
+}
+
+
+
+static int
+do_lua_nodelib_count (lua_State *L, halfword match, int i, halfword first) {
+  int count  = 0;
+  int t = first;
+  while (t!=match) {
+    if (i<0 || type(t)==i) { count++;  }
+    t = vlink(t);
+  }
+  lua_pushnumber(L,count);
+  return 1;
+}
+
+static int lua_nodelib_length (lua_State *L) {
+  halfword n;
+  halfword m = null;
+  if (lua_isnil(L,1)) {
+    lua_pushnumber(L,0);
+    return 1;
+  }
+  n = *(check_isnode(L,1));
+  if (lua_gettop(L)==2) {
+    m = *(check_isnode(L,2));
+  } 
+  return do_lua_nodelib_count(L,m,-1,n);
+}
+
+
+static int lua_nodelib_count (lua_State *L) {
+  halfword n;
+  halfword m = null;
+  int i = -1;
+  i = lua_tointeger(L,1);
+  if (lua_isnil(L,2)) {
+    lua_pushnumber(L,0);
+    return 1;
+  }
+  n = *(check_isnode(L,2));
+  if (lua_gettop(L)==3)
+    m = *(check_isnode(L,3));
+  return do_lua_nodelib_count(L,m,i,n);
+}
+
+/* fetching a field from a node */
+
+#define nodelib_pushlist(L,n) { lua_pushnumber(L,n); lua_nodelib_push(L); }
+#define nodelib_pushattr(L,n) { lua_pushnumber(L,n); lua_nodelib_push(L); }
+#define nodelib_pushspec(L,n) { lua_pushnumber(L,n); lua_nodelib_push(L); }
+#define nodelib_pushaction(L,n) { lua_pushnumber(L,n); lua_nodelib_push(L); }
+#define nodelib_pushstring(L,n) { lua_pushstring(L,makecstring(n)); }
+
+static void
+lua_nodelib_getfield_whatsit  (lua_State *L, int n, int field) {
+  if (field==2) {
+    lua_pushnumber(L,subtype(n));
+  } else {
+  switch (subtype(n)) {
+  case open_node:               
+    switch (field) {
+    case  4: lua_pushnumber(L,write_stream(n));              break;
+    case  5: nodelib_pushstring(L,open_name(n));             break;
+    case  6: nodelib_pushstring(L,open_area(n));             break;
+    case  7: nodelib_pushstring(L,open_ext(n));              break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case write_node:              
+    switch (field) {
+    case  4: lua_pushnumber(L,write_stream(n));              break;
+    case  5: tokenlist_to_lua(L,write_tokens(n));            break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case close_node:              
+    switch (field) {
+    case  4: lua_pushnumber(L,write_stream(n));              break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case special_node:            
+    switch (field) {
+    case  4: tokenlist_to_luastring(L,write_tokens(n));      break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case local_par_node:          
+    switch (field) {
+    case  4: lua_pushnumber(L,local_pen_inter(n));           break;
+    case  5: lua_pushnumber(L,local_pen_broken(n));          break;
+    case  6: lua_pushnumber(L,local_par_dir(n));             break;
+    case  7: nodelib_pushlist(L,local_box_left(n));          break;
+    case  8: lua_pushnumber(L,local_box_left_width(n));      break;
+    case  9: nodelib_pushlist(L,local_box_right(n));         break;
+    case 10: lua_pushnumber(L,local_box_right_width(n));     break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case dir_node:                
+    switch (field) {
+    case  4: lua_pushnumber(L,dir_dir(n));                   break;
+    case  5: lua_pushnumber(L,dir_level(n));                 break;
+    case  6: lua_pushnumber(L,dir_dvi_ptr(n));               break;
+    case  7: lua_pushnumber(L,dir_dvi_h(n));                 break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_literal_node:
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_literal_mode(n));          break;
+    case  5: tokenlist_to_luastring(L,pdf_literal_data(n));  break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_refobj_node:         
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_obj_objnum(n));            break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_refxform_node:       
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_xform_objnum(n));          break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_refximage_node:      
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_ximage_objnum(n));         break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_annot_node:          
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_annot_objnum(n));          break;
+    case  8: tokenlist_to_luastring(L,pdf_annot_data(n));    break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_start_link_node:     
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_link_objnum(n));           break;
+    case  8: tokenlist_to_luastring(L,pdf_link_attr(n));     break;
+    case  9: nodelib_pushaction(L,pdf_link_action(n));       break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_dest_node:           
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_dest_named_id(n));         break;
+    case  8: if (pdf_dest_named_id(n) == 1)
+	tokenlist_to_luastring(L,pdf_dest_id(n));
+      else 
+	lua_pushnumber(L,pdf_dest_id(n));                    break;
+    case  9: lua_pushnumber(L,pdf_dest_type(n));             break;
+    case 10: lua_pushnumber(L,pdf_dest_xyz_zoom(n));         break;
+    case 11: lua_pushnumber(L,pdf_dest_objnum(n));           break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_thread_node:         
+  case pdf_start_thread_node:   
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_width(n));                 break;
+    case  5: lua_pushnumber(L,pdf_height(n));                break;
+    case  6: lua_pushnumber(L,pdf_depth(n));                 break;
+    case  7: lua_pushnumber(L,pdf_thread_named_id(n));       break;
+    case  8: if (pdf_thread_named_id(n) == 1)
+	tokenlist_to_luastring(L,pdf_thread_id(n));
+      else 
+	lua_pushnumber(L,pdf_thread_id(n));                  break;
+    case  9: tokenlist_to_luastring(L,pdf_thread_attr(n));   break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case late_lua_node:           
+    switch (field) {
+    case  4: lua_pushnumber(L,late_lua_reg(n));              break;
+    case  5: tokenlist_to_luastring(L,late_lua_data(n));     break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case close_lua_node:          
+    switch (field) {
+    case  4: lua_pushnumber(L,late_lua_reg(n));              break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_colorstack_node:     
+    switch (field) {
+    case  4: lua_pushnumber(L,pdf_colorstack_stack(n));      break;
+    case  5: lua_pushnumber(L,pdf_colorstack_cmd(n));        break;
+    case  6: tokenlist_to_luastring(L,pdf_colorstack_data(n)); break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case pdf_setmatrix_node:      
+    switch (field) {
+    case  4: tokenlist_to_luastring(L,pdf_setmatrix_data(n)); break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  case user_defined_node:       
+    switch (field) {
+    case  4: lua_pushnumber(L,user_node_id(n));	             break;
+    case  5: lua_pushnumber(L,user_node_type(n));            break;
+    case  6: 
+      switch (user_node_type(n)) {
+      case 'a': nodelib_pushlist(L,user_node_value(n));   break;
+      case 'd': lua_pushnumber(L,user_node_value(n));     break;
+      case 'n': nodelib_pushlist(L,user_node_value(n));   break;
+      case 's': nodelib_pushstring(L,user_node_value(n)); break;
+      case 't': tokenlist_to_lua(L,user_node_value(n));   break;
+      default: lua_pushnumber(L,user_node_value(n));      break;
+      }                                                      break;
+    default: lua_pushnil(L); 
+    }
+    break;
+  default:
+    lua_pushnil(L); 
+    break;
+  }
+  }
+}
+
+
+static int
+lua_nodelib_getfield  (lua_State *L) {
+  halfword *n_ptr, n;
+  int field;
+  if (lua_isnil(L,1))
+    return 1; /* a nil */
+  n_ptr = check_isnode(L,1);
+  n = *n_ptr;
+  field = get_valid_node_field_id(L,2, n);
+
+  if (field<-1)
+    return 0;
+  if (field==0) {
+    lua_pushnumber(L,vlink(n));
+    lua_nodelib_push(L);
+  } else if (field==1) {
+    lua_pushnumber(L,type(n));
+  } else if (field==-1) {
+    lua_pushnumber(L,alink(n));
+    lua_nodelib_push(L);
+  } else if (field==3 && nodetype_has_attributes(type(n))) {
+    nodelib_pushattr(L,node_attr(n));
+  } else {
+    switch (type(n)) {
+    case hlist_node:
+    case vlist_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,width(n));	      break;
+      case  5: lua_pushnumber(L,depth(n));	      break;
+      case  6: lua_pushnumber(L,height(n));	      break;
+      case  7: lua_pushnumber(L,box_dir(n));          break;
+      case  8: lua_pushnumber(L,shift_amount(n));     break;
+      case  9: lua_pushnumber(L,glue_order(n));       break;
+      case 10: lua_pushnumber(L,glue_sign(n));        break;
+      case 11: lua_pushnumber(L,(double)glue_set(n)); break;
+      case 12: nodelib_pushlist(L,list_ptr(n));       break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case unset_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	              break;
+      case  4: lua_pushnumber(L,width(n));	      break;
+      case  5: lua_pushnumber(L,depth(n));	      break;
+      case  6: lua_pushnumber(L,height(n));	      break;
+      case  7: lua_pushnumber(L,box_dir(n));          break;
+      case  8: lua_pushnumber(L,glue_shrink(n));      break;
+      case  9: lua_pushnumber(L,glue_order(n));       break;
+      case 10: lua_pushnumber(L,glue_sign(n));        break;
+      case 11: lua_pushnumber(L,glue_stretch(n));     break;
+      case 12: lua_pushnumber(L,span_count(n));	      break;
+      case 13: nodelib_pushlist(L,list_ptr(n));       break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case rule_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	              break;
+      case  4: lua_pushnumber(L,width(n));	      break;
+      case  5: lua_pushnumber(L,depth(n));	      break;
+      case  6: lua_pushnumber(L,height(n));	      break;
+      case  7: lua_pushnumber(L,rule_dir(n));         break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case ins_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,float_cost(n));	      break;
+      case  5: lua_pushnumber(L,depth(n));	      break;
+      case  6: lua_pushnumber(L,height(n));	      break;
+      case  7: nodelib_pushspec(L,split_top_ptr(n));  break;
+      case  8: nodelib_pushlist(L,ins_ptr(n));        break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case mark_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,mark_class(n));	      break;
+      case  5: tokenlist_to_lua(L,mark_ptr(n));       break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case adjust_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: nodelib_pushlist(L,adjust_ptr(n));     break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case disc_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));             break;
+      case  4: nodelib_pushlist(L,vlink(pre_break(n)));  break;
+      case  5: nodelib_pushlist(L,vlink(post_break(n))); break;
+      case  6: nodelib_pushlist(L,vlink(no_break(n)));   break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case math_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,surround(n));	      break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case glue_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: nodelib_pushspec(L,glue_ptr(n));       break;
+      case  5: nodelib_pushlist(L,leader_ptr(n));     break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case glue_spec_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	              break;
+	  case  3: lua_pushnumber(L,width(n));           break;
+      case  4: lua_pushnumber(L,stretch(n));	      break;
+      case  5: lua_pushnumber(L,shrink(n));	      break;
+      case  6: lua_pushnumber(L,stretch_order(n));    break;
+      case  7: lua_pushnumber(L,shrink_order(n));     break;
+      case  8: lua_pushnumber(L,glue_ref_count(n));   break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case kern_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,width(n));	      break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case penalty_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	              break;
+      case  4: lua_pushnumber(L,penalty(n));	      break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case glyph_node: 
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  4: lua_pushnumber(L,character(n));	      break;
+      case  5: lua_pushnumber(L,font(n));	      break;
+      case  6: lua_pushnumber(L,char_lang(n));	      break;
+      case  7: lua_pushnumber(L,char_lhmin(n));	      break;
+      case  8: lua_pushnumber(L,char_rhmin(n));	      break;
+      case  9: lua_pushnumber(L,char_uchyph(n));      break;
+      case 10: nodelib_pushlist(L,lig_ptr(n));	      break;
+      case 11: lua_pushnumber(L,x_displace(n));	      break;
+      case 12: lua_pushnumber(L,y_displace(n));	      break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case inserting_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));          break;
+      case  3: nodelib_pushlist(L,last_ins_ptr(n));   break;
+      case  4: nodelib_pushlist(L,best_ins_ptr(n));   break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case split_up_node:
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));          break;
+      case  3: nodelib_pushlist(L,last_ins_ptr(n));   break;
+      case  4: nodelib_pushlist(L,best_ins_ptr(n));   break;
+      case  5: nodelib_pushlist(L,broken_ptr(n));     break;
+      case  6: nodelib_pushlist(L,broken_ins(n));     break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case margin_kern_node :
+      switch (field) {
+      case  2: lua_pushnumber(L,subtype(n));	      break;
+      case  3: lua_pushnumber(L,width(n));	          break;
+      case  4: nodelib_pushlist(L,margin_char(n));    break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case action_node:
+      switch (field) {
+      case  2: lua_pushnil(L); /* dummy subtype */            break;
+      case  3: lua_pushnumber(L,pdf_action_type(n));          break;
+      case  4: lua_pushnumber(L,pdf_action_named_id(n));      break;
+      case  5: if (pdf_action_named_id(n)==1) {
+	  tokenlist_to_luastring(L,pdf_action_id(n));
+	} else {
+	  lua_pushnumber(L,pdf_action_id(n));
+	}                                                     break;
+      case  6: tokenlist_to_luastring(L,pdf_action_file(n));  break;
+      case  7: lua_pushnumber(L,pdf_action_new_window(n));    break;
+      case  8: tokenlist_to_luastring(L,pdf_action_tokens(n));break;
+      case  9: lua_pushnumber(L,pdf_action_refcount(n));      break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case attribute_list_node :
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	               break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case attribute_node :
+      switch (field) {
+      case  2: lua_pushnumber(L,0);	              break;
+      case  3: lua_pushnumber(L,attribute_id(n));     break;
+      case  4: lua_pushnumber(L,attribute_value(n));  break;
+      default: lua_pushnil(L);
+      }
+      break;
+    case whatsit_node:
+      lua_nodelib_getfield_whatsit(L,n,field);
+      break;
+    default: 
+      lua_pushnil(L); 
+      break;
+    }
+  }
+  return 1;
+}
+
+
+static int nodelib_getlist(lua_State *L, int n) {
+  halfword *m;
+  if (lua_isuserdata(L,n)) {
+    m = check_isnode(L,n);
+    return *m;
+  } else {
+    return null ;
+  }
+}
+
+#define nodelib_getspec        nodelib_getlist
+#define nodelib_getaction      nodelib_getlist
+
+
+static str_number 
+nodelib_getstring(lua_State *L, int a) {
+  size_t k;
+  char *s=(char *)lua_tolstring(L,a, &k);
+  return maketexlstring(s,k);
+}
+
+#define nodelib_gettoks(L,a)   tokenlist_from_lua(L)
+
+static void nodelib_setattr (lua_State *L, int stackindex, halfword n) {
+  halfword p;
+  p = nodelib_getlist(L,stackindex);
+  if (node_attr(n) != p) {
+    if (node_attr(n)!=null)
+      delete_attribute_ref(node_attr(n));
+    node_attr(n) = p; 
+    attr_list_ref(p)++;
+  }
+}
+
+static int nodelib_cantset (lua_State *L, int field, int n) {
+  lua_pushfstring(L,"You cannot set field %d in a node of type %s",
+		  field, node_data[type(n)].name);
+  lua_error(L);
+  return 0;
+}
+
+static int
+lua_nodelib_setfield_whatsit(lua_State *L, int n, int field) {
+  switch (subtype(n)) {
+  case open_node:
+    switch (field) {
+    case  4: write_stream(n) = lua_tointeger(L,3);          break;
+    case  5: open_name(n) = nodelib_getstring(L,3);         break;
+    case  6: open_area(n) = nodelib_getstring(L,3);         break;
+    case  7: open_ext(n)  = nodelib_getstring(L,3);         break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case write_node:              
+    switch (field) {
+    case  4: write_stream(n) = lua_tointeger(L,3);          break;
+    case  5: write_tokens(n) = nodelib_gettoks(L,3);        break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case close_node:              
+    switch (field) {
+    case  4: write_stream(n) = lua_tointeger(L,3);          break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case special_node:            
+    switch (field) {
+    case  4: write_tokens(n) = nodelib_gettoks(L,3);        break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case local_par_node:          
+    switch (field) {
+    case  4: local_pen_inter(n) = lua_tointeger(L,3);       break;
+    case  5: local_pen_broken(n) = lua_tointeger(L,3);      break;
+    case  6: local_par_dir(n) = lua_tointeger(L,3);         break;
+    case  7: local_box_left(n) = nodelib_getlist(L,3);      break;
+    case  8: local_box_left_width(n) = lua_tointeger(L,3);  break;
+    case  9: local_box_right(n) = nodelib_getlist(L,3);     break;
+    case 10: local_box_right_width(n) = lua_tointeger(L,3); break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case dir_node:                
+    switch (field) {
+    case  4: dir_dir(n) = lua_tointeger(L,3);               break;
+    case  5: dir_level(n) = lua_tointeger(L,3);             break;
+    case  6: dir_dvi_ptr(n) = lua_tointeger(L,3);           break;
+    case  7: dir_dvi_h(n) = lua_tointeger(L,3);             break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_literal_node:
+    switch (field) {
+    case  4: pdf_literal_mode(n) = lua_tointeger(L,3);      break;
+    case  5: pdf_literal_data(n) = nodelib_gettoks(L,3);    break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_refobj_node:         
+    switch (field) {
+    case  4: pdf_obj_objnum(n) = lua_tointeger(L,3);        break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_refxform_node:       
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_xform_objnum(n) = lua_tointeger(L,3);      break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_refximage_node:      
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_ximage_objnum(n) = lua_tointeger(L,3);     break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_annot_node:          
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_annot_objnum(n) = lua_tointeger(L,3);      break;
+    case  8: pdf_annot_data(n) = nodelib_getstring(L,3);    break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_start_link_node:     
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_link_objnum(n) = lua_tointeger(L,3);       break;
+    case  8: pdf_link_attr(n) = nodelib_getstring(L,3);     break;
+    case  9: pdf_link_action(n) = nodelib_getaction(L,3);   break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_end_link_node:       
+    switch (field) {
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_dest_node:           
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_dest_named_id(n) = lua_tointeger(L,3);     break;
+    case  8: if (pdf_dest_named_id(n)==1)
+	pdf_dest_id(n) = nodelib_gettoks(L,3);
+      else
+	pdf_dest_id(n) = lua_tointeger(L,3);                break;
+    case  9: pdf_dest_type(n) = lua_tointeger(L,3);         break;
+    case 10: pdf_dest_xyz_zoom(n) = lua_tointeger(L,3);     break;
+    case 11: pdf_dest_objnum(n) = lua_tointeger(L,3);       break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_thread_node:         
+  case pdf_start_thread_node:   
+    switch (field) {
+    case  4: pdf_width(n) = lua_tointeger(L,3);             break;
+    case  5: pdf_height(n) = lua_tointeger(L,3);            break;
+    case  6: pdf_depth(n) = lua_tointeger(L,3);             break;
+    case  7: pdf_thread_named_id(n) = lua_tointeger(L,3);   break;
+    case  8: if (pdf_thread_named_id(n)==1)
+	pdf_thread_id(n) = nodelib_gettoks(L,3);
+      else
+	pdf_thread_id(n) = lua_tointeger(L,3);              break;
+    case  9: pdf_thread_attr(n) = nodelib_gettoks(L,3);     break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_end_thread_node:     
+  case pdf_save_pos_node:       
+    return nodelib_cantset(L,field,n);
+    break;
+  case late_lua_node:           
+    switch (field) {
+    case  4: late_lua_reg(n) = lua_tointeger(L,3);          break;
+    case  5: late_lua_data(n) = nodelib_gettoks(L,3);       break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case close_lua_node:          
+    switch (field) {
+    case  4: late_lua_reg(n) = lua_tointeger(L,3);          break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_colorstack_node:     
+    switch (field) {
+    case  4: pdf_colorstack_stack(n) = lua_tointeger(L,3);  break;
+    case  5: pdf_colorstack_cmd(n) = lua_tointeger(L,3);    break;
+    case  6: pdf_colorstack_data(n) = nodelib_gettoks(L,3); break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_setmatrix_node:      
+    switch (field) {
+    case  4: pdf_setmatrix_data(n) = nodelib_gettoks(L,3);  break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  case pdf_save_node:           
+  case pdf_restore_node:        
+  case cancel_boundary_node:        
+    return nodelib_cantset(L,field,n);
+    break;
+  case user_defined_node:       
+    switch (field) {
+    case  4: user_node_id(n) = lua_tointeger(L,3);          break;
+    case  5: user_node_type(n) = lua_tointeger(L,3);        break;
+    case  6: 
+      switch(user_node_type(n)) {
+      case 'a': user_node_value(n) = nodelib_getlist(L,3); break;
+      case 'd': user_node_value(n) = lua_tointeger(L,3); break;
+      case 'n': user_node_value(n) = nodelib_getlist(L,3); break;
+      case 's': user_node_value(n) = nodelib_getstring(L,3); break;
+      case 't': user_node_value(n) = nodelib_gettoks(L,3); break;
+      default: user_node_value(n) = lua_tointeger(L,3); break;
+      }                                                     break;
+    default: return nodelib_cantset(L,field,n);
+    }
+    break;
+  default:
+    /* do nothing */
+    break;
+  }
+  return 0;
+}
+
+static int
+lua_nodelib_setfield  (lua_State *L) {
+  register halfword n;
+  register int field;
+  n = *check_isnode(L,1);
+  field = get_valid_node_field_id(L,2,n);
+  if (field<-1)
+    return 0;
+  if (field==0) {
+    vlink(n) = nodelib_getlist(L,3);
+  } else if (field==-1) {
+    alink(n) = nodelib_getlist(L,3);
+  } else if (field==3 && nodetype_has_attributes(type(n))) {
+	nodelib_setattr(L,3,n);
+  } else if (type(n)==glyph_node) {
+	switch (field) {
+	case  2: subtype(n) = lua_tointeger(L,3);	      break;
+	case  4: character(n) = lua_tointeger(L,3);       break;
+	case  5: font(n) = lua_tointeger(L,3);	          break;
+	case  6: set_char_lang(n,lua_tointeger(L,3));     break;
+	case  7: set_char_lhmin(n,lua_tointeger(L,3));    break;
+	case  8: set_char_rhmin(n,lua_tointeger(L,3));    break;
+	case  9: set_char_uchyph(n,lua_tointeger(L,3));   break;
+	case 10: lig_ptr(n) = nodelib_getlist(L,3);       break;
+	case 11: x_displace(n) = lua_tointeger(L,3);      break;
+	case 12: y_displace(n) = lua_tointeger(L,3);      break;
+	default: return nodelib_cantset(L,field,n);
+	}
+  } else {
+    switch (type(n)) {
+    case hlist_node:
+    case vlist_node:
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: width(n) = lua_tointeger(L,3);	        break;
+      case  5: depth(n) = lua_tointeger(L,3);	        break;
+      case  6: height(n) = lua_tointeger(L,3);	        break;
+      case  7: box_dir(n) = lua_tointeger(L,3);         break;
+      case  8: shift_amount(n) = lua_tointeger(L,3);    break;
+      case  9: glue_order(n) = lua_tointeger(L,3);      break;
+      case 10: glue_sign(n) = lua_tointeger(L,3);       break;
+      case 11: glue_set(n) = (double)lua_tonumber(L,3); break;
+      case 12: list_ptr(n) = nodelib_getlist(L,3);      break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case unset_node:
+      switch (field) {
+      case  2: /* dummy subtype */                      break;
+      case  4: width(n) = lua_tointeger(L,3);	        break;
+      case  5: depth(n) = lua_tointeger(L,3);	        break;
+      case  6: height(n) = lua_tointeger(L,3);	        break;
+      case  7: box_dir(n) = lua_tointeger(L,3);         break;
+      case  8: glue_shrink(n) = lua_tointeger(L,3);     break;
+      case  9: glue_order(n) = lua_tointeger(L,3);      break;
+      case 10: glue_sign(n) = lua_tointeger(L,3);       break;
+      case 11: glue_stretch(n) = lua_tointeger(L,3);    break;
+      case 12: span_count(n) = lua_tointeger(L,3);	break;
+      case 13: list_ptr(n) = nodelib_getlist(L,3);      break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case rule_node:
+      switch (field) {
+      case  2: /* dummy subtype */                      break;
+      case  4: width(n) = lua_tointeger(L,3);	        break;
+      case  5: depth(n) = lua_tointeger(L,3);	        break;
+      case  6: height(n) = lua_tointeger(L,3);	        break;
+      case  7: rule_dir(n) = lua_tointeger(L,3);        break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case ins_node:
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: float_cost(n) = lua_tointeger(L,3);	break;
+      case  5: depth(n) = lua_tointeger(L,3);	        break;
+      case  6: height(n) = lua_tointeger(L,3);	        break;
+      case  7: split_top_ptr(n) = nodelib_getspec(L,3); break;
+      case  8: ins_ptr(n) = nodelib_getlist(L,3);       break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case mark_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: mark_class(n) = lua_tointeger(L,3);	break;
+      case  5: mark_ptr(n) = nodelib_gettoks(L,3);      break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case adjust_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: adjust_ptr(n) = nodelib_getlist(L,3);    break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case disc_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	            break;
+      case  4: set_disc_field(pre_break(n),nodelib_getlist(L,3));  break;
+      case  5: set_disc_field(post_break(n),nodelib_getlist(L,3)); break;
+      case  6: set_disc_field(no_break(n),nodelib_getlist(L,3));   break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case math_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: surround(n) = lua_tointeger(L,3);        break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case glue_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);         break;
+      case  4: glue_ptr(n) = nodelib_getspec(L,3);      break;
+      case  5: leader_ptr(n) = nodelib_getlist(L,3);    break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case glue_spec_node: 
+      switch (field) {
+      case  2: /* dummy subtype */                      break;
+      case  3: width(n) = lua_tointeger(L,3);	        break;
+      case  4: stretch(n) = lua_tointeger(L,3);	        break;
+      case  5: shrink(n) = lua_tointeger(L,3);	        break;
+      case  6: stretch_order(n) = lua_tointeger(L,3);	break;
+      case  7: shrink_order(n) = lua_tointeger(L,3);	break;
+      case  8: glue_ref_count(n) = lua_tointeger(L,3);  break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case kern_node: 
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  4: width(n) = lua_tointeger(L,3);           break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case penalty_node: 
+      switch (field) {
+      case  2: /* dummy subtype */                      break;
+      case  4: penalty(n) = lua_tointeger(L,3);         break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case action_node:
+      switch (field) {
+      case  2: /* dummy subtype */                            break;
+      case  3: pdf_action_type(n)     = lua_tointeger(L,3);   break;
+      case  4: pdf_action_named_id(n) = lua_tointeger(L,3);   break;
+      case  5: if (pdf_action_named_id(n)==1) {
+	  pdf_action_id(n) = nodelib_gettoks(L,3);         
+	} else {
+	  pdf_action_id(n) = lua_tointeger(L,3);         
+	}                                                     break;
+      case  6: pdf_action_file(n) =  nodelib_gettoks(L,3);    break;
+      case  7: pdf_action_new_window(n) = lua_tointeger(L,3); break;
+      case  8: pdf_action_tokens(n) =  nodelib_gettoks(L,3);  break;
+      case  9: pdf_action_refcount(n) = lua_tointeger(L,3);   break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case margin_kern_node:
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);	        break;
+      case  3: width(n) = lua_tointeger(L,3);           break;
+      case  4: margin_char(n) = nodelib_getlist(L,3);   break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case inserting_node:
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);         break;
+      case  3: last_ins_ptr(n) = nodelib_getlist(L,3);  break;
+      case  4: best_ins_ptr(n) = nodelib_getlist(L,3);  break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case split_up_node:
+      switch (field) {
+      case  2: subtype(n) = lua_tointeger(L,3);         break;
+      case  3: last_ins_ptr(n) = nodelib_getlist(L,3);  break;
+      case  4: best_ins_ptr(n) = nodelib_getlist(L,3);  break;
+      case  5: broken_ptr(n) = nodelib_getlist(L,3);    break;
+      case  6: broken_ins(n) = nodelib_getlist(L,3);    break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case attribute_list_node:
+      switch (field) {
+      case  2: /* dummy subtype */                      break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case attribute_node:
+      switch (field) {
+      case  2: /* dummy subtype */                       break;
+      case  3: attribute_id(n) = lua_tointeger(L,3);     break;
+      case  4: attribute_value(n) = lua_tointeger(L,3);  break;
+      default: return nodelib_cantset(L,field,n);
+      }
+      break;
+    case whatsit_node:
+      lua_nodelib_setfield_whatsit(L,n,field);
+      break;
+    default:
+      /* do nothing */
+      break;
+    }
+  }
+  return 0;
+}
+
+static int
+lua_nodelib_print  (lua_State *L) {
+  char *msg;
+  char a[7] = {' ',' ',' ', 'n', 'i', 'l', 0};
+  char v[7] = {' ',' ',' ', 'n', 'i', 'l', 0};
+  halfword *n;
+  n = check_isnode(L,1);
+  msg = xmalloc(256);
+  if (alink(*n)!=null) 
+    snprintf(a,7,"%6d",(int)alink(*n));
+  if (vlink(*n)!=null) 
+    snprintf(v,7,"%6d",(int)vlink(*n));
+  snprintf(msg,255,"<node %s < %6d > %s : %s %d>", a, (int)*n, v, node_data[type(*n)].name, subtype(*n));
+  lua_pushstring(L,msg);
+  free(msg);
+  return 1;
+}
+
+
+static int
+lua_nodelib_equal  (lua_State *L) {
+  halfword n, m;
+  n = *(check_isnode(L,1));
+  m = *(check_isnode(L,2));
+  lua_pushboolean(L,(n==m));
+  return 1;
+}
+
+static int 
+font_tex_ligaturing (lua_State *L) {
+  /* on the stack are two nodes and a direction */
+  halfword tmp_head;
+  halfword *h;
+  halfword t =null;
+  if (lua_gettop(L)<1) {
+	lua_pushnil(L);
+    lua_pushboolean(L,0);
+    return 2;
+  } 
+  h = check_isnode(L,1);
+  if (lua_gettop(L)>1) {
+	t = *(check_isnode(L,2));
+  }
+  tmp_head = new_node(nesting_node,1);
+  couple_nodes(tmp_head,*h);
+  tlink(tmp_head)=t;
+  t = handle_ligaturing(tmp_head,t);
+  lua_pushnumber(L,vlink(tmp_head));
+  flush_node(tmp_head);
+  lua_nodelib_push(L);  
+  lua_pushnumber(L,t);
+  lua_nodelib_push(L);  
+  lua_pushboolean(L,1);
+  return 3;
+}
+
+static int 
+font_tex_kerning (lua_State *L) {
+  /* on the stack are two nodes and a direction */
+
+  halfword tmp_head;
+  halfword *h;
+  halfword t =null;
+  if (lua_gettop(L)<1) {
+    lua_pushnil(L);
+    lua_pushboolean(L,0);
+    return 2;
+  } 
+  h = check_isnode(L,1);
+  if (lua_gettop(L)>1) {
+    t = *(check_isnode(L,2));
+  }
+  tmp_head = new_node(nesting_node,1);
+  couple_nodes(tmp_head,*h);
+  tlink(tmp_head)=t;
+  t = handle_kerning(tmp_head,t);
+  lua_pushnumber(L,vlink(tmp_head));
+  flush_node(tmp_head);
+  lua_nodelib_push(L);    
+  lua_pushnumber(L,t);
+  lua_nodelib_push(L);    
+  lua_pushboolean(L,1);
+  return 3;
+}
+
+static int
+lua_nodelib_protect_glyphs  (lua_State *L) {
+  int t = 0;
+  halfword head = *(check_isnode(L,1));
+  while (head!=null) {
+    if (type(head)==glyph_node) {
+      register int s = subtype(head);
+      if (s<256) {
+	t = 1;
+	subtype(head) = ((s&0xFE) << 8);
+      }
+    }
+    head = vlink(head);
+  }
+  lua_pushboolean(L,t);
+  lua_pushvalue(L,1);
+  return 2;
+}
+
+static int
+lua_nodelib_unprotect_glyphs  (lua_State *L) {
+  int t = 0;
+  halfword head = *(check_isnode(L,1));
+  while (head!=null) {
+    if (type(head)==glyph_node) {
+      register int s = subtype(head);
+      if (s>=256) {
+	t = 1;
+	subtype(head) = (s >> 8);
+      }
+    }
+    head = vlink(head);
+  }
+  lua_pushboolean(L,t);
+  lua_pushvalue(L,1);
+  return 2;
+}
+
+
+static int 
+lua_nodelib_first_character (lua_State *L) {
+  /* on the stack are two nodes and a direction */
+  halfword h, savetail = null, t = null;
+  if (lua_gettop(L)<1) {
+    lua_pushnil(L);
+    lua_pushboolean(L,0);
+    return 2;
+  } 
+  h = *(check_isnode(L,1));
+  if (lua_gettop(L)>1) {
+    t = *(check_isnode(L,2));
+    savetail = vlink(t);
+    vlink(t) = null;
+  }
+  while (h!=null && !is_simple_character(h)) {
+    h = vlink(h);
+  }
+  if (savetail!=null) { vlink(t) = savetail; }
+  lua_pushnumber(L,h);
+  lua_nodelib_push(L);
+  lua_pushboolean(L,(h==null? 0 : 1));
+  return 2;
+}
+
+
+/* this is too simplistic, but it helps Hans to get going */
+
+halfword
+do_ligature_n  (halfword prev, halfword stop, halfword lig) {
+  vlink(lig) = vlink(stop);
+  vlink(stop) = null;
+  lig_ptr(lig) = vlink(prev);
+  vlink(prev) = lig;
+  return lig;
+}
+
+
+
+/* node.do_ligature_n(node prev, node last, node lig) */
+static int
+lua_nodelib_do_ligature_n  (lua_State *L) {
+  halfword n, m, o, p, tmp_head;
+  n = *(check_isnode(L,1));
+  m = *(check_isnode(L,2));
+  o = *(check_isnode(L,3));
+  if (alink(n)==null || vlink(alink(n))!=n) {
+    tmp_head = new_node(temp_node,0);
+    couple_nodes(tmp_head,n);
+    p = do_ligature_n(tmp_head,m,o);
+    flush_node(tmp_head);
+  } else {
+    p = do_ligature_n(alink(n),m,o);
+  }
+  lua_pushnumber(L,p);
+  lua_nodelib_push(L);
+  return 1;
+}
+
+extern halfword list_node_mem_usage (void) ;
+
+static int
+lua_nodelib_usedlist (lua_State *L) {
+  lua_pushnumber(L,list_node_mem_usage());
+  lua_nodelib_push(L);
+  return 1;
+}
+
+
+static const struct luaL_reg nodelib_f [] = {
+  {"id",            lua_nodelib_id},
+  {"subtype",       lua_nodelib_subtype},
+  {"type",          lua_nodelib_type},
+  {"new",           lua_nodelib_new},
+  {"length",        lua_nodelib_length},
+  {"count",         lua_nodelib_count},
+  {"traverse",      lua_nodelib_traverse},
+  {"traverse_id",   lua_nodelib_traverse_filtered},
+  {"slide",         lua_nodelib_tail},
+  {"types",         lua_nodelib_types},
+  {"whatsits",      lua_nodelib_whatsits},
+  {"fields",        lua_nodelib_fields},
+  {"has_field",     lua_nodelib_has_field},
+  {"free",          lua_nodelib_free},
+  {"flush_list",    lua_nodelib_flush_list},
+  {"remove",        lua_nodelib_remove},
+  {"insert_before", lua_nodelib_insert_before},
+  {"insert_after",  lua_nodelib_insert_after},
+  {"write",         lua_nodelib_append},
+  {"last_node",     lua_nodelib_last_node},
+  {"copy",          lua_nodelib_copy},
+  {"copy_list",     lua_nodelib_copy_list},
+  {"hpack",         lua_nodelib_hpack},
+  {"has_attribute", lua_nodelib_has_attribute},
+  {"set_attribute", lua_nodelib_set_attribute},
+  {"unset_attribute", lua_nodelib_unset_attribute},
+  {"do_ligature_n",   lua_nodelib_do_ligature_n},
+  {"ligaturing",      font_tex_ligaturing},
+  {"kerning",         font_tex_kerning},
+  {"first_character", lua_nodelib_first_character},
+  {"usedlist",        lua_nodelib_usedlist},
+  {"protect_glyphs",   lua_nodelib_protect_glyphs},
+  {"unprotect_glyphs", lua_nodelib_unprotect_glyphs},
+  {NULL, NULL}  /* sentinel */
+};
+
+static const struct luaL_reg nodelib_m [] = {
+  {"__index",    lua_nodelib_getfield},
+  {"__newindex", lua_nodelib_setfield},
+  {"__tostring", lua_nodelib_print},
+  {"__eq",       lua_nodelib_equal},
+  {NULL, NULL}  /* sentinel */
+};
+
+
+
+int 
+luaopen_node (lua_State *L) 
+{
+  luaL_newmetatable(L,NODE_METATABLE);
+  luaL_register(L, NULL, nodelib_m);
+  luaL_register(L, "node", nodelib_f);
+  init_luaS_index(luatex_node);
+  initialize_luaS_indexes(L);
+  return 1;
+}
+
+void 
+nodelist_to_lua (lua_State *L, int n) { 
+  lua_pushnumber(L,n);
+  lua_nodelib_push(L);
+}
+
+int
+nodelist_from_lua (lua_State *L) { 
+  halfword *n;
+  if (lua_isnil(L,-1))
+    return null;
+  n = check_isnode(L,-1);
+  return *n;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/loslibext.c b/Build/source/texk/web2c/luatexdir/lua/loslibext.c
new file mode 100644
index 00000000000..003b031f627
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/loslibext.c
@@ -0,0 +1,627 @@
+/* $Id: loslibext.c 1066 2008-02-23 10:52:51Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include <sys/stat.h>
+#include <sys/types.h>
+#include <time.h>
+
+/* An attempt to figure out the basic platform, does not
+  care about niceties like version numbers yet,
+  and ignores platforms where luatex is unlikely to 
+  successfully compile without major prorting effort 
+  (amiga|mac|os2|vms) */
+
+#if defined(_WIN32) || defined(WIN32) || defined(__NT__)
+#define OS_PLATTYPE "windows"
+#define OS_PLATNAME "windows"
+#elif defined(__GO32__) || defined(__DJGPP__) || defined(__DOS__) 
+#define OS_PLATTYPE "msdos"
+#define OS_PLATNAME "msdos"
+#else  /* assume everything else is unix-y */
+#define OS_PLATTYPE "unix"
+/* this is just a first guess */
+#if defined(__BSD__) 
+  #define OS_PLATNAME "bsd"
+#elif defined(__SYSV__) 
+  #define OS_PLATNAME "sysv"
+#else
+  #define OS_PLATNAME "generic"
+#endif
+/* attempt to be more precise */
+#if defined(__LINUX__) || defined (__linux)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "linux"
+#elif defined(__FREEBSD__) || defined(__FreeBSD)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "freebsd"
+#elif defined(__OPENBSD__)  || defined(__OpenBSD)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "openbsd"
+#elif defined(__SOLARIS__)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "solaris"
+#elif defined(__SUNOS__) ||  defined(__SUN__) ||  defined(sun)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "sunos"
+#elif defined(HPUX) || defined(__hpux)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "hpux"
+#elif defined(__sgi)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "irix"
+#elif defined(__MACH__) && defined(__APPLE__)
+  #undef OS_PLATNAME
+  #define OS_PLATNAME "macosx"
+#endif 
+#endif
+
+
+
+
+
+/* there could be more platforms that don't have these two,
+ *  but win32 and sunos are for sure.
+ * gettimeofday() for win32 is using an alternative definition
+ */
+
+#if (! defined(WIN32)) && (! defined(__SUNOS__))
+#include <sys/time.h>   /* gettimeofday() */
+#include <sys/times.h>  /* times() */
+#include <sys/wait.h>
+#endif 
+
+/* set this to one for spawn instead of exec on windows */
+
+#define DONT_REALLY_EXIT 1
+
+#ifdef WIN32
+#include <process.h>
+#define spawn_command(a,b,c) _spawnvpe(_P_WAIT,(const char *)a,(const char* const*)b,(const char* const*)c)
+#if DONT_REALLY_EXIT
+#define exec_command(a,b,c) exit(spawn_command((a),(b),(c)))
+#else
+#define exec_command(a,b,c) _execvpe((const char *)a,(const char* const*)b,(const char* const*)c)
+#endif
+#else
+#include <unistd.h>
+#define DEFAULT_PATH 	"/bin:/usr/bin:."
+
+static int 
+exec_command(const char *file, char *const *argv, char *const *envp)
+{
+	char path[PATH_MAX];
+	const char *searchpath, *esp;
+	size_t prefixlen, filelen, totallen;
+
+	if (strchr(file, '/'))	/* Specific path */
+		return execve(file, argv, envp);
+
+	filelen = strlen(file);
+
+	searchpath = getenv("PATH");
+	if (!searchpath)
+		searchpath = DEFAULT_PATH;
+
+	errno = ENOENT;		/* Default errno, if execve() doesn't  change it */
+
+	do {
+		esp = strchr(searchpath, ':');
+		if (esp)
+			prefixlen = esp - searchpath;
+		else
+			prefixlen = strlen(searchpath);
+
+		if (prefixlen == 0 || searchpath[prefixlen - 1] == '/') {
+			totallen = prefixlen + filelen;
+			if (totallen >= PATH_MAX)
+				continue;
+			memcpy(path, searchpath, prefixlen);
+			memcpy(path + prefixlen, file, filelen);
+		} else {
+			totallen = prefixlen + filelen + 1;
+			if (totallen >= PATH_MAX)
+				continue;
+			memcpy(path, searchpath, prefixlen);
+			path[prefixlen] = '/';
+			memcpy(path + prefixlen + 1, file, filelen);
+		}
+		path[totallen] = '\0';
+
+		execve(path, argv, envp);
+		if (errno == E2BIG  || errno == ENOEXEC ||
+		    errno == ENOMEM || errno == ETXTBSY)
+			break;	/* Report this as an error, no more search */
+
+		searchpath = esp + 1;
+	} while (esp);
+
+	return -1;
+}
+
+/* 
+   It is not possible to mimic |spawnve()| completely. The main problem is
+   that the |fork|--|waitpid| combination cannot really do identical error 
+   reporting to the parent process, because it has to pass all the possible
+   error conditions as well as the actual process return status through a 
+   single 8-bit value.
+
+   The current implementation tries to give back meaningful results for |execve()|
+   errors in the child, for the cases that could also be returned by |spawnve()|,
+   and for |ETXTBSY|, because that can be triggered by our path searching routine.
+
+   This implementation does not differentiate abnormal status conditions reported 
+   by |waitpid()|, but will simply return a single error indication value.
+
+   For all this, hyjacking a bunch of numbers in the range 1...255 is needed. 
+   The chance of collisions is hopefully diminished by using a rather random
+   range in the 8-bit section.
+*/
+
+#define INVALID_RET_E2BIG   143 
+#define INVALID_RET_ENOENT  144
+#define INVALID_RET_ENOEXEC 145
+#define INVALID_RET_ENOMEM  146
+#define INVALID_RET_ETXTBSY 147
+#define INVALID_RET_UNKNOWN 148
+#define INVALID_RET_INTR    149
+
+static int 
+spawn_command(const char *file, char *const *argv, char *const *envp)
+{
+  pid_t pid, wait_pid;
+  int status;
+  pid = fork();
+  if (pid<0) {
+    return -1; /* fork failed */
+  }
+  if (pid>0) { /* parent */
+    status = 0;
+    wait_pid = waitpid (pid, &status,0);
+    if (wait_pid == pid) {
+      if (WIFEXITED(status))
+	return WEXITSTATUS(status);
+      else
+	return INVALID_RET_INTR;
+    } else {
+      return -1; /* some waitpid error */
+    }
+  } else {
+    int f;
+    /* somewhat random upper limit. ignore errors on purpose */
+    for (f = 0; f<256; f++) 
+      (void)fsync(f);
+
+    if (exec_command(file, argv, envp)) {
+      /* let's hope no-one uses these values  */
+      switch (errno) {
+      case E2BIG:    exit(INVALID_RET_E2BIG);
+      case ETXTBSY:  exit(INVALID_RET_ETXTBSY);
+      case ENOENT:   exit(INVALID_RET_ENOENT);
+      case ENOEXEC:  exit(INVALID_RET_ENOEXEC);
+      case ENOMEM:   exit(INVALID_RET_ENOMEM);
+      default:       exit(INVALID_RET_UNKNOWN);
+      }
+      return -1;
+    }
+  }
+}
+
+#endif
+
+extern char **environ;
+
+static char **
+do_split_command(char *maincmd)
+{
+    char *piece, *start_piece;
+    char *cmd;
+    char **cmdline = NULL;
+    unsigned int i, j;
+    int ret = 0;
+    int in_string = 0;
+    int quoted = 0;
+    if (strlen(maincmd) == 0)
+	return NULL;
+    /* allocate the array of options first. it will probably be 
+       be a little bit too big, but better too much than to little */
+    j=2;
+    for (i = 0; i < strlen(maincmd); i++) { if (maincmd[i]==' ') j++; }
+    cmdline = malloc(sizeof(char *) * j);
+    for (i = 0; i < j; i++) { cmdline[i] = NULL; }
+    cmd = maincmd;
+    i = 0;
+    while (cmd[i] == ' ') i++; /* skip leading spaces */
+    start_piece = malloc(strlen(cmd)+1); /* a buffer */
+    piece = start_piece;
+    for (; i <= strlen(maincmd); i++) {
+      if (cmd[i]=='\\' && 
+	  (cmd[i+1] == '\\' || cmd[i+1] == '\'' || cmd[i+1] == '"')) {
+	quoted =1;
+	continue;
+      }
+      if (in_string && cmd[i] == in_string  && !quoted) { 
+	in_string = 0; 
+	continue; 
+      } 
+      if ((cmd[i] == '"' || cmd[i] == '\'')&& !quoted) { 
+	in_string = cmd[i]; 
+	continue; 
+      } 
+      if ((in_string==0 && cmd[i] == ' ') || cmd[i]==0) {
+	*piece = 0; 
+	cmdline[ret++] = xstrdup(start_piece);
+	piece = start_piece;
+	while (i < strlen(maincmd) && cmd[(i + 1)] == ' ')
+	  i++;
+	continue;
+      }
+      *piece++ = cmd[i];
+      quoted=0;
+    }
+    xfree(start_piece);
+    return cmdline;
+}
+
+static char **
+do_flatten_command(lua_State *L, char **runcmd) {
+   unsigned int i, j ;
+   char *s;
+   char **cmdline = NULL;
+   *runcmd = NULL;
+
+   for (j = 1;;j++) {
+     lua_rawgeti(L,-1,j);
+     if (lua_isnil(L,-1)) {
+       lua_pop(L,1);
+       break;
+     }
+     lua_pop(L,1);
+   }
+   if (j == 1)
+     return NULL;
+   cmdline = malloc(sizeof(char *) * (j+1));
+   for (i = 1; i <= j; i++) {
+     cmdline[i] = NULL;
+     lua_rawgeti(L,-1,i);
+     if (lua_isnil(L,-1) || (s=(char *)lua_tostring(L,-1))==NULL) {
+       lua_pop(L,1);
+       if (i==1) {
+		 xfree(cmdline) ;
+         return NULL;
+       } else {
+         break;
+       }
+     } else {
+       lua_pop(L,1);
+       cmdline[(i-1)] = xstrdup(s);
+     }
+   }
+   cmdline[i] = NULL;
+
+   lua_rawgeti(L,-1,0);
+   if (lua_isnil(L,-1) || (s=(char *)lua_tostring(L,-1))==NULL) {
+	 *runcmd = cmdline[0];
+   } else {
+	 *runcmd = xstrdup(s);
+   }
+   lua_pop(L,1);
+
+   return cmdline;
+}
+
+
+static int os_exec (lua_State *L) {
+  char * maincmd, * runcmd;
+  char ** cmdline = NULL;
+
+  if (lua_gettop(L)!=1) {
+    lua_pushnil(L);
+    lua_pushliteral(L,"invalid arguments passed");
+    return 2;
+  }
+  if (lua_type(L,1)==LUA_TSTRING) {
+    maincmd =  (char *)lua_tostring(L, 1);
+    cmdline = do_split_command(maincmd);
+    runcmd = cmdline[0];
+  } else if (lua_type(L,1)==LUA_TTABLE) {
+    cmdline = do_flatten_command(L, & runcmd);
+  }
+  if (cmdline!=NULL) {
+#if defined(WIN32) && DONT_REALLY_EXIT
+    exec_command(runcmd, cmdline, environ);
+#else
+    if (exec_command(runcmd, cmdline, environ)==-1) {
+      lua_pushnil(L);
+      lua_pushfstring(L,"%s: %s",runcmd,  strerror(errno));
+      lua_pushnumber(L, errno);
+      return 3;
+    }
+#endif
+  }
+  lua_pushnil(L);
+  lua_pushliteral(L,"invalid command line passed");
+  return 2;
+}
+
+#define do_error_return(A,B) do {					\
+    lua_pushnil(L);									\
+    lua_pushfstring(L,"%s: %s",runcmd,(A));			\
+    lua_pushnumber(L, B);							\
+    return 3;										\
+  } while (0)
+
+static int os_spawn (lua_State *L) {
+  char * maincmd, * runcmd;
+  char ** cmdline = NULL;
+  int i;
+
+  if (lua_gettop(L)!=1) {
+    lua_pushnil(L);
+    lua_pushliteral(L,"invalid arguments passed");
+    return 2;
+  }
+  if (lua_type(L,1)==LUA_TSTRING) {
+    maincmd =  (char *)lua_tostring(L, 1);
+    cmdline = do_split_command(maincmd);
+    runcmd = cmdline[0];
+  } else if (lua_type(L,1)==LUA_TTABLE) {
+    cmdline = do_flatten_command(L, &runcmd);
+  }
+  if (cmdline!=NULL) {
+    i = spawn_command(runcmd, cmdline, environ);
+    if (i==0) {
+      lua_pushnumber(L, i);
+      return 1;
+    } else if (i==-1)                  { 
+      /* this branch covers WIN32 as well as fork() and waitpid() errors */
+      do_error_return(strerror(errno),errno);
+#ifndef WIN32
+    } else if (i==INVALID_RET_E2BIG)   { do_error_return(strerror(E2BIG),i);
+    } else if (i==INVALID_RET_ENOENT)  { do_error_return(strerror(ENOENT),i);
+    } else if (i==INVALID_RET_ENOEXEC) { do_error_return(strerror(ENOEXEC),i);
+    } else if (i==INVALID_RET_ENOMEM)  { do_error_return(strerror(ENOMEM),i);
+    } else if (i==INVALID_RET_ETXTBSY) { do_error_return(strerror(ETXTBSY),i);
+    } else if (i==INVALID_RET_UNKNOWN) { do_error_return("execution failed",i);
+    } else if (i==INVALID_RET_INTR)    { do_error_return("execution interrupted",i);
+#endif
+    } else {
+      lua_pushnumber(L, i);
+      return 1;
+    }
+  } 
+  lua_pushnil(L);
+  lua_pushliteral(L,"invalid command line passed");
+  return 2;
+}
+
+/*  Hans wants to set env values */
+
+static int os_setenv (lua_State *L) {
+  char *value, *key, *val;
+  key =  (char *)luaL_optstring(L, 1, NULL);
+  val =  (char *)luaL_optstring(L, 2, NULL);
+  if (key) {
+	if (val) {
+	  value = xmalloc(strlen(key)+strlen(val)+2);
+	  sprintf(value,"%s=%s",key,val);
+	  if (putenv(value)) {
+		return luaL_error(L, "unable to change environment");
+	  }
+	} else {
+#if defined(WIN32) || defined(__sun__)
+	  value = xmalloc(strlen(key)+2);
+	  sprintf(value,"%s=",key);
+	  if (putenv(value)) {
+		return luaL_error(L, "unable to change environment");
+	  } 
+#else
+	  (void)unsetenv(key);
+#endif 
+	}
+  }
+  lua_pushboolean (L, 1);
+  return 1;
+}
+
+
+void find_env (lua_State *L){
+  char *envitem, *envitem_orig;
+  char *envkey;
+  char **envpointer;
+  envpointer = environ;
+  lua_getglobal(L,"os");
+  if (envpointer!=NULL && lua_istable(L,-1)) {
+    luaL_checkstack(L,2,"out of stack space");
+    lua_pushstring(L,"env"); 
+    lua_newtable(L); 
+    while (*envpointer) {
+      /* TODO: perhaps a memory leak here  */
+      luaL_checkstack(L,2,"out of stack space");
+      envitem = xstrdup(*envpointer);
+      envitem_orig = envitem;
+      envkey=envitem;
+      while (*envitem != '=') {
+		envitem++;
+      }
+      *envitem=0;
+      envitem++;
+      lua_pushstring(L,envkey);
+      lua_pushstring(L,envitem);
+      lua_rawset(L,-3);
+      envpointer++;
+      free(envitem_orig);
+    }
+    lua_rawset(L,-3);
+  }
+  lua_pop(L,1);
+}
+
+static int ex_sleep(lua_State *L)
+{
+  lua_Number interval = luaL_checknumber(L, 1);
+  lua_Number units = luaL_optnumber(L, 2, 1);
+#ifdef WIN32
+  Sleep(1e3 * interval / units);
+#else /* assumes posix or bsd */
+  usleep(1e6 * interval / units);
+#endif
+  return 0;
+}
+
+#if (! defined (WIN32))  && (! defined (__SUNOS__))
+static int os_times (lua_State *L) {
+  struct tms r;
+  (void)times(&r);
+  lua_newtable(L);
+  lua_pushnumber(L, ((lua_Number)(r.tms_utime))/(lua_Number)sysconf(_SC_CLK_TCK));
+  lua_setfield(L,-2,"utime");
+  lua_pushnumber(L, ((lua_Number)(r.tms_stime))/(lua_Number)sysconf(_SC_CLK_TCK));
+  lua_setfield(L,-2,"stime");
+  lua_pushnumber(L, ((lua_Number)(r.tms_cutime))/(lua_Number)sysconf(_SC_CLK_TCK));
+  lua_setfield(L,-2,"cutime");
+  lua_pushnumber(L, ((lua_Number)(r.tms_cstime))/(lua_Number)sysconf(_SC_CLK_TCK));
+  lua_setfield(L,-2,"cstime");
+  return 1;
+}
+#endif
+
+#if ! defined (__SUNOS__)
+
+#if defined(_MSC_VER) || defined(_MSC_EXTENSIONS)
+  #define DELTA_EPOCH_IN_MICROSECS  11644473600000000Ui64
+#else
+  #define DELTA_EPOCH_IN_MICROSECS  11644473600000000ULL
+#endif
+
+static int os_gettimeofday (lua_State *L) {
+  double v;
+#ifndef WIN32
+  struct timeval tv;
+  gettimeofday(&tv, NULL);
+  v = (double)tv.tv_sec + (double)tv.tv_usec / 1000000.0;
+#else
+  FILETIME ft;
+  unsigned __int64 tmpres = 0;
+
+  GetSystemTimeAsFileTime(&ft);
+
+  tmpres |= ft.dwHighDateTime;
+  tmpres <<= 32;
+  tmpres |= ft.dwLowDateTime;
+  tmpres /= 10;
+  tmpres -= DELTA_EPOCH_IN_MICROSECS; /*converting file time to unix epoch*/
+  v = (double)tmpres / 1000000.0; 
+#endif
+  lua_pushnumber(L, v);
+  return 1;
+}
+#endif
+
+static const char repl[] = "0123456789abcdefghijklmnopqrstuvwxyz";
+
+static int dirs_made = 0;
+
+#define MAXTRIES 36*36*36
+
+char *
+do_mkdtemp (char *tmpl)
+{
+  int count ;
+  int value ;
+  char *xes = &tmpl[strlen (tmpl) - 6];
+  /* this is not really all that random, but it will do */
+  if (dirs_made==0) {
+	srand(time(NULL));
+  }
+  value = rand();
+  for (count = 0; count < MAXTRIES; value += 8413, ++count) {
+      int v = value;
+      xes[0] = repl[v % 36];  v /= 36;
+      xes[1] = repl[v % 36];  v /= 36;
+      xes[2] = repl[v % 36];  v /= 36;
+      xes[3] = repl[v % 36];  v /= 36;
+      xes[4] = repl[v % 36];  v /= 36;
+      xes[5] = repl[v % 36];
+	  if (mkdir (tmpl, S_IRUSR | S_IWUSR | S_IXUSR) >= 0) {
+		dirs_made++;
+		return tmpl;
+	  } else if (errno != EEXIST) {
+		return NULL;
+	  }
+    }
+  return NULL;
+}
+
+static int os_tmpdir (lua_State *L) {
+  char *s, *tempdir; 
+  char *tmp = (char *)luaL_optstring(L, 1, "luatex.XXXXXX");
+  if (tmp==NULL || 
+	  strlen(tmp)<6 ||
+	  (strcmp(tmp+strlen(tmp)-6,"XXXXXX") != 0)) {
+    lua_pushnil(L);
+    lua_pushstring(L, "Invalid argument to os.tmpdir()");
+    return 2;
+  } else {
+	tempdir = xstrdup(tmp);
+  }
+#ifdef HAVE_MKDTEMP
+  s = mkdtemp(tempdir);
+#else
+  s = do_mkdtemp(tempdir);
+#endif
+  if (s==NULL) {
+	int en = errno;  /* calls to Lua API may change this value */
+	lua_pushnil(L);
+	lua_pushfstring(L, "%s", strerror(en));
+	return 2;
+  } else {
+	lua_pushstring(L,s);
+	return 1;
+  }
+}
+
+
+void
+open_oslibext (lua_State *L, int safer_option) {
+
+  find_env(L);
+
+  lua_getglobal(L,"os");
+  lua_pushcfunction(L, ex_sleep);
+  lua_setfield(L,-2,"sleep");
+  lua_getglobal(L,"os");
+  lua_pushliteral(L, OS_PLATTYPE);
+  lua_setfield(L,-2,"type");
+  lua_getglobal(L,"os");
+  lua_pushliteral(L, OS_PLATNAME);
+  lua_setfield(L,-2,"name");
+#if (! defined (WIN32))  && (! defined (__SUNOS__))
+  lua_getglobal(L,"os");
+  lua_pushcfunction(L, os_times);
+  lua_setfield(L,-2,"times");
+#endif
+#if ! defined (__SUNOS__)
+  lua_getglobal(L,"os");
+  lua_pushcfunction(L, os_gettimeofday);
+  lua_setfield(L,-2,"gettimeofday");
+#endif
+  if (!safer_option) {
+	lua_getglobal(L,"os");
+	lua_pushcfunction(L, os_setenv);
+	lua_setfield(L,-2,"setenv");
+	lua_getglobal(L,"os");
+	lua_pushcfunction(L, os_exec);
+	lua_setfield(L,-2,"exec");
+	lua_getglobal(L,"os");
+	lua_pushcfunction(L, os_spawn);
+	lua_setfield(L,-2,"spawn");
+	lua_getglobal(L,"os");
+	lua_pushcfunction(L, os_tmpdir);
+	lua_setfield(L,-2,"tmpdir");
+
+  }
+
+
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/lpdflib.c b/Build/source/texk/web2c/luatexdir/lua/lpdflib.c
new file mode 100644
index 00000000000..9cf847c84c8
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lpdflib.c
@@ -0,0 +1,127 @@
+/* $Id: lpdflib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+
+static int 
+findcurv (lua_State *L) {
+  int j;
+  j = get_cur_v();
+  lua_pushnumber(L, j);
+  return 1;
+}
+
+static int 
+findcurh (lua_State *L) {
+  int j;
+  j = get_cur_h();
+  lua_pushnumber(L, j);
+  return 1;
+}
+
+
+typedef enum { set_origin, direct_page, direct_always } pdf_lit_mode;
+
+int luapdfprint(lua_State * L)
+{
+    int n;
+	unsigned i, len;
+    const char *outputstr, *st;
+    pdf_lit_mode literal_mode;
+    n = lua_gettop(L);
+    if (!lua_isstring(L, -1)) {
+        lua_pushstring(L, "no string to print");
+        lua_error(L);
+    }
+    literal_mode = set_origin;
+    if (n == 2) {
+        if (!lua_isstring(L, -2)) {
+            lua_pushstring(L, "invalid argument for print literal mode");
+            lua_error(L);
+        } else {
+            outputstr = (char *) lua_tostring(L, -2);
+            if (strcmp(outputstr, "direct") == 0)
+                literal_mode = direct_always;
+            else if (strcmp(outputstr, "page") == 0)
+                literal_mode = direct_page;
+            else {
+                lua_pushstring(L,
+                               "invalid argument for print literal mode");
+                lua_error(L);
+            }
+        }
+    } else {
+	    if (n != 1) {
+            lua_pushstring(L, "invalid number of arguments");
+            lua_error(L);
+        }
+    }
+    switch (literal_mode) {
+    case (set_origin):
+        pdf_end_text();
+        pdf_set_origin(cur_h, cur_v);
+        break;
+    case (direct_page):
+        pdf_end_text();
+        break;
+    case (direct_always):
+        pdf_end_string_nl();
+        break;
+    default:
+        assert(0);
+    }
+    st = lua_tolstring(L, n,&len);
+    for (i = 0; i < len; i++) {
+	  if (i%16 == 0) 
+        pdfroom(16);
+	  pdf_buf[pdf_ptr++] = st[i];
+    }
+    return 0;
+}
+
+static int 
+getpdf (lua_State *L) {
+  char *st;
+  if (lua_isstring(L,2)) {
+    st = (char *)lua_tostring(L,2);
+    if (st && *st) {
+       if (*st == 'h')
+	 return findcurh(L);
+       else if (*st == 'v')
+	 return findcurv(L);
+    }
+  }
+  lua_pushnil(L);
+  return 1;
+}
+
+static int 
+setpdf (lua_State *L) {
+  return (L==NULL ? 0 : 0); /* for -Wall */
+}
+
+static const struct luaL_reg pdflib[] = {
+    {"print", luapdfprint},
+    {NULL, NULL}                /* sentinel */
+};
+
+
+int 
+luaopen_pdf (lua_State *L) {
+  luaL_register(L, "pdf", pdflib);
+  /* build meta table */
+  luaL_newmetatable(L,"pdf_meta"); 
+  lua_pushstring(L, "__index");
+  lua_pushcfunction(L, getpdf); 
+  /* do these later, NYI */
+  if (0) {
+    lua_settable(L, -3);
+    lua_pushstring(L, "__newindex");
+    lua_pushcfunction(L, setpdf); 
+  }
+  lua_settable(L, -3);
+  lua_setmetatable(L,-2); /* meta to itself */
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/lstatslib.c b/Build/source/texk/web2c/luatexdir/lua/lstatslib.c
new file mode 100644
index 00000000000..025e851e775
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/lstatslib.c
@@ -0,0 +1,211 @@
+/* $Id: lstatslib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+typedef struct statistic {
+  const char *name;
+  char type;
+  void *value;
+} statistic ;
+
+extern char *ptexbanner;
+/* extern string getcurrentfilenamestring; */
+
+typedef char * (*charfunc)(void);
+typedef integer (*intfunc)(void);
+
+char *getbanner (void) {
+  return ptexbanner;
+}
+
+/* hack, I really should implement the makecstring */
+char *getfilename (void) {
+  integer t;
+  t = get_current_name();
+  if (t>(1<<21))
+	return makecstring(t);
+  else
+	return xstrdup ("");
+}
+
+char *getlasterror (void) {
+  return makecstring(last_error);
+}
+
+
+extern int luabytecode_max;
+extern int luabytecode_bytes;
+extern int luastate_max;
+extern int luastate_bytes;
+
+static struct statistic stats[] = {
+  { "pdf_gone",                  'g', &pdf_gone         },
+  { "pdf_ptr",                   'g', &pdf_ptr          },
+  { "dvi_gone",                  'g', &dvi_offset       },
+  { "dvi_ptr",                   'g', &dvi_ptr          },
+  { "total_pages",               'g', &total_pages      },
+  { "output_file_name",          's', &output_file_name  },
+  { "log_name",                  's', &texmf_log_name    }, /* weird */
+  { "banner",                    'S', &getbanner       },
+  { "pdftex_banner",             's', &pdftex_banner    },
+  /*
+   * mem stat 
+   */
+  { "var_used",                  'g', &var_used         },
+  { "dyn_used",                  'g', &dyn_used         },
+  /* 
+   * traditional tex stats 
+   */
+  { "str_ptr",                   'g', &str_ptr          },
+  { "init_str_ptr",              'g', &init_str_ptr      },
+  { "max_strings",               'g', &max_strings      },
+  { "pool_ptr",                  'g', &pool_ptr         },
+  { "init_pool_ptr",             'g', &init_pool_ptr     },
+  { "pool_size",                 'g', &pool_size        },
+  { "var_mem_max",               'g', &var_mem_max      },
+  { "node_mem_usage",            'S', &sprint_node_mem_usage  },
+  { "fix_mem_max",               'g', &fix_mem_max      },
+  { "fix_mem_min",               'g', &fix_mem_min      },
+  { "fix_mem_end",               'g', &fix_mem_end      },
+  { "cs_count",                  'g', &cs_count         },
+  { "hash_size",                 'G', &get_hash_size     },
+  { "hash_extra",                'g', &hash_extra       },
+  { "font_ptr",                  'G', &max_font_id      }, 
+  { "max_in_stack",              'g', &max_in_stack      },
+  { "max_nest_stack",            'g', &max_nest_stack    },
+  { "max_param_stack",           'g', &max_param_stack   },
+  { "max_buf_stack",             'g', &max_buf_stack     },
+  { "max_save_stack",            'g', &max_save_stack    },
+  { "stack_size",                'g', &stack_size       },
+  { "nest_size",                 'g', &nest_size        },
+  { "param_size",                'g', &param_size       },
+  { "buf_size",                  'g', &buf_size         },
+  { "save_size",                 'g', &save_size        },
+  /* pdf stats */
+  { "obj_ptr",                   'g', &obj_ptr          },
+  { "obj_tab_size",              'g', &obj_tab_size      },
+  { "pdf_os_cntr",               'g', &pdf_os_cntr       },
+  { "pdf_os_objidx",             'g', &pdf_os_objidx     },
+  { "pdf_dest_names_ptr",        'g', &pdf_dest_names_ptr },
+  { "dest_names_size",           'g', &dest_names_size   },
+  { "pdf_mem_ptr",               'g', &pdf_mem_ptr       },
+  { "pdf_mem_size",              'g', &pdf_mem_size      },
+  
+  { "largest_used_mark",         'g', &biggest_used_mark  },
+
+  { "filename",                  'S', &getfilename     },
+  { "inputid",                   'G', &get_current_name  },
+  { "linenumber",                'g', &line            },
+  { "lasterrorstring",           'S', &getlasterror    },
+  
+  { "luabytecodes",              'g', &luabytecode_max   },
+  { "luabytecode_bytes",         'g', &luabytecode_bytes },
+  { "luastates",                 'g', &luastate_max      },
+  { "luastate_bytes",            'g', &luastate_bytes    },
+
+  { "output_active",             'b', &output_active    },
+  
+  { NULL,                         0 , 0                } };
+
+
+static int stats_name_to_id (char *name) {
+  int i;
+  for (i=0; stats[i].name!=NULL; i++) {
+    if (strcmp(stats[i].name, name) == 0)
+      return i;
+  }
+  return 0;
+}
+
+static int do_getstat (lua_State *L,int i) {
+  int t;
+  char *st;
+  charfunc f;
+  intfunc g;
+  int str;
+  t = stats[i].type;
+  switch(t) {
+  case 'S':
+	f = stats[i].value;
+	st = f();
+	lua_pushstring(L,st);
+	break;
+  case 's':
+	str = *(integer *)(stats[i].value);
+    if (str) {
+      lua_pushstring(L,makecstring(str));
+    } else {
+  	  lua_pushnil(L);
+	}
+	break;
+  case 'G':
+	g = stats[i].value;
+	lua_pushnumber(L,g());
+	break;
+  case 'g':
+	lua_pushnumber(L,*(integer *)(stats[i].value));
+	break;
+  case 'B':
+	g = stats[i].value;
+	lua_pushboolean(L,g());
+	break;
+  case 'b':
+	lua_pushboolean(L,*(integer *)(stats[i].value));
+	break;
+  default:
+	lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int getstats (lua_State *L) {
+  char *st;
+  int i;
+  if (lua_isstring(L,-1)) {
+    st = (char *)lua_tostring(L,-1);
+	i = stats_name_to_id(st);
+	if (i>0) {
+	  return do_getstat(L,i);
+	}
+  }
+  return 0;
+}
+
+static int setstats (lua_State *L) {
+  return 0;
+}
+
+static int statslist (lua_State *L) {
+  int i;
+  luaL_checkstack(L,1,"out of stack space");
+  lua_newtable(L);
+  for (i=0; stats[i].name!=NULL; i++) {
+	luaL_checkstack(L,2,"out of stack space");
+	lua_pushstring(L,stats[i].name);
+	do_getstat(L,i);
+	lua_rawset(L,-3);
+  }
+  return 1;
+}
+
+
+
+static const struct luaL_reg statslib [] = {
+  {"list",statslist},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_stats (lua_State *L) 
+{
+  luaL_register(L, "status", statslib);
+  luaL_newmetatable(L,"stats_meta"); 
+  lua_pushstring(L, "__index");
+  lua_pushcfunction(L, getstats); 
+  lua_settable(L, -3);
+  lua_pushstring(L, "__newindex");
+  lua_pushcfunction(L, setstats); 
+  lua_settable(L, -3);
+  lua_setmetatable(L,-2); /* meta to itself */
+  return 1;
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/ltexiolib.c b/Build/source/texk/web2c/luatexdir/lua/ltexiolib.c
new file mode 100644
index 00000000000..a61409b2943
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/ltexiolib.c
@@ -0,0 +1,117 @@
+/* $Id: ltexiolib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+typedef void (*texio_printer) (strnumber s);
+
+static char *loggable_info = NULL;
+
+static int
+do_texio_print (lua_State *L, texio_printer printfunction) {
+  strnumber texs,u;
+  char *s;
+  char save_selector;
+  int n,i;
+  size_t k;
+  u = 0;
+  n = lua_gettop(L);
+  if (n==0 || !lua_isstring(L, -1)) {
+    lua_pushstring(L, "no string to print");
+    lua_error(L);
+  }
+  save_selector = selector;
+  i = 1;
+  if (n>1) {
+	s=(char *)lua_tostring(L, 1);
+	if      (strcmp(s,"log") == 0)          { i++; selector = log_only;     }
+	else if (strcmp(s,"term") == 0)         { i++; selector = term_only;    }
+	else if (strcmp(s,"term and log") == 0) { i++; selector = term_and_log; }
+  }
+  if (selector!=log_only &&  selector!=term_only && selector != term_and_log) {
+	normalize_selector(); /* sets selector */
+  }
+  /* just in case there is a string in progress */
+  if (str_start[str_ptr-0x200000]<pool_ptr) 
+    u=make_string();
+  for (;i<=n;i++) {
+	s = (char *)lua_tolstring(L, i, &k);
+	texs = maketexlstring(s,k);
+	printfunction(texs);
+	flush_str(texs);
+  }
+  selector = save_selector;
+  if (u!=0) str_ptr--;
+  return 0; 
+}
+
+static void
+do_texio_ini_print (lua_State *L, char *extra) {
+  char *s;
+  int i,n,l;
+  n = lua_gettop(L);
+  i = 1;
+  l = 3;
+  if (n>1) {
+	s=(char *)lua_tostring(L, 1);
+	if      (strcmp(s,"log") == 0)          { i++; l = 1; }
+	else if (strcmp(s,"term") == 0)         { i++; l = 2; }
+	else if (strcmp(s,"term and log") == 0) { i++; l = 3; }
+  }
+  for (;i<=n;i++) {
+	if(lua_isstring(L, i)) {
+	  s = (char *)lua_tostring(L, i);
+	  if (l==2||l==3)
+		fprintf(stdout,"%s%s", extra, s);
+	  if (l==1||l==3) {
+		if (loggable_info==NULL) {
+		  loggable_info = strdup(s);
+		} else {
+		  char *v = concat3 (loggable_info,extra,s);
+		  free(loggable_info);
+		  loggable_info = v;
+		}
+	  }
+	}
+  }
+}
+
+static int
+texio_print (lua_State *L) {
+  if (ready_already!=314159 || pool_ptr==0 || job_name==0) {
+	do_texio_ini_print(L,"");
+	return 0;
+  }
+  return do_texio_print(L,zprint);
+}
+
+static int
+texio_printnl (lua_State *L) {
+  if (ready_already!=314159 || pool_ptr==0 || job_name==0) {
+	do_texio_ini_print(L,"\n");
+	return 0;
+  }
+  return do_texio_print(L,zprint_nl);
+}
+
+/* at the point this function is called, the selector is log_only */
+void flush_loggable_info (void) {
+  if (loggable_info!=NULL) {
+	fprintf(log_file,"%s\n",loggable_info);
+	free(loggable_info);
+	loggable_info=NULL;
+  }
+}
+
+
+static const struct luaL_reg texiolib [] = {
+  {"write", texio_print},
+  {"write_nl", texio_printnl},
+  {NULL, NULL}  /* sentinel */
+};
+
+int
+luaopen_texio (lua_State *L) {
+  luaL_register(L,"texio",texiolib);
+  return 1;
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/ltexlib.c b/Build/source/texk/web2c/luatexdir/lua/ltexlib.c
new file mode 100644
index 00000000000..f2258010136
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/ltexlib.c
@@ -0,0 +1,820 @@
+/* $Id: ltexlib.c 1087 2008-03-07 23:52:35Z hhenkel $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+typedef struct {
+  char *text;
+  unsigned int tsize;
+  void *next;
+  unsigned char partial;
+  int cattable;
+} rope;
+
+typedef struct {
+  rope *head;
+  rope *tail;
+  char complete; /* currently still writing ? */
+} spindle;
+
+#define  PARTIAL_LINE       1
+#define  FULL_LINE          0
+
+#define  NO_CAT_TABLE      -2
+#define  DEFAULT_CAT_TABLE -1
+
+#define  write_spindle spindles[spindle_index]
+#define  read_spindle  spindles[(spindle_index-1)]
+
+static int      spindle_size  = 0;
+static spindle *spindles      = NULL;
+static int      spindle_index = 0;
+
+
+static int 
+do_luacprint (lua_State * L, int partial, int deftable) {
+  int i, n;
+  size_t tsize;
+  char *st, *sttemp;
+  rope *rn;
+  int cattable = deftable;
+  int startstrings = 1;
+  n = lua_gettop(L);
+  if (cattable != NO_CAT_TABLE) {
+    if (lua_type(L,1)==LUA_TNUMBER && n>1) {
+      cattable = lua_tonumber(L, 1);
+      startstrings = 2;
+    }
+  }
+  for (i = startstrings; i <= n; i++) {
+    if (!lua_isstring(L, i)) {
+      lua_pushstring(L, "no string to print");
+      lua_error(L);
+    }
+    sttemp = (char *)lua_tolstring(L, i,&tsize);
+    st = xmalloc((tsize+1)); 
+    memcpy(st,sttemp,(tsize+1));
+    if (st) {
+      /* fprintf(stderr,"W[%d]:=%s\n",spindle_index,st);*/
+      luacstrings++; 
+      rn = (rope *)xmalloc(sizeof(rope)); /* valgrind says we leak here */
+      rn->text      = st;
+      rn->tsize     = tsize;
+      rn->partial   = partial;
+      rn->cattable  = cattable;
+      rn->next = NULL;
+      if (write_spindle.head == NULL) {
+	assert(write_spindle.tail == NULL);
+	write_spindle.head = rn;
+      } else {
+	write_spindle.tail->next  = rn;
+      }
+      write_spindle.tail = rn;
+      write_spindle.complete = 0;
+    }
+  }
+  return 0;
+}
+
+int luacwrite(lua_State * L) {
+  return do_luacprint(L,FULL_LINE,NO_CAT_TABLE);
+}
+
+int luacprint(lua_State * L) {
+  return do_luacprint(L,FULL_LINE,DEFAULT_CAT_TABLE);
+}
+
+int luacsprint(lua_State * L) {
+  return do_luacprint(L,PARTIAL_LINE,DEFAULT_CAT_TABLE);
+}
+
+int 
+luacstring_detokenized (void) {
+  return (read_spindle.tail->cattable == NO_CAT_TABLE);
+}
+
+int
+luacstring_defaultcattable (void) {
+  return (read_spindle.tail->cattable == DEFAULT_CAT_TABLE);
+}
+
+integer
+luacstring_cattable (void) {
+  return (integer)read_spindle.tail->cattable;
+}
+
+int 
+luacstring_simple (void) {
+  return (read_spindle.tail->partial == PARTIAL_LINE);
+}
+
+int 
+luacstring_penultimate (void) {
+  return (read_spindle.tail->next == NULL);
+}
+
+int 
+luacstring_input (void) {
+  char *st;
+  int ret;
+  rope *t = read_spindle.head;
+  if (!read_spindle.complete) {
+    read_spindle.complete =1;
+    read_spindle.tail = NULL;
+  }
+  if (t == NULL) {
+    if(read_spindle.tail != NULL)
+      free(read_spindle.tail);
+    read_spindle.tail = NULL;
+    return 0;
+  }
+  if (t->text != NULL) {
+    st = t->text;
+    /* put that thing in the buffer */
+    last = first;
+    ret = last;
+    check_buffer_overflow (last + t->tsize);
+    while (t->tsize-->0)
+      buffer[last++] = *st++;
+    if (!t->partial) {
+      while (last-1>ret && buffer[last-1] == ' ')
+	last--;
+    }
+    free (t->text);
+    t->text = NULL;
+  }
+  if (read_spindle.tail != NULL) { /* not a one-liner */
+    free(read_spindle.tail);
+  }
+  read_spindle.tail = t;
+  read_spindle.head = t->next;
+  return 1;
+}
+
+/* open for reading, and make a new one for writing */
+void 
+luacstring_start (int n) {
+  spindle_index++;
+  if(spindle_size == spindle_index) { /* add a new one */
+    spindles = xrealloc(spindles,sizeof(spindle)*(spindle_size+1));
+    spindles[spindle_index].head = NULL;
+    spindles[spindle_index].tail = NULL;
+    spindles[spindle_index].complete = 0;
+    spindle_size++;
+  }
+}
+
+/* close for reading */
+
+void 
+luacstring_close (int n) {
+  rope *next, *t;
+  next = read_spindle.head;
+  while (next != NULL) {
+    if (next->text != NULL)
+      free(next->text);
+    t = next;
+    next = next->next;
+    free(t);
+  }
+  read_spindle.head = NULL;
+  if(read_spindle.tail != NULL)
+    free(read_spindle.tail);
+  read_spindle.tail = NULL;
+  read_spindle.complete = 0;
+  spindle_index--;
+}
+
+/* local (static) versions */
+
+#define width_offset 1
+#define depth_offset 2
+#define height_offset 3
+
+#define check_index_range(j)                            \
+   if (j<0 || j > 65535) {                                \
+	lua_pushstring(L, "incorrect index value");	\
+	lua_error(L);  }
+
+
+int dimen_to_number (lua_State *L,char *s){
+  double v;
+  char *d;
+  int j;
+  v = strtod(s,&d);
+  if      (strcmp (d,"in") == 0) { j = (int)(((v*7227)/100)   *65536); }
+  else if (strcmp (d,"pc") == 0) { j = (int)((v*12)           *65536); } 
+  else if (strcmp (d,"cm") == 0) { j = (int)(((v*7227)/254)   *65536); }
+  else if (strcmp (d,"mm") == 0) { j = (int)(((v*7227)/2540)  *65536); }
+  else if (strcmp (d,"bp") == 0) { j = (int)(((v*7227)/7200)  *65536); }
+  else if (strcmp (d,"dd") == 0) { j = (int)(((v*1238)/1157)  *65536); }
+  else if (strcmp (d,"cc") == 0) { j = (int)(((v*14856)/1157) *65536); }
+  else if (strcmp (d,"nd") == 0) { j = (int)(((v*21681)/20320)*65536); }
+  else if (strcmp (d,"nc") == 0) { j = (int)(((v*65043)/5080) *65536); }
+  else if (strcmp (d,"pt") == 0) { j = (int)(v                *65536); }
+  else if (strcmp (d,"sp") == 0) { j = (int)(v); }
+  else {
+	lua_pushstring(L, "unknown dimension specifier");
+	lua_error(L);
+	j = 0;
+  }
+  return j;
+}
+
+int setdimen (lua_State *L) {
+  int i,j;
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  j = 0;
+  /* find the value*/
+  if (!lua_isnumber(L,i))
+    if (lua_isstring(L,i)) {
+	j = dimen_to_number(L,(char *)lua_tostring(L,i));
+    } else {
+      lua_pushstring(L, "unsupported value type");
+      lua_error(L);
+    }
+  else
+    j = (int)lua_tonumber(L,i);
+  /* find the index*/
+  if (lua_type(L,i-1)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i-1, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    k = zget_equiv(cur_cs)-get_scaled_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i-1);
+  }
+  check_index_range(k);
+  if(set_tex_dimen_register(k,j)) {
+    lua_pushstring(L, "incorrect value");
+    lua_error(L);
+  }
+  return 0;
+}
+
+int getdimen (lua_State *L) {
+  int i,j;  
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  if (lua_type(L,i)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    if (is_undefined_cs(cur_cs)) {
+      lua_pushnil(L);
+      return 1;
+    }
+    k = zget_equiv(cur_cs)-get_scaled_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i);
+  }
+  check_index_range(k);
+  j = get_tex_dimen_register(k);
+  lua_pushnumber(L, j);
+  return 1;
+}
+
+int setcount (lua_State *L) {
+  int i,j;
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  j = (int)luaL_checkinteger(L,i);
+  if (lua_type(L,i-1)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i-1,&k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    k = zget_equiv(cur_cs)-get_count_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i-1);
+  }
+  check_index_range(k);
+  if (set_tex_count_register(k,j)) {
+	lua_pushstring(L, "incorrect value");
+	lua_error(L);
+  }
+  return 0;
+}
+
+int getcount (lua_State *L) {
+  int i, j;
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  if (lua_type(L,i)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    if (is_undefined_cs(cur_cs)) {
+      lua_pushnil(L);
+      return 1;
+    }
+    k = zget_equiv(cur_cs)-get_count_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i);
+  }
+  check_index_range(k);
+  j = get_tex_count_register(k);
+  lua_pushnumber(L, j);
+  return 1;
+}
+
+
+int setattribute (lua_State *L) {
+  int i,j;
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  j = (int)luaL_checkinteger(L,i);
+  if (lua_type(L,i-1)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i-1, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    k = zget_equiv(cur_cs)-get_attribute_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i-1);
+  }
+  check_index_range(k);
+  if (set_tex_attribute_register(k,j)) {
+	lua_pushstring(L, "incorrect value");
+	lua_error(L);
+  }
+  return 0;
+}
+
+int getattribute (lua_State *L) {
+  int i, j;
+  size_t k;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  if (lua_type(L,i)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    if (is_undefined_cs(cur_cs)) {
+      lua_pushnil(L);
+      return 1;
+    }
+    k = zget_equiv(cur_cs)-get_attribute_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i);
+  }
+  check_index_range(k);
+  j = get_tex_attribute_register(k);
+  lua_pushnumber(L, j);
+  return 1;
+}
+
+int settoks (lua_State *L) {
+  int i,j;
+  size_t k,len;
+  int cur_cs;
+  int texstr;
+  char *s, *st;
+  i = lua_gettop(L);
+  if (!lua_isstring(L,i)) {
+    lua_pushstring(L, "unsupported value type");
+    lua_error(L);
+  }
+  st = (char *)lua_tolstring(L,i,&len);
+
+  if (lua_type(L,i-1)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i-1, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    k = zget_equiv(cur_cs)-get_toks_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i-1);
+  }
+  check_index_range(k);
+  j = maketexlstring(st,len);
+
+  if(zset_tex_toks_register(k,j)) {
+    flush_str(j);
+    lua_pushstring(L, "incorrect value");
+    lua_error(L);
+  }
+  return 0;
+}
+
+int gettoks (lua_State *L) {
+  int i;
+  size_t k;
+  strnumber t;
+  int cur_cs;
+  int texstr;
+  char *s;
+  i = lua_gettop(L);
+  if (lua_type(L,i)==LUA_TSTRING) {
+    s = (char *)lua_tolstring(L,i, &k);
+    texstr = maketexlstring(s,k);
+    cur_cs = string_lookup(texstr);
+    flush_str(texstr);
+    if (is_undefined_cs(cur_cs)) {
+      lua_pushnil(L);
+      return 1;
+    }
+    k = zget_equiv(cur_cs)-get_toks_base();
+  } else {
+    k = (int)luaL_checkinteger(L,i);
+  }
+
+  check_index_range(k);
+  t = get_tex_toks_register(k);
+  lua_pushstring(L, makecstring(t));
+  flush_str(t);
+  return 1;
+}
+
+int getbox (lua_State *L) {
+  int k, t;
+  k = (int)luaL_checkinteger(L,-1);
+  check_index_range(k);
+  t = get_tex_box_register(k);
+  nodelist_to_lua(L,t);
+  return 1;
+}
+
+int setbox (lua_State *L) {
+  int i,j,k;
+
+
+
+  k = (int)luaL_checkinteger(L,-2);
+  check_index_range(k);
+  i = get_tex_box_register(k);
+  if (lua_isboolean(L,-1)) {
+    j = lua_toboolean(L,-1);
+    if (j==0)
+      j = null;
+    else 
+      return 0;
+  } else {
+    j = nodelist_from_lua(L);
+  }
+  if(set_tex_box_register(k,j)) {
+    lua_pushstring(L, "incorrect value");
+    lua_error(L);
+  }
+  return 0;
+}
+
+
+static int getboxdim (lua_State *L, int whichdim) {
+  int i, j;
+  i = lua_gettop(L);
+  j = (int)lua_tonumber(L,(i));
+  lua_settop(L,(i-2)); /* table at -1 */
+  if (j<0 || j > 65535) {
+	lua_pushstring(L, "incorrect index");
+	lua_error(L);
+  }
+  switch (whichdim) {
+  case width_offset: 
+	lua_pushnumber(L, get_tex_box_width(j));
+	break;
+  case height_offset: 
+	lua_pushnumber(L, get_tex_box_height(j));
+	break;
+  case depth_offset: 
+	lua_pushnumber(L, get_tex_box_depth(j));
+  }
+  return 1;
+}
+
+int getboxwd (lua_State *L) {
+  return getboxdim (L, width_offset);
+}
+
+int getboxht (lua_State *L) {
+  return getboxdim (L, height_offset);
+}
+
+int getboxdp (lua_State *L) {
+  return getboxdim (L, depth_offset);
+}
+
+static int setboxdim (lua_State *L, int whichdim) {
+  int i,j,k,err;
+  i = lua_gettop(L);
+  if (!lua_isnumber(L,i)) {
+	j = dimen_to_number(L,(char *)lua_tostring(L,i));
+  } else {
+    j = (int)lua_tonumber(L,i);
+  }
+  k = (int)lua_tonumber(L,(i-1));
+  lua_settop(L,(i-3)); /* table at -2 */
+  if (k<0 || k > 65535) {
+	lua_pushstring(L, "incorrect index");
+	lua_error(L);
+  }
+  err = 0;
+  switch (whichdim) {
+  case width_offset: 
+	err = set_tex_box_width(k,j);
+	break;
+  case height_offset: 
+	err = set_tex_box_height(k,j);
+	break;
+  case depth_offset: 
+	err = set_tex_box_depth(k,j);
+  }
+  if (err) {
+	lua_pushstring(L, "not a box");
+	lua_error(L);
+  }
+  return 0;
+}
+
+int setboxwd (lua_State *L) {
+  return setboxdim(L,width_offset);
+}
+
+int setboxht (lua_State *L) {
+  return setboxdim(L,height_offset);
+}
+
+int setboxdp (lua_State *L) {
+  return setboxdim(L,depth_offset);
+}
+
+int settex (lua_State *L) {
+  char *st;
+  int i,j,texstr;
+  size_t k;
+  int cur_cs, cur_cmd;
+  j = 0;
+  i = lua_gettop(L);
+  if (lua_isstring(L,(i-1))) {
+    st = (char *)lua_tolstring(L,(i-1), &k);
+    texstr = maketexlstring(st,k);
+    if (zis_primitive(texstr)) {
+      cur_cs = string_lookup(texstr);
+      flush_str(texstr);
+      cur_cmd = zget_eq_type(cur_cs);
+      if (is_int_assign(cur_cmd)) {
+	if (lua_isnumber(L,i)) {
+	  assign_internal_int(zget_equiv(cur_cs),lua_tonumber(L,i));
+	} else {
+	  lua_pushstring(L, "unsupported value type");
+	  lua_error(L);
+	}
+      } else if (is_dim_assign(cur_cmd)) {
+	if (!lua_isnumber(L,i))
+	  if (lua_isstring(L,i)) {
+	    j = dimen_to_number(L,(char *)lua_tostring(L,i));
+	  } else {
+	    lua_pushstring(L, "unsupported value type");
+	    lua_error(L);
+	  }
+	else
+	  j = (int)lua_tonumber(L,i);
+	assign_internal_dim(zget_equiv(cur_cs),j);
+      } else {
+	lua_pushstring(L, "unsupported tex internal assignment");
+	lua_error(L);
+      }
+    } else {
+      lua_rawset(L,(i-2));
+    }
+  } else {
+    lua_rawset(L,(i-2));
+  }
+  return 0;
+}
+
+char *
+get_something_internal (int cur_cmd, int cur_code) {
+  int texstr;
+  char *str;
+  int save_cur_val,save_cur_val_level;
+  save_cur_val = cur_val;
+  save_cur_val_level = cur_val_level;
+  zscan_something_simple(cur_cmd,cur_code);
+  texstr = the_scanned_result();
+  cur_val = save_cur_val;
+  cur_val_level = save_cur_val_level;  
+  str = makecstring(texstr);
+  flush_str(texstr);
+  return str;
+}
+
+char *
+get_convert (int cur_code) {
+  int texstr;
+  char *str = NULL;
+  texstr = the_convert_string(cur_code);
+  if (texstr) {
+    str = makecstring(texstr);
+    flush_str(texstr);
+  }
+  return str;
+}
+
+
+int
+gettex (lua_State *L) {
+  char *st;
+  int i,texstr;
+  size_t k;
+  char *str;
+  int cur_cs, cur_cmd, cur_code;
+  i = lua_gettop(L);
+  if (lua_isstring(L,i)) {
+    st = (char *)lua_tolstring(L,i, &k);
+    texstr = maketexlstring(st,k);
+    cur_cs = zprim_lookup(texstr);
+    flush_str(texstr);
+    if (cur_cs) {
+      cur_cmd = zget_prim_eq_type(cur_cs);
+      cur_code = zget_prim_equiv(cur_cs);
+      if (is_convert(cur_cmd))
+	str = get_convert(cur_code);
+      else 
+	str = get_something_internal(cur_cmd,cur_code);
+      if (str)
+	lua_pushstring(L,str);
+      else 
+	lua_pushnil(L);
+      return 1;
+    } else {
+      lua_rawget(L,(i-1));
+      return 1;
+    }    
+  } else {
+    lua_rawget(L,(i-1));
+    return 1;
+  }
+  return 0; /* not reached */
+}
+
+
+int
+getlist (lua_State *L) {
+  char *str;
+  if (lua_isstring(L,2)) {
+    str = (char *)lua_tostring(L,2);
+    if (strcmp(str,"page_ins_head")==0) {
+      lua_pushnumber(L,page_ins_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"contrib_head")==0) {
+      lua_pushnumber(L,contrib_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"page_head")==0) {
+      lua_pushnumber(L,page_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"temp_head")==0) {
+      lua_pushnumber(L,temp_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"hold_head")==0) {
+      lua_pushnumber(L,hold_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"adjust_head")==0) {
+      lua_pushnumber(L,adjust_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"pre_adjust_head")==0) {
+      lua_pushnumber(L,pre_adjust_head);  lua_nodelib_push(L);
+    } else if (strcmp(str,"align_head")==0) {
+      lua_pushnumber(L,align_head);  lua_nodelib_push(L);
+    } else {
+      lua_pushnil(L);
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+int
+setlist (lua_State *L) {
+  return 0;
+}
+
+#define infinity 2147483647
+
+static int 
+do_integer_error(double m) {
+  char *help[] = {"I can only go up to 2147483647='17777777777=""7FFFFFFF,",
+				  "so I'm using that number instead of yours.",   
+				  NULL } ;
+  tex_error("Number too big",help);
+  return (m>0.0 ? infinity : -infinity);
+}
+
+
+static int
+tex_roundnumber (lua_State *L) {
+  double m = lua_tonumber(L, 1)+0.5;
+  if (abs(m)>(double)infinity)
+	lua_pushnumber(L,do_integer_error(m));
+  else
+	lua_pushnumber(L,floor(m));
+  return 1;
+}
+
+static int
+tex_scaletable (lua_State *L) {
+  double delta = luaL_checknumber(L, 2);
+  if (lua_istable(L,1)) {
+    lua_newtable(L); /* the new table is at index 3 */
+    lua_pushnil(L);
+    while (lua_next(L,1)!= 0 ) {  /* numeric value */
+	  lua_pushvalue(L,-2);
+	  lua_insert(L,-2);
+      if (lua_isnumber(L,-1)) {
+        double m = lua_tonumber(L,-1)*delta + 0.5;
+		lua_pop(L,1);
+		if (abs(m)>(double)infinity)
+		  lua_pushnumber(L,do_integer_error(m));
+		else
+		  lua_pushnumber(L,floor(m));
+	  }
+	  lua_rawset(L,3);
+    }
+  } else if (lua_isnumber(L,1)) {
+    double m = lua_tonumber(L,1)*delta + 0.5;
+	if (abs(m)>(double)infinity)
+	  lua_pushnumber(L,do_integer_error(m));
+	else
+	  lua_pushnumber(L,floor(m));
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static const struct luaL_reg texlib [] = {
+  {"write",    luacwrite},
+  {"print",    luacprint},
+  {"sprint",   luacsprint},
+  {"setdimen", setdimen},
+  {"getdimen", getdimen},
+  {"setattribute", setattribute},
+  {"getattribute", getattribute},
+  {"setcount",  setcount},
+  {"getcount",  getcount},
+  {"settoks",   settoks},
+  {"gettoks",   gettoks},
+  {"setbox",    setbox},
+  {"getbox",    getbox},
+  {"setlist",   setlist},
+  {"getlist",   getlist},
+  {"setboxwd",  setboxwd},
+  {"getboxwd",  getboxwd},
+  {"setboxht",  setboxht},
+  {"getboxht",  getboxht},
+  {"setboxdp",  setboxdp},
+  {"getboxdp",  getboxdp},
+  {"round",     tex_roundnumber},
+  {"scale",     tex_scaletable},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_tex (lua_State *L) 
+{
+  luaL_register(L, "tex", texlib);
+  make_table(L,"attribute","getattribute","setattribute");
+  make_table(L,"dimen","getdimen","setdimen");
+  make_table(L,"count","getcount","setcount");
+  make_table(L,"toks","gettoks","settoks");
+  make_table(L,"box","getbox","setbox");
+  make_table(L,"lists","getlist","setlist");
+  make_table(L,"wd","getboxwd","setboxwd");
+  make_table(L,"ht","getboxht","setboxht");
+  make_table(L,"dp","getboxdp","setboxdp");
+  /* make the meta entries */
+  /* fetch it back */
+  luaL_newmetatable(L,"tex_meta"); 
+  lua_pushstring(L, "__index");
+  lua_pushcfunction(L, gettex); 
+  lua_settable(L, -3);
+  lua_pushstring(L, "__newindex");
+  lua_pushcfunction(L, settex); 
+  lua_settable(L, -3);
+  lua_setmetatable(L,-2); /* meta to itself */
+  /* initialize the I/O stack: */
+  spindles = xmalloc(sizeof(spindle));
+  spindle_index = 0;
+  spindles[0].head = NULL;
+  spindles[0].tail = NULL;
+  spindle_size = 1;
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/ltokenlib.c b/Build/source/texk/web2c/luatexdir/lua/ltokenlib.c
new file mode 100644
index 00000000000..582779623cf
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/ltokenlib.c
@@ -0,0 +1,263 @@
+/* $Id: ltokenlib.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+
+extern int get_command_id (char *);
+
+static int max_command = 0;
+static int hash_base = 0;
+static int active_base = 0;
+static int null_cs = 0;
+
+#define  protected_token 0x1C00001
+
+#define  is_valid_token(L,i)  (lua_istable(L,i) && lua_objlen(L,i)==3)
+#define  get_token_cmd(L,i)  lua_rawgeti(L,i,1) 
+#define  get_token_chr(L,i)  lua_rawgeti(L,i,2) 
+#define  get_token_cs(L,i)   lua_rawgeti(L,i,3) 
+
+static int 
+test_expandable (lua_State *L) {
+  integer cmd = -1;
+  if (is_valid_token(L,-1)) {
+    get_token_cmd(L,-1);
+    if (lua_isnumber(L,-1)) {
+      cmd = lua_tointeger(L,-1);
+    } else if (lua_isstring(L,-1)) {
+      cmd = get_command_id((char *)lua_tostring(L,-1));
+    }
+    if (cmd>max_command) {
+      lua_pushboolean(L,1);
+    } else {
+      lua_pushboolean(L,0);
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+static int 
+test_protected (lua_State *L) {
+  integer chr = -1;
+  if (is_valid_token(L,-1)) {
+    get_token_chr(L,-1);
+    if (lua_isnumber(L,-1)) {
+      chr = lua_tointeger(L,-1);
+    } else if (lua_isstring(L,-1)) {
+      chr = get_command_id((char *)lua_tostring(L,-1));
+    }
+    if (fixmem[fixmem[chr].hhrh].hhlh==protected_token) {
+      lua_pushboolean(L,1);
+    } else {
+      lua_pushboolean(L,0);
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int 
+test_activechar (lua_State *L) {
+  integer cmd = -1;
+  if (is_valid_token(L,-1)) {
+    get_token_chr(L,-1);
+    if (lua_isnumber(L,-1)) {
+      cmd = lua_tointeger(L,-1);
+    }
+    if (cmd>0 && cmd==protected_token) {
+      lua_pushboolean(L,1);
+    } else {
+      lua_pushboolean(L,0);
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+
+static int
+run_get_command_name (lua_State *L) {
+  int cs;
+  if (is_valid_token(L,-1)) {
+    get_token_cmd(L,-1);
+    if (lua_isnumber(L,-1)) {
+      cs = lua_tointeger(L,-1);
+      lua_pushstring(L,command_names[cs].cmd_name);
+    } else {
+      lua_pushstring(L,"");
+    }
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int
+run_get_csname_name (lua_State *L) {
+  int cs,cmd,n;
+  char *s;
+
+  if (is_valid_token(L,-1)) {
+    get_token_cmd(L,-1);
+	if (lua_isnumber(L,-1)) {
+	  cmd = lua_tointeger(L,-1);
+	}
+	lua_pop(L,1);
+    cs = 0;
+    get_token_cs(L,-1);
+	if (lua_isnumber(L,-1)) {
+	  cs = lua_tointeger(L,-1);
+	}
+	lua_pop(L,1);
+
+	if (cs != 0 && (n = zget_cs_text(cs)) && n>=0) {
+	  s = makecstring(n);
+	  lua_pushstring(L,s);
+	} else {
+	  lua_pushstring(L,"");
+	}
+  } else {
+    lua_pushnil(L);
+  }
+  return 1;
+}
+
+static int
+run_get_command_id (lua_State *L) {
+  int cs = -1;
+  if (lua_isstring(L,-1)) {
+    cs = get_command_id((char *)lua_tostring(L,-1));
+  }
+  lua_pushnumber(L,cs);
+  return 1;
+}
+
+
+static int
+run_get_csname_id (lua_State *L) {
+  int texstr;
+  char *s;
+  size_t k,cs = 0;
+  if (lua_isstring(L,-1)) {
+    s = (char *)lua_tolstring(L,-1, &k);
+	texstr = maketexlstring(s,k);
+    cs = string_lookup(texstr);
+    flush_str(texstr);
+  }
+  lua_pushnumber(L,cs);
+  return 1;
+}
+
+
+void 
+make_token_table (lua_State *L, int cmd, int chr, int cs) {
+  lua_createtable(L,3,0);
+  lua_pushnumber(L,cmd);
+  lua_rawseti(L,-2,1);
+  lua_pushnumber(L,chr);
+  lua_rawseti(L,-2,2);
+  lua_pushnumber(L,cs);
+  lua_rawseti(L,-2,3);
+}
+
+static int 
+run_get_next (lua_State *L) {
+  int save_nncs;
+  save_nncs = no_new_control_sequence;
+  no_new_control_sequence = 0;
+  get_next();
+  no_new_control_sequence = save_nncs;
+  make_token_table(L,cur_cmd,cur_chr,cur_cs);
+  return 1;
+}
+
+static int 
+run_expand (lua_State *L) {
+  expand();
+  return 0;
+}
+
+
+static int 
+run_lookup (lua_State *L) {
+  char *s;
+  size_t l;
+  str_number t;
+  integer cs,cmd,chr;
+  int save_nncs;
+  if (lua_isstring(L,-1)) {
+    s = (char *)lua_tolstring(L,-1,&l);
+    if (l>0) {
+      save_nncs = no_new_control_sequence;
+      no_new_control_sequence = true;
+      cs = id_lookup((last+1),l); /* cleans up the lookup buffer */
+      t = maketexlstring(s,l);
+      cs = string_lookup(t);
+      flush_str(t);
+      cmd = zget_eq_type(cs);
+      chr = zget_equiv(cs);
+      make_token_table(L,cmd,chr,cs);
+      no_new_control_sequence = save_nncs;
+      return 1;
+    }
+  }
+  lua_newtable(L);
+  return 1;
+}
+
+static int 
+run_build (lua_State *L) {
+  integer cmd,chr,cs;
+  if (lua_isnumber(L,1)) {
+    cs =0;
+    chr = lua_tointeger(L,1);
+    cmd = luaL_optinteger(L,2,zget_char_cat_code(chr));
+    if (cmd==0 || cmd == 9 || cmd == 14 || cmd == 15) {
+      fprintf(stdout, "\n\nluatex error: not a good token.\nCatcode %i can not be returned, so I replaced it by 12 (other)",(int)cmd);
+      error();
+      cmd=12;
+    }
+    if (cmd == 13) {
+       cs=chr+active_base;
+       cmd=zget_eq_type(cs); 
+       chr=zget_equiv(cs);
+    }
+    make_token_table(L,cmd,chr,cs);
+    return 1;
+  } else {
+    return run_lookup(L);
+  }
+}
+
+
+static const struct luaL_reg tokenlib [] = {
+  {"get_next",     run_get_next},
+  {"expand",       run_expand},
+  {"lookup",       run_lookup},
+  {"create",       run_build},
+  {"is_expandable",test_expandable},
+  {"is_activechar",test_activechar},
+  {"is_protected", test_protected},
+  {"csname_id",    run_get_csname_id},
+  {"csname_name",  run_get_csname_name},
+  {"command_name", run_get_command_name},
+  {"command_id",   run_get_command_id},
+  {NULL, NULL}  /* sentinel */
+};
+
+int luaopen_token (lua_State *L) 
+{
+  luaL_register(L, "token", tokenlib);
+  max_command  = get_max_command();
+  hash_base    = get_hash_base();
+  active_base  = get_active_base();
+  null_cs      = get_nullcs();
+  return 1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/luainit.c b/Build/source/texk/web2c/luatexdir/lua/luainit.c
new file mode 100644
index 00000000000..c76b676c0f4
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/luainit.c
@@ -0,0 +1,520 @@
+#include <sys/stat.h>
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include <luatexdir/luatexextra.h>
+
+#ifndef program_invocation_name
+/*  char *program_invocation_name = NULL; */
+#endif
+
+extern void parse_src_specials_option (char *n) ;
+
+const_string LUATEX_IHELP[] = {
+    "Usage: luatex --lua=FILE [OPTION]... [TEXNAME[.tex]] [COMMANDS]",
+    "   or: luatex --lua=FILE [OPTION]... \\FIRST-LINE",
+    "   or: luatex --lua=FILE [OPTION]... &FMT ARGS",
+    "  Run luaTeX on TEXNAME, usually creating TEXNAME.pdf.",
+    "  Any remaining COMMANDS are processed as luatex input, after TEXNAME is read.",
+    "",
+    "  Alternatively, if the first non-option argument begins with a backslash,",
+    "  interpret all non-option arguments as a line of luatex input.",
+    "",
+    "  Alternatively, if the first non-option argument begins with a &, the",
+    "  next word is taken as the FMT to read, overriding all else.  Any",
+    "  remaining arguments are processed as above.",
+    "",
+    "  If no arguments or options are specified, prompt for input.",
+    "",
+    "  --lua=FILE               the lua initialization file",
+    "  --safer                  disable some easily exploitable lua commands",
+    "  --fmt=FORMAT             load the format file FORMAT",
+    "  --ini                    be initex, for dumping formats",
+    "  --help                   display this help and exit",
+    "  --version                output version information and exit",
+    "",
+    "  Alternate behaviour models can be obtained by special switches",
+    "",
+    "  --luaonly                run a lua file, then exit",
+    "  --luaconly               byte-compile a lua file, then exit",
+    NULL
+};
+
+static void
+prepare_cmdline(lua_State * L, char **argv, int argc, int zero_offset)
+{
+    int i;
+    luaL_checkstack(L, argc + 3, "too many arguments to script");
+    lua_createtable(L, 0, 0);
+    for (i = 0; i < argc; i++) {
+	  lua_pushstring(L, argv[i]);
+	  lua_rawseti(L, -2, (i-zero_offset));
+    }
+    lua_setglobal(L, "arg");
+    return;
+}
+
+extern string dump_name;
+extern const_string c_job_name;
+extern boolean srcspecialsoption;
+extern char *last_source_name;
+extern int last_lineno;
+
+string input_name = NULL;
+
+static string user_progname = NULL;
+
+extern char *ptexbanner;
+extern int program_name_set; /* in lkpselib.c */
+
+/* for topenin() */
+extern char **argv;
+extern int argc;
+
+char *startup_filename = NULL;
+int lua_only = 0;
+int lua_offset = 0;
+
+int safer_option = 0;
+
+/* Reading the options.  */
+
+/* Test whether getopt found an option ``A''.
+   Assumes the option index is in the variable `option_index', and the
+   option table in a variable `long_options'.  */
+#define ARGUMENT_IS(a) STREQ (long_options[option_index].name, a)
+
+/* SunOS cc can't initialize automatic structs, so make this static.  */
+static struct option long_options[]
+ = {  { "fmt",                       1, 0, 0},
+      { "lua",                       1, 0, 0},
+      { "luaonly",                   0, 0, 0},
+      { "safer",                     0, &safer_option, 1},
+      { "help",                      0, 0, 0 },
+      { "ini",                       0, &ini_version, 1 },
+      { "interaction",               1, 0, 0 },
+      { "halt-on-error",             0, &haltonerrorp, 1 },
+      { "kpathsea-debug",            1, 0, 0 },
+      { "progname",                  1, 0, 0 },
+      { "version",                   0, 0, 0 },
+      { "recorder",                  0, &recorder_enabled, 1 },
+      { "etex",                      0, 0, 0 },
+      { "output-comment",            1, 0, 0 },
+      { "output-directory",          1, 0, 0 },
+      { "draftmode",                 0, 0, 0 },
+      { "output-format",             1, 0, 0 },
+      { "shell-escape",              0, &shellenabledp, 1 },
+      { "no-shell-escape",           0, &shellenabledp, -1 },
+      { "debug-format",              0, &debug_format_file, 1 },
+      { "src-specials",              2, 0, 0 },
+      { "file-line-error-style",     0, &filelineerrorstylep, 1 },
+      { "no-file-line-error-style",  0, &filelineerrorstylep, -1 },
+      /* Shorter option names for the above. */
+      { "file-line-error",           0, &filelineerrorstylep, 1 },
+      { "no-file-line-error",        0, &filelineerrorstylep, -1 },
+      { "jobname",                   1, 0, 0 },
+      { "parse-first-line",          0, &parsefirstlinep, 1 },
+      { "no-parse-first-line",       0, &parsefirstlinep, -1 },
+      { "translate-file",            1, 0, 0 },
+      { "default-translate-file",    1, 0, 0 },
+      { "8bit",                      0, 0, 0 },
+      { "mktex",                     1, 0, 0 },
+      { "no-mktex",                  1, 0, 0 },
+{0, 0, 0, 0}
+};
+
+static void
+parse_options(int argc, char **argv)
+{
+  int g;			/* `getopt' return code.  */
+  int option_index;
+  char *firstfile = NULL;
+  opterr = 0;			/* dont whine */
+  for (;;) {
+	g = getopt_long_only(argc, argv, "+", long_options, &option_index);
+	
+	if (g == -1)		/* End of arguments, exit the loop.  */
+	    break;
+	if (g == '?')		/* Unknown option.  */
+	  continue;
+	
+	assert(g == 0);		/* We have no short option names.  */
+	
+	if (ARGUMENT_IS("luaonly")) {
+	  lua_only = 1;
+	  lua_offset = optind;
+	  luainit = 1 ;
+	} else if (ARGUMENT_IS("lua")) {
+	  startup_filename = optarg;
+	  lua_offset = (optind-1);
+	  luainit = 1 ;
+	  
+	} else if (ARGUMENT_IS ("kpathsea-debug")) {
+      kpathsea_debug |= atoi (optarg);
+
+	} else if (ARGUMENT_IS("progname")) {
+	  user_progname = optarg;
+	  
+    } else if (ARGUMENT_IS ("jobname")) {
+      c_job_name = optarg;
+
+	} else if (ARGUMENT_IS("fmt")) {
+	  dump_name = optarg;
+	  
+    } else if (ARGUMENT_IS ("output-directory")) {
+      output_directory = optarg;
+
+    } else if (ARGUMENT_IS ("output-comment")) {
+      unsigned len = strlen (optarg);
+      if (len < 256) {
+        output_comment = optarg;
+      } else {
+        WARNING2 ("Comment truncated to 255 characters from %d. (%s)",
+                  len, optarg);
+        output_comment = (string)xmalloc (256);
+        strncpy (output_comment, optarg, 255);
+        output_comment[255] = 0;
+      }
+
+    } else if (ARGUMENT_IS ("src-specials")) {
+       last_source_name = xstrdup("");
+       /* Option `--src" without any value means `auto' mode. */
+       if (optarg == NULL) {
+         insertsrcspecialeverypar = true;
+         insertsrcspecialauto = true;
+         srcspecialsoption = true;
+         srcspecialsp = true;
+       } else {
+          parse_src_specials_option(optarg);
+       }
+
+    } else if (ARGUMENT_IS ("output-format")) {
+       pdf_output_option = 1;
+       if (strcmp(optarg, "dvi") == 0) {
+         pdf_output_value = 0;
+       } else if (strcmp(optarg, "pdf") == 0) {
+         pdf_output_value = 2;
+       } else {
+         WARNING1 ("Ignoring unknown value `%s' for --output-format", optarg);
+         pdf_output_option = 0;
+       }
+
+    } else if (ARGUMENT_IS ("draftmode")) {
+      pdf_draftmode_option = 1;
+      pdf_draftmode_value = 1;
+
+    } else if (ARGUMENT_IS ("mktex")) {
+      kpse_maketex_option (optarg, true);
+
+    } else if (ARGUMENT_IS ("no-mktex")) {
+      kpse_maketex_option (optarg, false);
+
+    } else if (ARGUMENT_IS ("interaction")) {
+        /* These numbers match @d's in *.ch */
+      if (STREQ (optarg, "batchmode")) {
+        interactionoption = 0;
+      } else if (STREQ (optarg, "nonstopmode")) {
+        interactionoption = 1;
+      } else if (STREQ (optarg, "scrollmode")) {
+        interactionoption = 2;
+      } else if (STREQ (optarg, "errorstopmode")) {
+        interactionoption = 3;
+      } else {
+        WARNING1 ("Ignoring unknown argument `%s' to --interaction", optarg);
+      }
+      
+	} else if (ARGUMENT_IS("help")) {
+	  usagehelp(LUATEX_IHELP, BUG_ADDRESS);
+	  
+	} else if (ARGUMENT_IS("version")) {
+	  char *versions;
+	  initversionstring(&versions); 
+          print_version_banner();
+
+	  puts(
+"\n\nLuaTeX merges and builds upon (parts of) the code from these projects:\n\n"
+"tex       by Donald Knuth\n"
+"etex      by Peter Breitenlohner, Phil Taylor and friends\n"
+"omega     by John Plaice and Yannis Haralambous\n"
+"aleph     by Giuseppe Bilotta\n"
+"pdftex    by Han The Thanh and friends\n"
+"kpathsea  by Karl Berry, Olaf Weber and others\n"
+"lua       by Roberto Ierusalimschy, Waldemar Celes,\n"
+"             Luiz Henrique de Figueiredo\n"
+"metapost  by John Hobby, Taco Hoekwater and friends.\n"
+"xpdf      by Derek Noonberg (partial)\n"
+"fontforge by George Williams (partial)\n\n"
+"Some extensions to lua and additional lua libraries are used, as well as\n"
+"libraries for graphic inclusion. More details can be found in the source.\n"
+"Code development was sponsored by a grant from Colorado State University\n"
+"via the 'oriental tex' project, the TeX User Groups, and donations.\n\n"
+"The LuaTeX team is Hans Hagen, Hartmut Henkel, Taco Hoekwater.\n\n"
+"There is NO warranty. Redistribution of this software is covered by\n"
+"the terms of the GNU General Public License, version 2. For more\n"
+"information about these matters, see the file named COPYING and\n"
+"the LuaTeX source.\n\n"
+"Copyright 2008 Taco Hoekwater, the LuaTeX Team.\n");
+
+	  puts(versions);
+          uexit(0);	  
+	}
+  }
+  /* attempt to find dump_name */
+  if (argv[optind] && argv[optind][0] == '&') {
+	dump_name = strdup(argv[optind] + 1);
+  } else if (argv[optind] && argv[optind][0] != '\\') {
+	if (argv[optind][0] == '*') {
+	  input_name = strdup(argv[optind] + 1);
+	} else {
+	  firstfile = strdup(argv[optind]);
+	  if (lua_only) {
+		startup_filename = firstfile;
+	  }  else {
+		if ((strstr(firstfile,".lua") == firstfile+strlen(firstfile)-4) ||
+			(strstr(firstfile,".luc") == firstfile+strlen(firstfile)-4) ||
+            (strstr(firstfile,".LUA") == firstfile+strlen(firstfile)-4) ||
+			(strstr(firstfile,".LUC") == firstfile+strlen(firstfile)-4) ||
+			(strstr(argv[0],"luatexlua") != NULL) ||
+            (strstr(argv[0],"texlua") != NULL)) {
+		  startup_filename = firstfile;
+		  lua_only = 1;
+		  lua_offset = optind;		  
+		  luainit = 1 ;
+		} else {
+		  input_name = firstfile;
+		}
+	  }
+	}
+  } else {
+	if ((strstr(argv[0],"luatexlua") != NULL)||
+        (strstr(argv[0],"texlua") != NULL)) {
+	  lua_only = 1;
+	  luainit = 1 ;
+	}
+  }
+}
+
+/* test for readability */
+#define is_readable(a) (stat(a,&finfo)==0) && S_ISREG(finfo.st_mode) &&  \
+  (f=fopen(a,"r")) != NULL && !fclose(f)
+
+char *
+find_filename(char *name, char *envkey)
+{
+    struct stat finfo;
+    char *dirname = NULL;
+    char *filename = NULL;
+    FILE *f;
+    if (is_readable(name)) {
+	return name;
+    } else {
+	dirname = getenv(envkey);
+	if ((dirname != NULL) && strlen(dirname)) {
+	    dirname = strdup(getenv(envkey));
+	    if (*(dirname + strlen(dirname) - 1) == '/') {
+		*(dirname + strlen(dirname) - 1) = 0;
+	    }
+	    filename = xmalloc(strlen(dirname) + strlen(name) + 2);
+	    filename = concat3(dirname, "/", name);
+	    if (is_readable(filename)) {
+		xfree(dirname);
+		return filename;
+	    }
+	    xfree(filename);
+	}
+    }
+    return NULL;
+}
+
+
+void 
+init_kpse (void) {
+
+  if (!user_progname) {
+	user_progname = dump_name;
+  } else if (!dump_name) {
+	dump_name = user_progname;
+  }
+  if (!user_progname) {
+	if (ini_version) {
+	  user_progname = input_name;
+	} else {
+	  if(!startup_filename) {
+		if (!dump_name) {
+		  dump_name = strdup(argv[0]);
+		  user_progname = dump_name;
+		}
+	  }
+	}
+  }
+  if (!user_progname) {
+	  fprintf(stdout,
+			  "kpathsea mode needs a --progname or --fmt switch\n");
+	  exit(1);
+  } 
+  kpse_set_program_name(argv[0], user_progname);
+  program_name_set=1;
+}
+
+void
+fix_dumpname (void) {
+  int dist;
+  if (dump_name) {
+	/* adjust array for Pascal and provide extension, if needed */
+	dist = strlen(dump_name) - strlen(DUMP_EXT);
+	if (strstr(dump_name, DUMP_EXT) == dump_name + dist)
+	  DUMP_VAR = concat(" ", dump_name);
+	else
+	  DUMP_VAR = concat3(" ", dump_name, DUMP_EXT);
+	DUMP_LENGTH_VAR = strlen(DUMP_VAR + 1);
+  } else {
+	/* For dump_name to be NULL is a bug.  */
+	if (!ini_version)
+	  abort();
+  }
+}
+
+void
+lua_initialize(int ac, char **av)
+{
+
+  char *given_file = NULL;
+  int kpse_init;
+  int tex_table_id;
+  int pdf_table_id;
+  int token_table_id;
+  int node_table_id;
+  /* Save to pass along to topenin.  */
+  argc = ac;
+  argv = av;
+	
+  ptexbanner = BANNER;
+  program_invocation_name = argv[0];
+
+  /* be 'luac' */
+  if (argc>1 &&
+      (STREQ(argv[0],"texluac") ||
+       STREQ(argv[1],"--luaconly") ||
+       STREQ(argv[1],"--luac"))) {
+    exit(luac_main(ac,av));
+  }
+
+  /* Must be initialized before options are parsed.  */
+  interactionoption = 4;
+  dump_name = NULL;
+  /* parse commandline */
+  parse_options(ac, av);
+
+  /* make sure that the locale is 'sane' (for lua) */
+  putenv("LC_CTYPE=C");
+  putenv("LC_COLLATE=C");
+  putenv("LC_NUMERIC=C");
+
+  /* this is sometimes needed */
+  putenv("engine=luatex");
+
+  luainterpreter(0);
+	  
+  prepare_cmdline(Luas[0], argv, argc, lua_offset);	/* collect arguments */
+
+  if (startup_filename != NULL) {
+    given_file = xstrdup(startup_filename);
+    startup_filename = find_filename(startup_filename, "LUATEXDIR");
+  }
+  /* now run the file */
+  if (startup_filename != NULL) {
+    /* hide the 'tex' and 'pdf' table */
+    tex_table_id = hide_lua_table(Luas[0], "tex");
+    token_table_id = hide_lua_table(Luas[0], "token");
+    node_table_id = hide_lua_table(Luas[0], "node");
+    pdf_table_id = hide_lua_table(Luas[0], "pdf");
+
+    if (luaL_loadfile(Luas[0], startup_filename)) {
+      fprintf(stdout, "%s\n",lua_tostring(Luas[0], -1));
+      exit(1);
+    }
+    if (lua_pcall(Luas[0], 0, 0, 0)) {
+      fprintf(stdout, "%s\n",lua_tostring(Luas[0], -1));
+      exit(1);
+    }
+    /* no filename? quit now! */
+    if (!input_name) {
+      get_lua_string("texconfig", "jobname", &input_name);
+    }
+    if (!dump_name) {
+      get_lua_string("texconfig", "formatname", &dump_name);
+    }
+    if ((lua_only) || ((!input_name) && (!dump_name))) {
+      exit(0);
+    }
+    /* unhide the 'tex' and 'pdf' table */
+    unhide_lua_table(Luas[0], "tex", tex_table_id);
+    unhide_lua_table(Luas[0], "pdf", pdf_table_id);
+    unhide_lua_table(Luas[0], "token", token_table_id);
+    unhide_lua_table(Luas[0], "node", node_table_id);
+	  
+    /* kpse_init */
+    kpse_init = -1;
+    get_lua_boolean("texconfig", "kpse_init", &kpse_init);
+
+    if (kpse_init != 0) {
+      init_kpse();
+    }
+    /* prohibit_file_trace (boolean) */
+    tracefilenames = 1;
+    get_lua_boolean("texconfig", "trace_file_names", &tracefilenames);
+	  
+    /* src_special_xx */
+    insertsrcspecialauto = insertsrcspecialeverypar =
+      insertsrcspecialeveryparend = insertsrcspecialeverycr =
+      insertsrcspecialeverymath = insertsrcspecialeveryhbox =
+      insertsrcspecialeveryvbox = insertsrcspecialeverydisplay =
+      false;
+    get_lua_boolean("texconfig", "src_special_auto",
+		    &insertsrcspecialauto);
+    get_lua_boolean("texconfig", "src_special_everypar",
+		    &insertsrcspecialeverypar);
+    get_lua_boolean("texconfig", "src_special_everyparend",
+		    &insertsrcspecialeveryparend);
+    get_lua_boolean("texconfig", "src_special_everycr",
+		    &insertsrcspecialeverycr);
+    get_lua_boolean("texconfig", "src_special_everymath",
+		    &insertsrcspecialeverymath);
+    get_lua_boolean("texconfig", "src_special_everyhbox",
+		    &insertsrcspecialeveryhbox);
+    get_lua_boolean("texconfig", "src_special_everyvbox",
+		    &insertsrcspecialeveryvbox);
+    get_lua_boolean("texconfig", "src_special_everydisplay",
+		    &insertsrcspecialeverydisplay);
+
+    srcspecialsp = insertsrcspecialauto | insertsrcspecialeverypar |
+      insertsrcspecialeveryparend | insertsrcspecialeverycr |
+      insertsrcspecialeverymath | insertsrcspecialeveryhbox |
+      insertsrcspecialeveryvbox | insertsrcspecialeverydisplay;
+
+    /* file_line_error */
+    filelineerrorstylep = false;
+    get_lua_boolean("texconfig", "file_line_error",
+		    &filelineerrorstylep);
+
+    /* halt_on_error */
+    haltonerrorp = false;
+    get_lua_boolean("texconfig", "halt_on_error", &haltonerrorp);
+	  
+    fix_dumpname();
+  } else {
+    if (luainit) {
+      if (given_file) {
+	fprintf(stdout, "%s file %s not found\n", (lua_only ? "Script" : "Configuration"), given_file);
+      } else {
+	fprintf(stdout, "No %s file given\n", (lua_only ? "script" : "configuration"));
+      }
+      exit(1);
+    } else {
+      /* init */
+      init_kpse();
+      fix_dumpname();
+    }
+  }
+}
diff --git a/Build/source/texk/web2c/luatexdir/lua/luanode.c b/Build/source/texk/web2c/luatexdir/lua/luanode.c
new file mode 100644
index 00000000000..17c8e7be8e2
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/luanode.c
@@ -0,0 +1,200 @@
+/* $Id: luanode.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+#undef link /* defined by cpascal.h */
+#define info(a)    fixmem[(a)].hhlh
+#define link(a)    fixmem[(a)].hhrh
+
+
+static char *group_code_names[] = {
+  "",
+  "simple",
+  "hbox",
+  "adjusted_hbox",
+  "vbox",
+  "vtop",
+  "align",
+  "no_align",
+  "output",
+  "math",
+  "disc",
+  "insert",
+  "vcenter",
+  "math_choice",
+  "semi_simple",
+  "math_shift",
+  "math_left",
+  "local_box" ,
+  "split_off",
+  "split_keep",
+  "preamble",
+  "align_set",
+  "fin_row"};
+
+char *pack_type_name[] = { "exactly", "additional"};
+
+
+void
+lua_node_filter_s (int filterid, char *extrainfo, halfword head_node, halfword *tail_node) {
+  halfword ret;  
+  int a;
+  lua_State *L = Luas[0];
+  int callback_id = callback_defined(filterid);
+  if (head_node==null || vlink(head_node)==null || callback_id==0)
+    return;
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1, callback_id);
+  if (!lua_isfunction(L,-1)) {
+    lua_pop(L,2);
+    return;
+  }
+  nodelist_to_lua(L,vlink(head_node)); /* arg 1 */
+  lua_pushstring(L,extrainfo);         /* arg 2 */
+  if (lua_pcall(L,2,1,0) != 0) { /* no arg, 1 result */
+    fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+    lua_pop(L,2);
+    error();
+    return;
+  }
+  if (lua_isboolean(L,-1)) {
+    if (lua_toboolean(L,-1)!=1) {
+      flush_node_list(vlink(head_node));
+      vlink(head_node) = null;
+    }
+  } else {
+    a = nodelist_from_lua(L);
+    vlink(head_node)= a;
+  }
+  lua_pop(L,2); /* result and callback container table */
+  if (fix_node_lists)
+	fix_node_list(head_node);
+  ret = vlink(head_node); 
+  if (ret!=null) {
+    while (vlink(ret)!=null)
+      ret=vlink(ret); 
+    *tail_node=ret;
+  } else {
+    *tail_node=head_node;
+  }
+  return ;
+}
+
+void
+lua_node_filter (int filterid, int extrainfo, halfword head_node, halfword *tail_node) {
+  lua_node_filter_s(filterid, group_code_names[extrainfo], head_node, tail_node);
+  return ;
+}
+
+
+
+halfword
+lua_hpack_filter (halfword head_node, scaled size, int pack_type, int extrainfo) {
+  halfword ret;  
+  lua_State *L = Luas[0];
+  int callback_id = callback_defined(hpack_filter_callback);
+  if (head_node==null || callback_id == 0)
+    return head_node;
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1, callback_id);
+  if (!lua_isfunction(L,-1)) {
+    lua_pop(L,2);
+    return head_node;
+  }
+
+  nodelist_to_lua(L,head_node);
+  lua_pushstring(L,group_code_names[extrainfo]);
+  lua_pushnumber(L,size);
+  lua_pushstring(L,pack_type_name[pack_type]);
+  if (lua_pcall(L,4,1,0) != 0) { /* no arg, 1 result */
+    fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+    lua_pop(L,2);
+    error();
+    return head_node;
+  }
+  ret = head_node;
+  if (lua_isboolean(L,-1)) {
+    if (lua_toboolean(L,-1)!=1) {
+      flush_node_list(head_node);
+      ret = null;
+    }
+  } else {
+    ret = nodelist_from_lua(L);
+  }
+  lua_pop(L,2); /* result and callback container table */
+  /*  lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);*/
+  if (fix_node_lists)
+	fix_node_list(ret);
+  return ret;
+}
+
+halfword
+lua_vpack_filter (halfword head_node, scaled size, int pack_type, scaled maxd, int extrainfo) {
+  halfword ret;  
+  integer callback_id ; 
+  lua_State *L = Luas[0];
+  if (head_node==null)
+	return head_node;
+  if (strcmp("output",group_code_names[extrainfo])==0) {
+    callback_id = callback_defined(pre_output_filter_callback);
+  } else {
+    callback_id = callback_defined(vpack_filter_callback);
+  }
+  if (callback_id==0) {
+    return head_node;
+  }
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  lua_rawgeti(L,-1, callback_id);
+  if (!lua_isfunction(L,-1)) {
+    lua_pop(L,2);
+    return head_node;
+  }
+  nodelist_to_lua(L,head_node);
+  lua_pushstring(L,group_code_names[extrainfo]);
+  lua_pushnumber(L,size);
+  lua_pushstring(L,pack_type_name[pack_type]);
+  lua_pushnumber(L,maxd);
+  if (lua_pcall(L,5,1,0) != 0) { /* no arg, 1 result */
+    fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+    lua_pop(L,2);
+    error();
+    return head_node;
+  }
+  ret = head_node;
+  if (lua_isboolean(L,-1)) {
+    if (lua_toboolean(L,-1)!=1) {
+      flush_node_list(head_node);
+      ret = null;
+    }
+  } else {
+    ret = nodelist_from_lua(L);
+  }
+  lua_pop(L,2); /* result and callback container table */
+  /*  lua_gc(L,LUA_GCSTEP, LUA_GC_STEP_SIZE);*/
+  if (fix_node_lists)
+	fix_node_list(ret);
+  return ret;
+}
+
+
+/* This is a quick hack to fix etex's \lastnodetype now that
+ * there are many more visible node types. TODO: check the
+ * eTeX manual for the expected return values.
+ */
+
+int 
+visible_last_node_type (int n) {
+  int i = type(n);
+  if ((i!=math_node) && (i<=unset_node))  
+    return i+1;
+  if (i==glyph_node)
+    return -1; 
+  if (i==whatsit_node && subtype(n)==local_par_node)
+    return -1;  
+  if (i==255)
+    return -1 ; /* this is not right, probably dir nodes! */
+  return last_known_node +1 ;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/luastuff.c b/Build/source/texk/web2c/luatexdir/lua/luastuff.c
new file mode 100644
index 00000000000..f48bfdb0171
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/luastuff.c
@@ -0,0 +1,310 @@
+/* $Id: luastuff.c 1079 2008-03-05 15:34:41Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+lua_State *Luas[65536];
+
+extern char *startup_filename;
+extern int safer_option;
+
+int luastate_max = 0;
+int luastate_bytes = 0;
+
+void
+make_table (lua_State *L, char *tab, char *getfunc, char *setfunc) {
+  /* make the table */            /* [{<tex>}] */
+  lua_pushstring(L,tab);          /* [{<tex>},"dimen"] */
+  lua_newtable(L);                /* [{<tex>},"dimen",{}] */
+  lua_settable(L, -3);            /* [{<tex>}] */
+  /* fetch it back */
+  lua_pushstring(L,tab);          /* [{<tex>},"dimen"] */
+  lua_gettable(L, -2);            /* [{<tex>},{<dimen>}] */
+  /* make the meta entries */
+  luaL_newmetatable(L,tab);       /* [{<tex>},{<dimen>},{<dimen_m>}] */
+  lua_pushstring(L, "__index");   /* [{<tex>},{<dimen>},{<dimen_m>},"__index"] */
+  lua_pushstring(L, getfunc);     /* [{<tex>},{<dimen>},{<dimen_m>},"__index","getdimen"] */
+  lua_gettable(L, -5);            /* [{<tex>},{<dimen>},{<dimen_m>},"__index",<tex.getdimen>]  */
+  lua_settable(L, -3);            /* [{<tex>},{<dimen>},{<dimen_m>}]  */
+  lua_pushstring(L, "__newindex");/* [{<tex>},{<dimen>},{<dimen_m>},"__newindex"] */
+  lua_pushstring(L, setfunc);     /* [{<tex>},{<dimen>},{<dimen_m>},"__newindex","setdimen"] */
+  lua_gettable(L, -5);            /* [{<tex>},{<dimen>},{<dimen_m>},"__newindex",<tex.setdimen>]  */
+  lua_settable(L, -3);            /* [{<tex>},{<dimen>},{<dimen_m>}]  */ 
+  lua_setmetatable(L,-2);         /* [{<tex>},{<dimen>}] : assign the metatable */
+  lua_pop(L,1);                   /* [{<tex>}] : clean the stack */
+}
+
+static 
+const char *getS(lua_State * L, void *ud, size_t * size) {
+    LoadS *ls = (LoadS *) ud;
+    (void) L;
+    if (ls->size == 0)
+        return NULL;
+    *size = ls->size;
+    ls->size = 0;
+    return ls->s;
+}
+
+void *my_luaalloc (void *ud, void *ptr, size_t osize, size_t nsize) {
+  void *ret = NULL;
+  if (nsize == 0)
+	free(ptr);
+  else
+	ret = realloc(ptr, nsize);
+  luastate_bytes += (nsize-osize);
+  return ret;
+}
+
+static int my_luapanic (lua_State *L) {
+  (void)L;  /* to avoid warnings */
+  fprintf(stderr, "PANIC: unprotected error in call to Lua API (%s)\n",
+                   lua_tostring(L, -1));
+  return 0;
+}
+
+
+void 
+luainterpreter (int n) {
+  lua_State *L;
+  L = lua_newstate(my_luaalloc, NULL);
+  if (L==NULL) {
+	fprintf(stderr,"Can't create a new Lua state (%d).",n);
+	return;
+  }
+  lua_atpanic(L, &my_luapanic);
+
+  luastate_max++;
+  luaL_openlibs(L);
+
+  open_oslibext(L,safer_option);
+
+  lua_getglobal(L,"package");
+  lua_pushstring(L,"");
+  lua_setfield(L,-2,"cpath");
+  lua_pop(L,1); /* pop the table */
+
+  /*luaopen_unicode(L);*/
+  lua_pushcfunction(L, luaopen_unicode);
+  lua_pushstring(L, "unicode");
+  lua_call(L, 1, 0);
+
+  /*luaopen_zip(L);*/
+  lua_pushcfunction(L, luaopen_zip);
+  lua_pushstring(L, "zip");
+  lua_call(L, 1, 0);
+
+  /*luaopen_lpeg(L);*/
+  lua_pushcfunction(L, luaopen_lpeg);
+  lua_pushstring(L, "lpeg");
+  lua_call(L, 1, 0);
+
+  /*luaopen_md5(L);*/
+  lua_pushcfunction(L, luaopen_md5);
+  lua_pushstring(L, "md5");
+  lua_call(L, 1, 0);
+
+  /*luaopen_lfs(L);*/
+  lua_pushcfunction(L, luaopen_lfs);
+  lua_pushstring(L, "lfs");
+  lua_call(L, 1, 0);
+
+  /* zlib. slightly odd calling convention */
+  luaopen_zlib(L);
+  lua_setglobal(L,"zlib");
+  luaopen_gzip(L);
+  /* fontforge */
+  luaopen_ff(L);
+
+  luaopen_pdf(L);
+  luaopen_tex(L);
+  luaopen_token(L);
+  luaopen_node(L);
+  luaopen_texio(L);
+  luaopen_kpse(L);
+  if (n==0) {
+    luaopen_callback(L);
+    lua_createtable(L, 0, 0);
+    lua_setglobal(L, "texconfig");
+  }
+  luaopen_lua(L,n,startup_filename);
+  luaopen_stats(L);
+  luaopen_font(L);
+  luaopen_lang(L);
+
+  /* luaopen_img(L); */
+  lua_pushcfunction(L, luaopen_img);
+  lua_pushstring(L, "img");
+  lua_call(L, 1, 0);
+  
+  luaopen_mp(L);
+
+  if (safer_option) {
+	/* disable some stuff if --safer */
+	(void)hide_lua_value(L, "os","execute");
+	(void)hide_lua_value(L, "os","rename");
+	(void)hide_lua_value(L, "os","remove");
+	(void)hide_lua_value(L, "io","popen");
+	/* make io.open only read files */
+	luaL_checkstack(L,2,"out of stack space");
+	lua_getglobal(L,"io");
+	lua_getfield(L,-1,"open_ro");	
+	lua_setfield(L,-2,"open");	
+	(void)hide_lua_value(L, "io","tmpfile");
+	(void)hide_lua_value(L, "io","output");
+	(void)hide_lua_value(L, "lfs","chdir");
+	(void)hide_lua_value(L, "lfs","lock");
+	(void)hide_lua_value(L, "lfs","touch");
+	(void)hide_lua_value(L, "lfs","rmdir");
+	(void)hide_lua_value(L, "lfs","mkdir");
+  }
+  Luas[n] = L;
+}
+
+int hide_lua_table(lua_State *L, char *name) {
+  int r=0;
+  lua_getglobal(L,name);
+  if(lua_istable(L,-1)) {
+    r = luaL_ref(L,LUA_REGISTRYINDEX);
+    lua_pushnil(L);
+    lua_setglobal(L,name);
+  }
+  return r;
+}
+
+void unhide_lua_table(lua_State *L, char *name, int r) {
+  lua_rawgeti(L,LUA_REGISTRYINDEX,r);
+  lua_setglobal(L,name);
+  luaL_unref(L,LUA_REGISTRYINDEX,r);
+}
+
+int hide_lua_value(lua_State *L, char *name, char *item) {
+  int r=0;
+  lua_getglobal(L,name);
+  if(lua_istable(L,-1)) {
+	lua_getfield(L,-1,item);
+    r = luaL_ref(L,LUA_REGISTRYINDEX);
+    lua_pushnil(L);
+    lua_setfield(L,-2,item);
+  }
+  return r;
+}
+
+void unhide_lua_value(lua_State *L, char *name, char *item, int r) {
+  lua_getglobal(L,name);
+  if(lua_istable(L,-1)) {
+	lua_rawgeti(L,LUA_REGISTRYINDEX,r);
+	lua_setfield(L,-2,item);
+	luaL_unref(L,LUA_REGISTRYINDEX,r);
+  }
+}
+
+
+void 
+luacall(int n, int s) {
+  LoadS ls;
+  int i ;
+  char lua_id[12];
+  if (Luas[n] == NULL) {
+    luainterpreter(n);
+  }
+  luatex_load_init(s,&ls);
+  if (ls.size>0) {
+	snprintf((char *)lua_id,12,"luas[%d]",n);
+	i = lua_load(Luas[n], getS, &ls, lua_id);
+	if (i != 0) {
+	  Luas[n] = luatex_error(Luas[n],(i == LUA_ERRSYNTAX ? 0 : 1));
+	} else {
+	  i = lua_pcall(Luas[n], 0, 0, 0);
+	  if (i != 0) {
+		Luas[n] = luatex_error(Luas[n],(i == LUA_ERRRUN ? 0 : 1));
+	  }	 
+	}
+  }
+}
+
+void 
+luatokencall(int n, int p) {
+  LoadS ls;
+  int i, l;
+  char *s=NULL;
+  char lua_id[12];
+  if (Luas[n] == NULL) {
+    luainterpreter(n);
+  }
+  l = 0;
+  s = tokenlist_to_cstring(p,1,&l);
+  ls.s = s;
+  ls.size = l;
+  if (ls.size>0) {
+	snprintf((char *)lua_id,12,"luas[%d]",n);
+	i = lua_load(Luas[n], getS, &ls, lua_id);
+	xfree(s);
+	if (i != 0) {
+	  Luas[n] = luatex_error(Luas[n],(i == LUA_ERRSYNTAX ? 0 : 1));
+	} else {
+	  i = lua_pcall(Luas[n], 0, 0, 0);
+	  if (i != 0) {
+		Luas[n] = luatex_error(Luas[n],(i == LUA_ERRRUN ? 0 : 1));
+	  }	 
+	}
+  }
+}
+
+
+
+void 
+closelua(int n) {
+  if (n!=0 && Luas[n] != NULL) {
+    lua_close(Luas[n]);
+	luastate_max--;
+    Luas[n] = NULL;
+  }
+}
+
+
+void 
+luatex_load_init (int s, LoadS *ls) {
+  ls->s = (const char *)&(str_pool[str_start[s]]);
+  ls->size = str_start[s + 1] - str_start[s];
+}
+
+lua_State *
+luatex_error (lua_State * L, int is_fatal) {
+
+  size_t len;
+  char *err;
+  strnumber s;
+  const char *luaerr = lua_tolstring(L, -1,&len);
+  err = (char *)xmalloc(len+1);
+  len = snprintf(err,(len+1),"%s",luaerr);
+  if (is_fatal>0) {
+    /* Normally a memory error from lua. 
+       The pool may overflow during the maketexlstring(), but we 
+       are crashing anyway so we may as well abort on the pool size */
+    s = maketexlstring(err, len);
+    lua_fatal_error(s);
+    /* never reached */
+    xfree (err);
+    lua_close(L);
+	luastate_max--;
+    return (lua_State *)NULL;
+  } else {
+    /* Here, the pool could be full already, but we can possibly escape from that 
+     * condition, since the lua chunk that caused the error is the current string.
+     */
+    s = str_ptr-0x200000;
+    /*    fprintf(stderr,"poolinfo: %d: %d,%d out of %d\n",s,pool_ptr,str_start[(s-1)],pool_size);*/
+    pool_ptr = str_start[(s-1)];
+    str_start[s] = pool_ptr;
+    if (pool_ptr+len>=pool_size) {
+      lua_norm_error(' ');
+    } else {
+      s = maketexlstring(err,len);
+      lua_norm_error(s);
+      flush_str(s);
+    }
+    xfree (err);
+    return L;
+  }
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/luatex.c b/Build/source/texk/web2c/luatexdir/lua/luatex.c
new file mode 100644
index 00000000000..5172ca24292
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/luatex.c
@@ -0,0 +1,343 @@
+/* $Id: luatex.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include <zlib.h>
+
+/* do this aleph stuff here, for now */
+
+void
+b_test_in(void)
+{
+  string fname = kpse_find_file ((char *)(nameoffile + 1), 
+				   kpse_program_binary_format, true);
+
+    if (fname) {
+      libcfree(nameoffile);
+      nameoffile = xmalloc(2+strlen(fname));
+      namelength = strlen(fname);
+      strcpy((char *)nameoffile+1, fname);
+    }
+    else {
+      libcfree(nameoffile);
+      nameoffile = xmalloc(2);
+      namelength = 0;
+      nameoffile[0] = 0;
+      nameoffile[1] = 0;
+    }
+}
+ 
+
+int **ocp_tables;
+static int ocp_entries = 0;
+
+void
+allocate_ocp_table P2C(int, ocp_number, int, ocp_size)
+{
+    int i;
+    if (ocp_entries==0) {
+      ocp_tables = (int **) xmalloc(256*sizeof(int**));
+      ocp_entries=256;
+    } else if ((ocp_number==256)&&(ocp_entries==256)) {
+      ocp_tables = xrealloc(ocp_tables, 65536);
+      ocp_entries=65536;
+    }
+    ocp_tables[ocp_number] =
+       (int *) xmalloc((1+ocp_size)*sizeof(int));
+    ocp_tables[ocp_number][0] = ocp_size;
+    for (i=1; i<=ocp_size; i++) {
+        ocp_tables[ocp_number][i]  = 0;
+    }
+}
+
+void
+dump_ocp_table P1C(int, ocp_number)
+{
+    dump_things(ocp_tables[ocp_number][0], ocp_tables[ocp_number][0]+1);
+}
+
+void
+undump_ocp_table P1C(int, ocp_number)
+{
+    int sizeword;
+    if (ocp_entries==0) {
+      ocp_tables = (int **) xmalloc(256*sizeof(int**));
+      ocp_entries=256;
+    } else if ((ocp_number==256)&&(ocp_entries==256)) {
+      ocp_tables = xrealloc(ocp_tables, 65536);
+      ocp_entries=65536;
+    }
+    undump_things(sizeword,1);
+    ocp_tables[ocp_number] =
+        (int *) xmalloc((1+sizeword)*sizeof(int));
+    ocp_tables[ocp_number][0] = sizeword;
+    undump_things(ocp_tables[ocp_number][1], sizeword);
+}
+
+
+void
+run_external_ocp P1C(string, external_ocp_name)
+{
+  char *in_file_name;
+  char *out_file_name;
+  FILE *in_file;
+  FILE *out_file;
+  char command_line[400];
+  int i;
+  unsigned c;
+  int c_in;
+#ifdef WIN32
+  char *tempenv;
+
+#define null_string(s) ((s == NULL) || (*s == '\0'))
+
+  tempenv = getenv("TMPDIR");
+  if (null_string(tempenv))
+    tempenv = getenv("TEMP");
+  if (null_string(tempenv))
+    tempenv = getenv("TMP");
+  if (null_string(tempenv))
+    tempenv = "c:/tmp";	/* "/tmp" is not good if we are on a CD-ROM */
+  in_file_name = concat(tempenv, "/__aleph__in__XXXXXX");
+  mktemp(in_file_name);
+#else
+  in_file_name = strdup("/tmp/__aleph__in__XXXXXX");
+  mkstemp(in_file_name);
+#endif /* WIN32 */
+
+  in_file = fopen(in_file_name, FOPEN_WBIN_MODE);
+  
+  for (i=1; i<=otp_input_end; i++) {
+      c = otp_input_buf[i];
+      if (c>0xffff) {
+          fprintf(stderr, "Aleph does not currently support 31-bit chars\n");
+          exit(1);
+      }
+      if (c>0x4000000) {
+          fputc(0xfc | ((c>>30) & 0x1), in_file);
+          fputc(0x80 | ((c>>24) & 0x3f), in_file);
+          fputc(0x80 | ((c>>18) & 0x3f), in_file);
+          fputc(0x80 | ((c>>12) & 0x3f), in_file);
+          fputc(0x80 | ((c>>6) & 0x3f), in_file);
+          fputc(0x80 | (c & 0x3f), in_file);
+      } else if (c>0x200000) {
+          fputc(0xf8 | ((c>>24) & 0x3), in_file);
+          fputc(0x80 | ((c>>18) & 0x3f), in_file);
+          fputc(0x80 | ((c>>12) & 0x3f), in_file);
+          fputc(0x80 | ((c>>6) & 0x3f), in_file);
+          fputc(0x80 | (c & 0x3f), in_file);
+      } else if (c>0x10000) {
+          fputc(0xf0 | ((c>>18) & 0x7), in_file);
+          fputc(0x80 | ((c>>12) & 0x3f), in_file);
+          fputc(0x80 | ((c>>6) & 0x3f), in_file);
+          fputc(0x80 | (c & 0x3f), in_file);
+      } else if (c>0x800) {
+          fputc(0xe0 | ((c>>12) & 0xf), in_file);
+          fputc(0x80 | ((c>>6) & 0x3f), in_file);
+          fputc(0x80 | (c & 0x3f), in_file);
+      } else if (c>0x80) {
+          fputc(0xc0 | ((c>>6) & 0x1f), in_file);
+          fputc(0x80 | (c & 0x3f), in_file);
+      } else {
+          fputc(c & 0x7f, in_file);
+      }
+  }
+  fclose(in_file);
+  
+#define advance_cin if ((c_in = fgetc(out_file)) == -1) { \
+                         fprintf(stderr, "File contains bad char\n"); \
+                         goto end_of_while; \
+                    }
+                     
+#ifdef WIN32
+  out_file_name = concat(tempenv, "/__aleph__out__XXXXXX");
+  mktemp(out_file_name);
+#else
+  out_file_name = strdup("/tmp/__aleph__out__XXXXXX");
+  mkstemp(out_file_name);
+#endif
+
+  sprintf(command_line, "%s <%s >%s\n",
+          external_ocp_name+1, in_file_name, out_file_name);
+  system(command_line);
+  out_file = fopen(out_file_name, FOPEN_RBIN_MODE);
+  otp_output_end = 0;
+  otp_output_buf[otp_output_end] = 0;
+  while ((c_in = fgetc(out_file)) != -1) {
+     if (c_in>=0xfc) {
+         c = (c_in & 0x1)   << 30;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 24;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 18;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 12;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 6;
+         {advance_cin}
+         c |= c_in & 0x3f;
+     } else if (c_in>=0xf8) {
+         c = (c_in & 0x3) << 24;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 18;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 12;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 6;
+         {advance_cin}
+         c |= c_in & 0x3f;
+     } else if (c_in>=0xf0) {
+         c = (c_in & 0x7) << 18;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 12;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 6;
+         {advance_cin}
+         c |= c_in & 0x3f;
+     } else if (c_in>=0xe0) {
+         c = (c_in & 0xf) << 12;
+         {advance_cin}
+         c |= (c_in & 0x3f) << 6;
+         {advance_cin}
+         c |= c_in & 0x3f;
+     } else if (c_in>=0x80) {
+         c = (c_in & 0x1f) << 6;
+         {advance_cin}
+         c |= c_in & 0x3f;
+     } else {
+         c = c_in & 0x7f;
+     }
+     otp_output_buf[++otp_output_end] = c;
+  }
+
+end_of_while:
+  remove(in_file_name);
+  remove(out_file_name);
+}
+
+/* Read and write dump files through zlib */
+
+/* Earlier versions recast *f from FILE * to gzFile, but there is
+ * no guarantee that these have the same size, so a static variable 
+ * is needed.
+ */
+
+static gzFile gz_fmtfile = NULL;
+
+void
+do_zdump (char *p,  int item_size,  int nitems, FILE *out_file)
+{
+  int err;
+  if (nitems==0)
+	return;
+  if (gzwrite (gz_fmtfile,(void *)p, item_size*nitems) != item_size*nitems)
+    {
+      fprintf (stderr, "! Could not write %d %d-byte item(s): %s.\n",
+               nitems, item_size, gzerror(gz_fmtfile,&err));
+      uexit (1);
+    }
+}
+
+void
+do_zundump (char *p,  int item_size,  int nitems, FILE *in_file)
+{
+  int err;
+  if (nitems==0)
+	return;
+  if (gzread (gz_fmtfile,(void *)p, item_size*nitems) <= 0) 
+	{
+	  fprintf (stderr, "Could not undump %d %d-byte item(s): %s.\n",
+			   nitems, item_size, gzerror(gz_fmtfile,&err));
+	  uexit (1);
+	}
+}
+
+#define COMPRESSION "R3"
+
+boolean 
+zopen_w_input (FILE **f, int format, const_string fopen_mode) {
+  int callbackid;
+  int res;
+  char *fnam;
+  callbackid = callback_defined(find_format_file_callback);
+  if (callbackid>0) {
+	res = run_callback(callbackid,"S->S",(nameoffile+1),&fnam);
+	if (res && fnam && strlen(fnam)>0) {
+	  xfree (nameoffile);
+	  nameoffile = xmalloc (strlen(fnam)+2);
+	  memcpy((nameoffile+1),fnam,strlen(fnam));
+	  *(nameoffile+strlen(fnam)+1)=0;
+	  *f = xfopen(fnam,fopen_mode);
+	  if (*f == NULL) {
+		return 0;
+	  }
+	} else {
+	  return 0;
+	}
+  } else {
+	res = open_input(f,format,fopen_mode);
+  }
+  if (res) {
+	gz_fmtfile = gzdopen(fileno(*f),"rb" COMPRESSION);
+  }
+  return res;
+}
+
+boolean 
+zopen_w_output (FILE **f, const_string fopen_mode) {
+  int res = 1;
+  if (luainit) {
+    *f = fopen((nameoffile+1),fopen_mode);
+    if (*f == NULL) {
+      return 0;
+    }
+  } else {
+    res =  open_output(f,fopen_mode);
+  }
+  if (res) {
+	gz_fmtfile = gzdopen(fileno(*f),"wb" COMPRESSION);
+  }
+  return res;
+}
+
+void 
+zwclose (FILE *f) { 
+  gzclose(gz_fmtfile); 
+}
+
+/* create the dvi or pdf file */
+
+int
+open_outfile(FILE **f, char *name, char *mode) {
+  FILE *res;
+  res = fopen(name,mode);
+  if (res != NULL) {
+	*f = res;
+	return 1;
+  }
+  return 0;
+}
+
+
+/* the caller sets tfm_buffer=NULL and tfm_size=0 */
+
+int
+readbinfile (FILE *f, unsigned char **tfm_buffer, integer *tfm_size) {
+  void *buf;
+  int size;
+  if (fseek(f, 0, SEEK_END)==0) {
+    size = ftell(f);
+    if (size>0) {
+      buf = xmalloc(size); 
+      if(fseek(f, 0, SEEK_SET)==0) {
+	if(fread((void *)buf,size,1,f)==1) {
+	  *tfm_buffer=(unsigned char *)buf;
+	  *tfm_size=(integer)size;
+	  return 1;
+	} 
+      }
+    }
+  } /* seek failed, or zero-sized file */
+  return 0;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/luatoken.c b/Build/source/texk/web2c/luatexdir/lua/luatoken.c
new file mode 100644
index 00000000000..23d9ca82150
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/luatoken.c
@@ -0,0 +1,548 @@
+/* $Id: luatoken.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "tokens.h"
+
+command_item command_names[] = 
+  { { "relax", 0, NULL },
+    { "left_brace", 0 , NULL },
+    { "right_brace", 0 , NULL },
+    { "math_shift", 0 , NULL },
+    { "tab_mark", 0 , NULL },
+    { "car_ret", 0 , NULL },
+    { "mac_param", 0 , NULL },
+    { "sup_mark", 0 , NULL },
+    { "sub_mark", 0 , NULL },
+    { "endv", 0 , NULL },
+    { "spacer", 0 , NULL },
+    { "letter", 0 , NULL },
+    { "other_char", 0 , NULL },
+    { "par_end", 0 , NULL },
+    { "stop", 0 , NULL },
+    { "delim_num", 0 , NULL  },
+    { "char_num", 0 , NULL },
+    { "math_char_num", 0 , NULL },
+    { "mark", 0 , NULL  },
+    { "xray", 0 , NULL },
+    { "make_box", 0 , NULL },
+    { "hmove", 0 , NULL },
+    { "vmove", 0 , NULL },
+    { "un_hbox", 0 , NULL },
+    { "un_vbox", 0 , NULL },
+    { "remove_item", 0 , NULL },
+    { "hskip", 0 , NULL },
+    { "vskip", 0 , NULL },
+    { "mskip", 0 , NULL },
+    { "kern", 0 , NULL },
+    { "mkern", 0 , NULL },
+    { "leader_ship", 0 , NULL },
+    { "halign", 0 , NULL },
+    { "valign", 0 , NULL },
+    { "no_align", 0 , NULL  },
+    { "vrule", 0 , NULL },
+    { "hrule", 0 , NULL },
+    { "insert", 0 , NULL },
+    { "vadjust", 0 , NULL },
+    { "ignore_spaces", 0 , NULL },
+    { "after_assignment", 0 , NULL },
+    { "after_group", 0 , NULL },
+    { "break_penalty", 0 , NULL  },
+    { "start_par", 0 , NULL },
+    { "ital_corr", 0 , NULL },
+    { "accent", 0 , NULL },
+    { "math_accent", 0 , NULL },
+    { "discretionary", 0 , NULL },
+    { "eq_no", 0 , NULL },
+    { "left_right", 0 , NULL },
+    { "math_comp", 0 , NULL },
+    { "limit_switch", 0 , NULL },
+    { "above", 0 , NULL },
+    { "math_style", 0 , NULL },
+    { "math_choice", 0 , NULL },
+    { "non_script", 0 , NULL },
+    { "vcenter", 0 , NULL },
+    { "case_shift", 0 , NULL },
+    { "message", 0 , NULL },
+    { "extension", 0 , NULL },
+    { "in_stream", 0 , NULL },
+    { "begin_group", 0 , NULL },
+    { "end_group", 0 , NULL },
+    { "omit", 0 , NULL },
+    { "ex_space", 0 , NULL },
+    { "no_boundary", 0 , NULL },
+    { "radical", 0 , NULL },
+    { "end_cs_name", 0 , NULL },
+    { "char_ghost", 0 , NULL },
+    { "assign_local_box", 0 , NULL },
+    { "char_given", 0 , NULL },
+    { "math_given", 0 , NULL },
+    { "omath_given", 0 , NULL },
+    { "last_item", 0 , NULL },
+    { "toks_register", 0 , NULL },
+    { "assign_toks", 0, NULL },
+    { "assign_int", 0, NULL },
+    { "assign_dimen", 0 , NULL },
+    { "assign_glue", 0 ,NULL },
+    { "assign_mu_glue", 0 , NULL },
+    { "assign_font_dimen", 0 , NULL },
+    { "assign_font_int", 0 , NULL },
+    { "set_aux", 0 , NULL },
+    { "set_prev_graf", 0 , NULL },
+    { "set_page_dimen", 0 , NULL },
+    { "set_page_int", 0 , NULL },
+    { "set_box_dimen", 0 , NULL },
+    { "set_shape", 0, NULL },
+    { "def_code", 0 , NULL },
+    { "extdef_code", 0 , NULL },
+    { "def_family", 0 , NULL },
+    { "set_font", 0 , NULL },
+    { "def_font", 0 , NULL },
+    { "register", 0 , NULL },
+    { "assign_box_dir", 0 , NULL },
+    { "assign_dir", 0 , NULL },
+    { "advance", 0 , NULL },
+    { "multiply", 0 , NULL },
+    { "divide", 0 , NULL },
+    { "prefix", 0 , NULL },
+    { "let", 0 , NULL }, /* 100 */
+    { "shorthand_def", 0 , NULL },
+    { "read_to_cs", 0 , NULL },
+    { "def", 0 , NULL },
+    { "set_box", 0 , NULL },
+    { "hyph_data", 0 , NULL },
+    { "set_interaction", 0 , NULL },
+    { "letterspace_font", 0 , NULL },
+    { "set_ocp", 0 , NULL },
+    { "def_ocp", 0 , NULL },
+    { "set_ocp_list", 0 , NULL }, /* 110 */
+    { "def_ocp_list", 0 , NULL },
+    { "clear_ocp_lists", 0 , NULL },
+    { "push_ocp_list", 0 , NULL },
+    { "pop_ocp_list", 0 , NULL },
+    { "ocp_list_op", 0 , NULL },
+    { "ocp_trace_level", 0 , NULL},
+    { "undefined_cs", 0 , NULL },
+    { "expand_after", 0 , NULL },
+    { "no_expand", 0 , NULL },
+    { "input", 0 , NULL }, /* 120 */
+    { "if_test", 0 , NULL },
+    { "fi_or_else", 0 , NULL },
+    { "cs_name", 0 , NULL },
+    { "convert", 0 , NULL },
+    { "the", 0 , NULL  },
+    { "top_bot_mark", 0 , NULL },
+    { "call", 0 , NULL },
+    { "long_call", 0 , NULL },
+    { "outer_call", 0 , NULL },
+    { "long_outer_call", 0 , NULL }, /* 130 */
+    { "end_template", 0 , NULL },
+    { "dont_expand", 0, NULL },
+    { "glue_ref", 0 , NULL },
+    { "shape_ref", 0 , NULL },
+    { "box_ref", 0 , NULL },
+    { "data", 0 , NULL },
+    {  NULL, 0, NULL } };
+
+
+int get_command_id (char *s) {
+  int i;
+  int cmd  = -1;
+  for (i=0;command_names[i].cmd_name != NULL;i++) {
+    if (strcmp(s,command_names[i].cmd_name) == 0) 
+      break;
+  }
+  if (command_names[i].cmd_name!=NULL) {
+    cmd = i;
+  }
+  return cmd;
+}
+
+static int
+get_cur_cmd (lua_State *L) {
+  int r = 0;
+  cur_cs = 0;
+  int len = lua_objlen(L,-1);
+  if (len==3 || len==2) {
+    r = 1;
+    lua_rawgeti(L,-1,1);
+    cur_cmd = lua_tointeger(L,-1);
+    lua_rawgeti(L,-2,2);
+    cur_chr = lua_tointeger(L,-1);
+	if (len==3) {
+	  lua_rawgeti(L,-3,3);
+	  cur_cs = lua_tointeger(L,-1);
+	}
+	lua_pop(L,len);
+    if (cur_cs==0) 
+      cur_tok=(cur_cmd*string_offset)+cur_chr; 
+    else
+      cur_tok=cs_token_flag+cur_cs; 
+  }
+  return r;
+}
+
+
+static int
+token_from_lua (lua_State *L) {
+  int cmd,chr;
+  int cs = 0;  
+  int len = lua_objlen(L,-1);
+  if (len==3 || len==2) {
+    lua_rawgeti(L,-1,1);
+    cmd = lua_tointeger(L,-1);
+    lua_rawgeti(L,-2,2);
+    chr = lua_tointeger(L,-1);
+	if (len==3) {
+	  lua_rawgeti(L,-3,3);
+	  cs = lua_tointeger(L,-1);
+	}
+	lua_pop(L,len);
+    if (cs==0) {
+      return (cmd*string_offset)+chr; 
+    } else {
+      return cs_token_flag+cs; 
+    }
+  }
+  return -1;
+}
+
+static int
+get_cur_cs (lua_State *L) {
+  char *s;
+  unsigned j;
+  size_t l;
+  integer cs;
+  int save_nncs;
+  int ret;
+  ret = 0;
+  cur_cs = 0;
+  lua_getfield(L,-1,"name");
+  if (lua_isstring(L,-1)) {
+    s = (char *)lua_tolstring(L,-1,&l);
+    if (l>0) {
+      if (last+l>buf_size)
+        check_buffer_overflow(last+l);
+      for (j=0;j<l;j++) {
+	buffer[last+1+j]=*s++;
+      }
+      save_nncs = no_new_control_sequence;
+      no_new_control_sequence = false;
+      cs = id_lookup((last+1),l);
+      cur_tok = cs_token_flag+cs;
+      cur_cmd = zget_eq_type(cs);
+      cur_chr = zget_equiv(cs);
+      no_new_control_sequence = save_nncs;
+      ret = 1;
+    }
+  }
+  lua_pop(L,1);
+  return ret;
+}
+
+
+#define append_i_byte(a) {				\
+    if ((i+2)>alloci) {					\
+      ret = xrealloc(ret,alloci+64);			\
+      alloci = alloci + 64; }				\
+    ret[i++] = a; }
+
+#define Print_char(a) append_i_byte(a)
+
+#define Print_uchar(s) {					\
+  if (s<=0x7F) {						\
+    Print_char(s);						\
+  } else if (s<=0x7FF) {					\
+    Print_char(0xC0 + (s / 0x40));				\
+    Print_char(0x80 + (s % 0x40));				\
+  } else if (s<=0xFFFF) {					\
+    Print_char(0xE0 + (s / 0x1000));				\
+    Print_char(0x80 + ((s % 0x1000) / 0x40));			\
+    Print_char(0x80 + ((s % 0x1000) % 0x40));			\
+  } else if (s>=0x10FF00) {					\
+    Print_char(s-0x10FF00);					\
+  } else {							\
+    Print_char(0xF0 + (s / 0x40000));				\
+    Print_char(0x80 + ((s % 0x40000) / 0x1000));		\
+    Print_char(0x80 + (((s % 0x40000) % 0x1000) / 0x40));	\
+    Print_char(0x80 + (((s % 0x40000) % 0x1000) % 0x40));	\
+  } }
+
+
+#define Print_esc(b) { if (e>0 && e<string_offset) { Print_uchar (e); Print_uchar (e); }	\
+    { char *v = b; while (*v) { Print_char(*v); v++; } } }
+
+#define single_letter(a) (length(a)==1)||			\
+  ((length(a)==4)&&(str_pool[str_start_macro(a)]>=0xF0))||	\
+  ((length(a)==3)&&(str_pool[str_start_macro(a)]>=0xE0))||	\
+  ((length(a)==2)&&(str_pool[str_start_macro(a)]>=0xC0))
+
+#define is_cat_letter(a)						\
+  (get_char_cat_code(pool_to_unichar(str_start_macro(a))) == 11)
+
+static int active_base = 0;
+static int hash_base = 0;
+static int eqtb_size = 0;
+static int null_cs = 0;
+static int undefined_control_sequence;
+
+char * 
+tokenlist_to_cstring ( int p , int inhibit_par, int *siz) {
+  integer m, c  ;
+  integer q;
+  char *s;
+  int e;
+  char *ret=NULL;
+  int match_chr = '#';
+  int n = '0';
+  int alloci = 0;
+  int i = 0;
+  if (p==null || link(p)==null) {
+    if (siz!=NULL)
+      *siz = 0;
+    return NULL;
+  }
+  p = link(p); /* skip refcount */
+  if (active_base==0) {
+	active_base = get_active_base();
+	hash_base = get_hash_base();
+	null_cs = get_nullcs();
+	eqtb_size = get_eqtb_size();
+	undefined_control_sequence = get_undefined_control_sequence();
+  }
+  e = get_escape_char();
+  while ( p != null ) {      
+    if (p < fix_mem_min || p > fix_mem_end )  {
+      Print_esc ("CLOBBERED.") ;
+      break;
+    } 
+    if (info(p)>=cs_token_flag) {
+      if ( ! (inhibit_par && info(p)==par_token) ) {
+		q = info(p) - cs_token_flag;
+		if (q<hash_base) {
+		  if (q==null_cs) {
+			/* Print_esc("csname"); Print_esc("endcsname"); */
+		  } else {
+			if (q<active_base) {
+			  Print_esc("IMPOSSIBLE.");
+			} else {
+			  Print_uchar(q-active_base);
+			}
+		  }
+		} else if ((q>=undefined_control_sequence)&&((q<=eqtb_size))||(q>eqtb_size+hash_extra)) {
+		  Print_esc("IMPOSSIBLE.");
+		} else if ((zget_cs_text(q)<0)||(zget_cs_text(q)>=str_ptr)) {
+		  Print_esc("NONEXISTENT.");
+		} else {
+		  Print_uchar (e); 	
+		  s = makecstring(zget_cs_text(q));
+		  while (*s) { Print_char(*s); s++; }
+		  if ((! single_letter(zget_cs_text(q))) || is_cat_letter(zget_cs_text(q))) { 
+			Print_char(' ');
+		  }
+		}
+      }
+    } else {
+      m=info(p) / string_offset; 
+      c=info(p) % string_offset;
+      if ( info(p) < 0 ) {
+		Print_esc ( "BAD.") ;
+      } else { 
+		switch ( m ) {
+		case 6 : /* falls through */
+		  Print_uchar ( c ) ;
+		case 1 : 
+		case 2 : 
+		case 3 : 
+		case 4 : 
+		case 7 : 
+		case 8 : 
+		case 10 : 
+		case 11 : 
+		case 12 : 
+		  Print_uchar ( c ) ;
+		  break ;
+		case 5 : 
+		  Print_uchar ( match_chr ) ;
+		  if ( c <= 9 ) {
+			Print_char ( c + '0') ;
+		  } else {
+			Print_char ( '!' ) ;
+			return NULL;
+		  } 
+		  break ;
+		case 13 : 
+		  match_chr = c ;
+		  Print_uchar ( c ) ;
+		  incr ( n ) ;
+		  Print_char ( n ) ;
+		  if ( n > '9' ) 
+			return NULL;
+		  break ;
+		case 14 : 
+		  if ( c == 0 ) {
+			Print_char ('-');
+			Print_char ('>') ;
+		  }
+		  break ;
+		default: 
+		  Print_esc ( "BAD.") ;
+		  break ;
+		} 
+      } 
+    } 
+    p = link(p);
+  } 
+  ret[i]=0;
+  if (siz!=NULL)
+    *siz = i;
+  return ret;
+}
+
+
+void
+tokenlist_to_lua(lua_State *L, int p) {
+  int cmd,chr,cs;
+  int v;
+  int i = 1;
+  v = p;
+  while (v!=null && v < fix_mem_end) {   i++;    v = link(v);  }
+  i = 1;
+  lua_createtable(L,i,0);
+  while (p!=null&& p < fix_mem_end) {
+    if (info(p)>=cs_token_flag) {
+      cs=info(p)-cs_token_flag;
+      cmd = zget_eq_type(cs);
+      chr = zget_equiv(cs);
+      make_token_table(L,cmd,chr,cs);
+    } else {
+      cmd=info(p) / string_offset; 
+      chr=info(p) % string_offset;
+      make_token_table(L,cmd,chr,0);
+    }
+    lua_rawseti(L,-2,i++);
+    p = link(p);
+  }
+}
+
+
+void
+tokenlist_to_luastring(lua_State *L, int p) {
+  int l;
+  char *s;
+  s = tokenlist_to_cstring(p,1,&l);
+  lua_pushlstring(L,s,l);
+}
+
+
+int
+tokenlist_from_lua(lua_State *L) {
+  char *s;
+  int tok,i;
+  size_t j;
+  halfword p,q,r;
+  r = get_avail();
+  info(r)=0; /* ref count */
+  link(r)=null;
+  p = r;
+  if (lua_istable(L,-1)) {
+    j = lua_objlen(L,-1);
+    if (j>0) {
+      for (i=1;i<=j;i++) {
+	lua_rawgeti(L,-1,i);
+	tok = token_from_lua(L);
+	if (tok>=0) {
+	  store_new_token(tok);
+	}
+	lua_pop(L,1);
+      };
+    }
+    return r;
+  } else if (lua_isstring(L,-1)) {
+    s = (char *)lua_tolstring(L,-1,&j);
+    for (i=0;i<j;i++) {
+      if (s[i] == 32) {
+	tok = (10*string_offset)+s[i]; 	  
+      } else {
+	tok = (12*string_offset)+s[i]; 	  
+      }
+      store_new_token(tok);
+    }
+    return r;
+  } else {
+    free_avail(r);
+    return null;
+  }
+}
+
+void
+do_get_token_lua (integer callback_id) {
+  lua_State *L = Luas[0];
+
+  lua_rawgeti(L,LUA_REGISTRYINDEX,callback_callbacks_id);
+  while (1) {
+    lua_rawgeti(L,-1, callback_id);
+    if (!lua_isfunction(L,-1)) {
+      lua_pop(L,2); /* the not-a-function callback and the container */
+      get_next();
+      return;
+    }
+    if (lua_pcall(L,0,1,0) != 0) { /* no arg, 1 result */
+      fprintf(stdout,"error: %s\n",lua_tostring(L,-1));
+      lua_pop(L,2);
+      error();
+      return;
+    }
+    if (lua_istable(L,-1)) {
+      lua_rawgeti(L,-1,1);
+      if (lua_istable(L,-1)) {
+	integer p,q,r;
+	int i,j;
+	lua_pop(L,1); 
+	/* build a token list */
+	r = get_avail(); 
+	p = r;
+	j = lua_objlen(L,-1);
+	if (j>0) {
+	  for (i=1;i<=j;i++) {
+	    lua_rawgeti(L,-1,i);
+	    if (get_cur_cmd(L) || get_cur_cs(L)) {
+	      store_new_token(cur_tok);
+	    }
+	    lua_pop(L,1);
+	  }
+	}
+	if (p!=r) {
+	  p = link(r);
+	  free_avail(r);
+	  begin_token_list(p, inserted);
+	  cur_input.nofilter_field=true;
+	  get_next();
+	  lua_pop(L,1);
+	  break;	
+	} else {
+	  fprintf(stdout,"error: illegal or empty token list returned\n");
+	  lua_pop(L,2);
+	  error();
+	  return;
+	}
+      } else {
+	lua_pop(L,1);
+	if (get_cur_cmd(L) || get_cur_cs(L)) {
+	  lua_pop(L,1);
+	  break;	
+	} else {
+	  lua_pop(L,2);
+	  continue; 
+	}
+      }
+    } else {
+      lua_pop(L,1);  
+      continue;	
+    }
+  }
+  lua_pop(L,1); /* callback container */
+  return; 
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/mp.w b/Build/source/texk/web2c/luatexdir/lua/mp.w
new file mode 100644
index 00000000000..a459cc48fe1
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/mp.w
@@ -0,0 +1,26173 @@
+% $Id: mp.web,v 1.8 2005/08/24 10:54:02 taco Exp $
+% MetaPost, by John Hobby.  Public domain.
+
+% Much of this program was copied with permission from MF.web Version 1.9
+% It interprets a language very similar to D.E. Knuth's METAFONT, but with
+% changes designed to make it more suitable for PostScript output.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+% PostScript is a trademark of Adobe Systems Incorporated.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\def\ps{PostScript}
+\def\psqrt#1{\sqrt{\mathstrut#1}}
+\def\k{_{k+1}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\font\logos=logosl10
+\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+\def\[#1]{\ignorespaces} % left over from pascal web
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+\mathchardef\vb="026A % synonym for `\|'
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+\def\title{MetaPost}
+\pdfoutput=1
+\pageno=3
+
+@* \[1] Introduction.
+
+This is \MP, a graphics-language processor based on D. E. Knuth's \MF.
+
+The main purpose of the following program is to explain the algorithms of \MP\
+as clearly as possible. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than C.
+
+A large piece of software like \MP\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program.  These comments explain
+features of the implementation, but they rarely attempt to explain the
+\MP\ language itself, since the reader is supposed to be familiar with
+{\sl The {\logos METAFONT\/}book} as well as the manual
+@.WEB@>
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+{\sl A User's Manual for MetaPost}, Computing Science Technical Report 162,
+AT\AM T Bell Laboratories.
+
+@ The present implementation is a preliminary version, but the possibilities
+for new features are limited by the desire to remain as nearly compatible
+with \MF\ as possible.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of the program, and it has been designed so that such
+extensions are not extremely difficult to make.
+The |banner| string defined here should be changed whenever \MP\
+undergoes any modifications, so that it will be clear which version of
+\MP\ might be the guilty party when a problem arises.
+@^extensions to \MP@>
+@^system dependencies@>
+
+@d banner "This is MetaPost, Version 1.003" /* printed when \MP\ starts */
+@d metapost_version "1.003"
+@d mplib_version "0.30"
+@d version_string " (Cweb version 0.30)"
+
+@d true 1
+@d false 0
+
+@ The external library header for \MP\ is |mplib.h|. It contains a
+few typedefs and the header defintions for the externally used
+fuctions.
+
+The most important of the typedefs is the definition of the structure 
+|MP_options|, that acts as a small, configurable front-end to the fairly 
+large |MP_instance| structure.
+ 
+@(mplib.h@>=
+typedef struct MP_instance * MP;
+@<Exported types@>
+typedef struct MP_options {
+  @<Option variables@>
+} MP_options;
+@<Exported function headers@>
+
+@ The internal header file is much longer: it not only lists the complete
+|MP_instance|, but also a lot of functions that have to be available to
+the \ps\ backend, that is defined in a separate \.{WEB} file. 
+
+The variables from |MP_options| are included inside the |MP_instance| 
+wholesale.
+
+@(mpmp.h@>=
+#include <setjmp.h>
+typedef struct psout_data_struct * psout_data;
+typedef int boolean;
+typedef signed int integer;
+@<Declare helpers@>
+@<Types in the outer block@>
+@<Constants in the outer block@>
+#  ifndef LIBAVL_ALLOCATOR
+#    define LIBAVL_ALLOCATOR
+    struct libavl_allocator {
+        void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size);
+        void (*libavl_free) (struct libavl_allocator *, void *libavl_block);
+    };
+#  endif
+typedef struct MP_instance {
+  @<Option variables@>
+  @<Global variables@>
+} MP_instance;
+@<Internal library declarations@>
+
+@ @c 
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include <assert.h>
+#include <unistd.h> /* for access() */
+#include <time.h> /* for struct tm \& co */
+#include "mplib.h"
+#include "mpmp.h" /* internal header */
+#include "mppsout.h" /* internal header */
+@h
+@<Declarations@>
+@<Basic printing procedures@>
+@<Error handling procedures@>
+
+@ Here are the functions that set up the \MP\ instance.
+
+@<Declarations@> =
+@<Declare |mp_reallocate| functions@>
+struct MP_options *mp_options (void);
+MP mp_new (struct MP_options *opt);
+
+@ @c
+struct MP_options *mp_options (void) {
+  struct MP_options *opt;
+  opt = malloc(sizeof(MP_options));
+  if (opt!=NULL) {
+    memset (opt,0,sizeof(MP_options));
+  }
+  return opt;
+} 
+
+@ The |__attribute__| pragma is gcc-only.
+
+@<Internal library ... @>=
+#if !defined(__GNUC__) || (__GNUC__ < 2)
+# define __attribute__(x)
+#endif /* !defined(__GNUC__) || (__GNUC__ < 2) */
+
+@ @c
+MP __attribute__ ((noinline))
+mp_new (struct MP_options *opt) {
+  MP mp;
+  mp = malloc(1*sizeof(MP_instance));
+  if (mp==NULL)
+	return mp;
+  @<Set |ini_version|@>;
+  @<Setup the non-local jump buffer in |mp_new|@>;
+  @<Allocate or initialize variables@>
+  if (opt->main_memory>mp->mem_max)
+    mp_reallocate_memory(mp,opt->main_memory);
+  mp_reallocate_paths(mp,1000);
+  mp_reallocate_fonts(mp,8);
+  return mp;
+}
+
+@ @c
+void mp_free (MP mp) {
+  int k; /* loop variable */
+  @<Dealloc variables@>
+  xfree(mp);
+}
+
+@ @c
+void  __attribute__((noinline))
+mp_do_initialize ( MP mp) {
+  @<Local variables for initialization@>
+  @<Set initial values of key variables@>
+}
+int mp_initialize (MP mp) { /* this procedure gets things started properly */
+  mp->history=mp_fatal_error_stop; /* in case we quit during initialization */
+  @<Install and test the non-local jump buffer@>;
+  t_open_out; /* open the terminal for output */
+  @<Check the ``constant'' values...@>;
+  if ( mp->bad>0 ) {
+	char ss[256];
+    snprintf(ss,256,"Ouch---my internal constants have been clobbered!\n"
+                   "---case %i",(int)mp->bad);
+    do_fprintf(mp->err_out,(char *)ss);
+@.Ouch...clobbered@>
+    return mp->history;
+  }
+  mp_do_initialize(mp); /* erase preloaded mem */
+  if (mp->ini_version) {
+    @<Run inimpost commands@>;
+  }
+  @<Initialize the output routines@>;
+  @<Get the first line of input and prepare to start@>;
+  mp_set_job_id(mp);
+  mp_init_map_file(mp, mp->troff_mode);
+  mp->history=mp_spotless; /* ready to go! */
+  if (mp->troff_mode) {
+    mp->internal[mp_gtroffmode]=unity; 
+    mp->internal[mp_prologues]=unity; 
+  }
+  if ( mp->start_sym>0 ) { /* insert the `\&{everyjob}' symbol */
+    mp->cur_sym=mp->start_sym; mp_back_input(mp);
+  }
+  return mp->history;
+}
+
+@ 
+@<Exported function headers@>=
+extern struct MP_options *mp_options (void);
+extern MP mp_new (struct MP_options *opt) ;
+extern void mp_free (MP mp);
+extern int mp_initialize (MP mp);
+
+@ The overall \MP\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `|start_here|'. If you want to skip down to the
+main program now, you can look up `|start_here|' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \MP's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+@ Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \MP\ is being installed or
+when system wizards are fooling around with \MP\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the preprocessor test `|#ifdef DEBUG .. #endif|'.
+
+@ This program has two important variations: (1) There is a long and slow
+version called \.{INIMP}, which does the extra calculations needed to
+@.INIMP@>
+initialize \MP's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+
+Which is which is decided at runtime.
+
+@ The following parameters can be changed at compile time to extend or
+reduce \MP's capacity. They may have different values in \.{INIMP} and
+in production versions of \MP.
+@.INIMP@>
+@^system dependencies@>
+
+@<Constants...@>=
+#define file_name_size 255 /* file names shouldn't be longer than this */
+#define bistack_size 1500 /* size of stack for bisection algorithms;
+  should probably be left at this value */
+
+@ Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \MP's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INIMP}
+@.INIMP@>
+to generate new tables for the production \MP\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. 
+
+@ @<Glob...@>=
+int max_strings; /* maximum number of strings; must not exceed |max_halfword| */
+int pool_size; /* maximum number of characters in strings, including all
+  error messages and help texts, and the names of all identifiers */
+int mem_max; /* greatest index in \MP's internal |mem| array;
+  must be strictly less than |max_halfword|;
+  must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top| */
+int mem_top; /* largest index in the |mem| array dumped by \.{INIMP};
+  must not be greater than |mem_max| */
+
+@ @<Option variables@>=
+int error_line; /* width of context lines on terminal error messages */
+int half_error_line; /* width of first lines of contexts in terminal
+  error messages; should be between 30 and |error_line-15| */
+int max_print_line; /* width of longest text lines output; should be at least 60 */
+int hash_size; /* maximum number of symbolic tokens,
+  must be less than |max_halfword-3*param_size| */
+int hash_prime; /* a prime number equal to about 85\pct! of |hash_size| */
+int param_size; /* maximum number of simultaneous macro parameters */
+int max_in_open; /* maximum number of input files and error insertions that
+  can be going on simultaneously */
+int main_memory; /* only for options, to set up |mem_max| and |mem_top| */
+void *userdata; /* this allows the calling application to setup local */
+
+@ 
+@d set_value(a,b,c) do { a=c; if (b>c) a=b; } while (0)
+
+@<Allocate or ...@>=
+mp->max_strings=500;
+mp->pool_size=10000;
+set_value(mp->error_line,opt->error_line,79);
+set_value(mp->half_error_line,opt->half_error_line,50);
+set_value(mp->max_print_line,opt->max_print_line,100);
+mp->main_memory=5000;
+mp->mem_max=5000;
+mp->mem_top=5000;
+set_value(mp->hash_size,opt->hash_size,9500);
+set_value(mp->hash_prime,opt->hash_prime,7919);
+set_value(mp->param_size,opt->param_size,150);
+set_value(mp->max_in_open,opt->max_in_open,10);
+mp->userdata=opt->userdata;
+
+@ In case somebody has inadvertently made bad settings of the ``constants,''
+\MP\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \MP\ where global variables are
+defined.
+
+@<Glob...@>=
+integer bad; /* is some ``constant'' wrong? */
+
+@ Later on we will say `\ignorespaces|if (mem_max>=max_halfword) bad=10;|',
+or something similar. (We can't do that until |max_halfword| has been defined.)
+
+@<Check the ``constant'' values for consistency@>=
+mp->bad=0;
+if ( (mp->half_error_line<30)||(mp->half_error_line>mp->error_line-15) ) mp->bad=1;
+if ( mp->max_print_line<60 ) mp->bad=2;
+if ( mp->mem_top<=1100 ) mp->bad=4;
+if (mp->hash_prime>mp->hash_size ) mp->bad=5;
+
+@ Some |goto| labels are used by the following definitions. The label
+`|restart|' is occasionally used at the very beginning of a procedure; and
+the label `|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case.  Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'.  If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`|common_ending|'.
+
+@ Here are some macros for common programming idioms.
+
+@d incr(A)   (A)=(A)+1 /* increase a variable by unity */
+@d decr(A)   (A)=(A)-1 /* decrease a variable by unity */
+@d negate(A) (A)=-(A) /* change the sign of a variable */
+@d double(A) (A)=(A)+(A)
+@d odd(A)   ((A)%2==1)
+@d chr(A)   (A)
+@d do_nothing   /* empty statement */
+@d Return   goto exit /* terminate a procedure call */
+@f return   nil /* \.{WEB} will henceforth say |return| instead of \\{return} */
+
+@* \[2] The character set.
+In order to make \MP\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal eight-bit
+code that includes standard ASCII, the ``American Standard Code for
+Information Interchange.''  This conversion is done immediately when each
+character is read in. Conversely, characters are converted from ASCII to
+the user's external representation just before they are output to a
+text file.
+@^ASCII code@>
+
+Such an internal code is relevant to users of \MP\ only with respect to
+the \&{char} and \&{ASCII} operations, and the comparison of strings.
+
+@ Characters of text that have been converted to \MP's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+typedef unsigned char ASCII_code; /* eight-bit numbers */
+
+@ The present specification of \MP\ has been written under the assumption
+that the character set contains at least the letters and symbols associated
+with ASCII codes 040 through 0176; all of these characters are now
+available on most computer terminals.
+
+We shall use the name |text_char| to stand for the data type of the characters 
+that are converted to and from |ASCII_code| when they are input and output. 
+We shall also assume that |text_char| consists of the elements 
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. 
+The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d first_text_char 0 /* ordinal number of the smallest element of |text_char| */
+@d last_text_char 255 /* ordinal number of the largest element of |text_char| */
+
+@<Types...@>=
+typedef unsigned char text_char; /* the data type of characters in text files */
+
+@ @<Local variables for init...@>=
+integer i;
+
+@ The \MP\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to Pascal's |ord| and |chr| functions.
+
+@d xchr(A) mp->xchr[(A)]
+@d xord(A) mp->xord[(A)]
+
+@<Glob...@>=
+ASCII_code xord[256];  /* specifies conversion of input characters */
+text_char xchr[256];  /* specifies conversion of output characters */
+
+@ The core system assumes all 8-bit is acceptable.  If it is not,
+a change file has to alter the below section.
+@^system dependencies@>
+
+Additionally, people with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \MP\ are allowed to have in their input files.
+Appropriate changes to \MP's |char_class| table should then be made.
+(Unlike \TeX, each installation of \MP\ has a fixed assignment of category
+codes, called the |char_class|.) Such changes make portability of programs
+more difficult, so they should be introduced cautiously if at all.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set initial ...@>=
+for (i=0;i<=0377;i++) { xchr(i)=i; }
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<0177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below 040 in case there is a coincidence.
+
+@<Set initial ...@>=
+for (i=first_text_char;i<=last_text_char;i++) { 
+   xord(chr(i))=0177;
+}
+for (i=0200;i<=0377;i++) { xord(xchr(i))=i;}
+for (i=0;i<=0176;i++) { xord(xchr(i))=i;}
+
+@* \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached; (5)~display of bits on the user's screen.
+The bit-display operation will be discussed in a later section; we shall
+deal here only with more traditional kinds of I/O.
+
+@ Finding files happens in a slightly roundabout fashion: the \MP\
+instance object contains a field that holds a function pointer that finds a
+file, and returns its name, or NULL. For this, it receives three
+parameters: the non-qualified name |fname|, the intended |fopen|
+operation type |fmode|, and the type of the file |ftype|.
+
+The file types that are passed on in |ftype| can be  used to 
+differentiate file searches if a library like kpathsea is used,
+the fopen mode is passed along for the same reason.
+
+@<Types...@>=
+typedef unsigned char eight_bits ; /* unsigned one-byte quantity */
+
+@ @<Exported types@>=
+enum mp_filetype {
+  mp_filetype_terminal = 0, /* the terminal */
+  mp_filetype_error, /* the terminal */
+  mp_filetype_program , /* \MP\ language input */
+  mp_filetype_log,  /* the log file */
+  mp_filetype_postscript, /* the postscript output */
+  mp_filetype_memfile, /* memory dumps */
+  mp_filetype_metrics, /* TeX font metric files */
+  mp_filetype_fontmap, /* PostScript font mapping files */
+  mp_filetype_font, /*  PostScript type1 font programs */
+  mp_filetype_encoding, /*  PostScript font encoding files */
+  mp_filetype_text  /* first text file for readfrom and writeto primitives */
+};
+typedef char *(*mp_file_finder)(MP, const char *, const char *, int);
+typedef void *(*mp_file_opener)(MP, const char *, const char *, int);
+typedef char *(*mp_file_reader)(MP, void *, size_t *);
+typedef void (*mp_binfile_reader)(MP, void *, void **, size_t *);
+typedef void (*mp_file_closer)(MP, void *);
+typedef int (*mp_file_eoftest)(MP, void *);
+typedef void (*mp_file_flush)(MP, void *);
+typedef void (*mp_file_writer)(MP, void *, const char *);
+typedef void (*mp_binfile_writer)(MP, void *, void *, size_t);
+#define NOTTESTING 1
+
+@ @<Option variables@>=
+mp_file_finder find_file;
+mp_file_opener open_file;
+mp_file_reader read_ascii_file;
+mp_binfile_reader read_binary_file;
+mp_file_closer close_file;
+mp_file_eoftest eof_file;
+mp_file_flush flush_file;
+mp_file_writer write_ascii_file;
+mp_binfile_writer write_binary_file;
+
+@ The default function for finding files is |mp_find_file|. It is 
+pretty stupid: it will only find files in the current directory.
+
+This function may disappear altogether, it is currently only
+used for the default font map file.
+
+@c
+char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype)  {
+  (void) mp;
+  if (fmode[0] != 'r' || (! access (fname,R_OK)) || ftype) {  
+     return strdup(fname);
+  }
+  return NULL;
+}
+
+@ This has to be done very early on, so it is best to put it in with
+the |mp_new| allocations
+
+@d set_callback_option(A) do { mp->A = mp_##A;
+  if (opt->A!=NULL) mp->A = opt->A;
+} while (0)
+
+@<Allocate or initialize ...@>=
+set_callback_option(find_file);
+set_callback_option(open_file);
+set_callback_option(read_ascii_file);
+set_callback_option(read_binary_file);
+set_callback_option(close_file);
+set_callback_option(eof_file);
+set_callback_option(flush_file);
+set_callback_option(write_ascii_file);
+set_callback_option(write_binary_file);
+
+@ Because |mp_find_file| is used so early, it has to be in the helpers
+section.
+
+@<Internal ...@>=
+char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype) ;
+void *mp_open_file (MP mp , const char *fname, const char *fmode, int ftype) ;
+char *mp_read_ascii_file (MP mp, void *f, size_t *size) ;
+void mp_read_binary_file (MP mp, void *f, void **d, size_t *size) ;
+void mp_close_file (MP mp, void *f) ;
+int mp_eof_file (MP mp, void *f) ;
+void mp_flush_file (MP mp, void *f) ;
+void mp_write_ascii_file (MP mp, void *f, const char *s) ;
+void mp_write_binary_file (MP mp, void *f, void *s, size_t t) ;
+
+@ The function to open files can now be very short.
+
+@c
+void *mp_open_file(MP mp, const char *fname, const char *fmode, int ftype)  {
+  char realmode[3];
+  (void) mp;
+  realmode[0] = *fmode;
+  realmode[1] = 'b';
+  realmode[2] = 0;
+#if NOTTESTING
+  if (ftype==mp_filetype_terminal) {
+    return (fmode[0] == 'r' ? stdin : stdout);
+  } else if (ftype==mp_filetype_error) {
+    return stderr;
+  } else if (fname != NULL && (fmode[0] != 'r' || (! access (fname,R_OK)))) {
+    return (void *)fopen(fname, realmode);
+  }
+#endif
+  return NULL;
+}
+
+@ This is a legacy interface: (almost) all file names pass through |name_of_file|.
+
+@<Glob...@>=
+char name_of_file[file_name_size+1]; /* the name of a system file */
+int name_length;/* this many characters are actually
+  relevant in |name_of_file| (the rest are blank) */
+
+@ @<Option variables@>=
+int print_found_names; /* configuration parameter */
+
+@ If this parameter is true, the terminal and log will report the found
+file names for input files instead of the requested ones. 
+It is off by default because it creates an extra filename lookup.
+
+@<Allocate or initialize ...@>=
+mp->print_found_names = (opt->print_found_names>0 ? true : false);
+
+@ \MP's file-opening procedures return |false| if no file identified by
+|name_of_file| could be opened.
+
+The |OPEN_FILE| macro takes care of the |print_found_names| parameter.
+It is not used for opening a mem file for read, because that file name 
+is never printed.
+
+@d OPEN_FILE(A) do {
+  if (mp->print_found_names) {
+    char *s = (mp->find_file)(mp,mp->name_of_file,A,ftype);
+    if (s!=NULL) {
+      *f = (mp->open_file)(mp,mp->name_of_file,A, ftype); 
+      strncpy(mp->name_of_file,s,file_name_size);
+      xfree(s);
+    } else {
+      *f = NULL;
+    }
+  } else {
+    *f = (mp->open_file)(mp,mp->name_of_file,A, ftype); 
+  }
+} while (0);
+return (*f ? true : false)
+
+@c 
+boolean mp_a_open_in (MP mp, void **f, int ftype) {
+  /* open a text file for input */
+  OPEN_FILE("r");
+}
+@#
+boolean mp_w_open_in (MP mp, void **f) {
+  /* open a word file for input */
+  *f = (mp->open_file)(mp,mp->name_of_file,"r",mp_filetype_memfile); 
+  return (*f ? true : false);
+}
+@#
+boolean mp_a_open_out (MP mp, void **f, int ftype) {
+  /* open a text file for output */
+  OPEN_FILE("w");
+}
+@#
+boolean mp_b_open_out (MP mp, void **f, int ftype) {
+  /* open a binary file for output */
+  OPEN_FILE("w");
+}
+@#
+boolean mp_w_open_out (MP mp, void **f) {
+  /* open a word file for output */
+  int ftype = mp_filetype_memfile;
+  OPEN_FILE("w");
+}
+
+@ @c
+char *mp_read_ascii_file (MP mp, void *ff, size_t *size) {
+  int c;
+  size_t len = 0, lim = 128;
+  char *s = NULL;
+  FILE *f = (FILE *)ff;
+  *size = 0;
+  (void) mp; /* for -Wunused */
+#if NOTTESTING
+  c = fgetc(f);
+  if (c==EOF)
+    return NULL;
+  s = malloc(lim); 
+  if (s==NULL) return NULL;
+  while (c!=EOF && c!='\n' && c!='\r') { 
+    if (len==lim) {
+      s =realloc(s, (lim+(lim>>2)));
+      if (s==NULL) return NULL;
+      lim+=(lim>>2);
+    }
+	s[len++] = c;
+    c =fgetc(f);
+  }
+  if (c=='\r') {
+    c = fgetc(f);
+    if (c!=EOF && c!='\n')
+       ungetc(c,f);
+  }
+  s[len] = 0;
+  *size = len;
+#endif
+  return s;
+}
+
+@ @c
+void mp_write_ascii_file (MP mp, void *f, const char *s) {
+  (void) mp;
+#if NOTTESTING
+  if (f!=NULL) {
+    fputs(s,(FILE *)f);
+  }
+#endif
+}
+
+@ @c
+void mp_read_binary_file (MP mp, void *f, void **data, size_t *size) {
+  size_t len = 0;
+  (void) mp;
+#if NOTTESTING
+  len = fread(*data,1,*size,(FILE *)f);
+#endif
+  *size = len;
+}
+
+@ @c
+void mp_write_binary_file (MP mp, void *f, void *s, size_t size) {
+  (void) mp;
+#if NOTTESTING
+  if (f!=NULL)
+    fwrite(s,size,1,(FILE *)f);
+#endif
+}
+
+
+@ @c
+void mp_close_file (MP mp, void *f) {
+  (void) mp;
+#if NOTTESTING
+  fclose((FILE *)f);
+#endif
+}
+
+@ @c
+int mp_eof_file (MP mp, void *f) {
+  (void) mp;
+#if NOTTESTING
+  return feof((FILE *)f);
+#else
+  return 0;
+#endif
+}
+
+@ @c
+void mp_flush_file (MP mp, void *f) {
+  (void) mp;
+#if NOTTESTING
+  fflush((FILE *)f);
+#endif
+}
+
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+size_t buf_size; /* maximum number of characters simultaneously present in
+                    current lines of open files */
+ASCII_code *buffer; /* lines of characters being read */
+size_t first; /* the first unused position in |buffer| */
+size_t last; /* end of the line just input to |buffer| */
+size_t max_buf_stack; /* largest index used in |buffer| */
+
+@ @<Allocate or initialize ...@>=
+mp->buf_size = 200;
+mp->buffer = xmalloc((mp->buf_size+1),sizeof(ASCII_code));
+
+@ @<Dealloc variables@>=
+xfree(mp->buffer);
+
+@ @c
+void mp_reallocate_buffer(MP mp, size_t l) {
+  ASCII_code *buffer;
+  if (l>max_halfword) {
+    mp_confusion(mp,"buffer size"); /* can't happen (I hope) */
+  }
+  buffer = xmalloc((l+1),sizeof(ASCII_code));
+  memcpy(buffer,mp->buffer,(mp->buf_size+1));
+  xfree(mp->buffer);
+  mp->buffer = buffer ;
+  mp->buf_size = l;
+}
+
+@ The |input_ln| function brings the next line of input from the specified
+field into available positions of the buffer array and returns the value
+|true|, unless the file has already been entirely read, in which case it
+returns |false| and sets |last:=first|.  In general, the |ASCII_code|
+numbers that represent the next line of the file are input into
+|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
+global variable |last| is set equal to |first| plus the length of the
+line. Trailing blanks are removed from the line; thus, either |last=first|
+(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
+@^inner loop@>
+
+The variable |max_buf_stack|, which is used to keep track of how large
+the |buf_size| parameter must be to accommodate the present job, is
+also kept up to date by |input_ln|.
+
+@c 
+boolean mp_input_ln (MP mp, void *f ) {
+  /* inputs the next line or returns |false| */
+  char *s;
+  size_t size = 0; 
+  mp->last=mp->first; /* cf.\ Matthew 19\thinspace:\thinspace30 */
+  s = (mp->read_ascii_file)(mp,f, &size);
+  if (s==NULL)
+	return false;
+  if (size>0) {
+    mp->last = mp->first+size;
+    if ( mp->last>=mp->max_buf_stack ) { 
+      mp->max_buf_stack=mp->last+1;
+      while ( mp->max_buf_stack>=mp->buf_size ) {
+        mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size>>2)));
+      }
+    }
+    memcpy((mp->buffer+mp->first),s,size);
+    /* while ( mp->buffer[mp->last]==' ' ) mp->last--; */
+  } 
+  free(s);
+  return true;
+}
+
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+void * term_in; /* the terminal as an input file */
+void * term_out; /* the terminal as an output file */
+void * err_out; /* the terminal as an output file */
+
+@ Here is how to open the terminal files. In the default configuration,
+nothing happens except that the command line (if there is one) is copied
+to the input buffer.  The variable |command_line| will be filled by the 
+|main| procedure. The copying can not be done earlier in the program 
+logic because in the |INI| version, the |buffer| is also used for primitive 
+initialization.
+
+@^system dependencies@>
+
+@d t_open_out  do {/* open the terminal for text output */
+    mp->term_out = (mp->open_file)(mp,"terminal", "w", mp_filetype_terminal);
+    mp->err_out = (mp->open_file)(mp,"error", "w", mp_filetype_error);
+} while (0)
+@d t_open_in  do { /* open the terminal for text input */
+    mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal);
+    if (mp->command_line!=NULL) {
+      mp->last = strlen(mp->command_line);
+      strncpy((char *)mp->buffer,mp->command_line,mp->last);
+      xfree(mp->command_line);
+    } else {
+	  mp->last = 0;
+    }
+} while (0)
+
+@d t_close_out do { /* close the terminal */
+  (mp->close_file)(mp,mp->term_out);
+  (mp->close_file)(mp,mp->err_out);
+} while (0)
+
+@d t_close_in do { /* close the terminal */
+  (mp->close_file)(mp,mp->term_in);
+} while (0)
+
+@<Option variables@>=
+char *command_line;
+
+@ @<Allocate or initialize ...@>=
+mp->command_line = xstrdup(opt->command_line);
+
+@ Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, |clear_terminal|, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, |wake_up_terminal|,
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system.  The following macros show how
+these operations can be specified:
+@^system dependencies@>
+
+@d update_terminal  (mp->flush_file)(mp,mp->term_out) /* empty the terminal output buffer */
+@d clear_terminal   do_nothing /* clear the terminal input buffer */
+@d wake_up_terminal (mp->flush_file)(mp,mp->term_out) 
+                    /* cancel the user's cancellation of output */
+
+@ We need a special routine to read the first line of \MP\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{input cmr10}' on the first
+line, or if some macro invoked by that line does such an \.{input},
+the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{mpout.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{input} command.)
+
+The first line is even more special. It's nice to let the user start
+running a \MP\ job by typing a command line like `\.{MP cmr10}'; in
+such a case, \MP\ will operate as if the first line of input were
+`\.{cmr10}', i.e., the first line will consist of the remainder of the
+command line, after the part that invoked \MP.
+
+@ Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file |term_in| for input from the
+  terminal. (The file |term_out| will already be open for output to the
+  terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+  considered the first line of terminal input. Otherwise the
+  user should be prompted with `\.{**}', and the first line of input
+  should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+  command line, should appear in locations |first| to |last-1| of the
+  |buffer| array.
+
+\textindent{4)}The global variable |loc| should be set so that the
+  character to be read next by \MP\ is in |buffer[loc]|. This
+  character should not be blank, and we should have |loc<last|.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{input}' need
+not be typed immediately after~`\.{**}'.)
+
+@d loc mp->cur_input.loc_field /* location of first unread character in |buffer| */
+
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@c 
+boolean mp_init_terminal (MP mp) { /* gets the terminal input started */
+  t_open_in; 
+  if (mp->last!=0) {
+    loc = mp->first = 0;
+	return true;
+  }
+  while (1) { 
+    if (!mp->noninteractive) {
+	  wake_up_terminal; do_fprintf(mp->term_out,"**"); update_terminal;
+@.**@>
+    }
+    if ( ! mp_input_ln(mp, mp->term_in ) ) { /* this shouldn't happen */
+      do_fprintf(mp->term_out,"\n! End of file on the terminal... why?");
+@.End of file on the terminal@>
+      return false;
+    }
+    loc=mp->first;
+    while ( (loc<(int)mp->last)&&(mp->buffer[loc]==' ') ) 
+      incr(loc);
+    if ( loc<(int)mp->last ) { 
+      return true; /* return unless the line was all blank */
+    }
+    if (!mp->noninteractive) {
+	  do_fprintf(mp->term_out,"Please type the name of your input file.\n");
+    }
+  }
+}
+
+@ @<Declarations@>=
+boolean mp_init_terminal (MP mp) ;
+
+
+@* \[4] String handling.
+Symbolic token names and diagnostic messages are variable-length strings
+of eight-bit characters. Many strings \MP\ uses are simply literals
+in the compiled source, like the error messages and the names of the
+internal parameters. Other strings are used or defined from the \MP\ input 
+language, and these have to be interned.
+
+\MP\ uses strings more extensively than \MF\ does, but the necessary
+operations can still be handled with a fairly simple data structure.
+The array |str_pool| contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array |str_start| contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number |s| comprises the characters |str_pool[j]| for
+|str_start[s]<=j<str_start[ss]| where |ss=next_str[s]|.  The string pool
+is allocated sequentially and |str_pool[pool_ptr]| is the next unused
+location.  The first string number not currently in use is |str_ptr|
+and |next_str[str_ptr]| begins a list of free string numbers.  String
+pool entries |str_start[str_ptr]| up to |pool_ptr| are reserved for a
+string currently being constructed.
+
+String numbers 0 to 255 are reserved for strings that correspond to single
+ASCII characters. This is in accordance with the conventions of \.{WEB},
+@.WEB@>
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~255. String number 46 will presumably be the
+single character `\..'\thinspace; but some ASCII codes have no standard visible
+representation, and \MP\ may need to be able to print an arbitrary
+ASCII character, so the first 256 strings are used to specify exactly what
+should be printed for each of the 256 possibilities.
+
+@<Types...@>=
+typedef int pool_pointer; /* for variables that point into |str_pool| */
+typedef int str_number; /* for variables that point into |str_start| */
+
+@ @<Glob...@>=
+ASCII_code *str_pool; /* the characters */
+pool_pointer *str_start; /* the starting pointers */
+str_number *next_str; /* for linking strings in order */
+pool_pointer pool_ptr; /* first unused position in |str_pool| */
+str_number str_ptr; /* number of the current string being created */
+pool_pointer init_pool_ptr; /* the starting value of |pool_ptr| */
+str_number init_str_use; /* the initial number of strings in use */
+pool_pointer max_pool_ptr; /* the maximum so far of |pool_ptr| */
+str_number max_str_ptr; /* the maximum so far of |str_ptr| */
+
+@ @<Allocate or initialize ...@>=
+mp->str_pool  = xmalloc ((mp->pool_size +1),sizeof(ASCII_code));
+mp->str_start = xmalloc ((mp->max_strings+1),sizeof(pool_pointer));
+mp->next_str  = xmalloc ((mp->max_strings+1),sizeof(str_number));
+
+@ @<Dealloc variables@>=
+xfree(mp->str_pool);
+xfree(mp->str_start);
+xfree(mp->next_str);
+
+@ Most printing is done from |char *|s, but sometimes not. Here are
+functions that convert an internal string into a |char *| for use
+by the printing routines, and vice versa.
+
+@d str(A) mp_str(mp,A)
+@d rts(A) mp_rts(mp,A)
+
+@<Internal ...@>=
+int mp_xstrcmp (const char *a, const char *b);
+char * mp_str (MP mp, str_number s);
+
+@ @<Declarations@>=
+str_number mp_rts (MP mp, const char *s);
+str_number mp_make_string (MP mp);
+
+@ The attempt to catch interrupted strings that is in |mp_rts|, is not 
+very good: it does not handle nesting over more than one level.
+
+@c 
+int mp_xstrcmp (const char *a, const char *b) {
+	if (a==NULL && b==NULL) 
+	  return 0;
+    if (a==NULL)
+      return -1;
+    if (b==NULL)
+      return 1;
+    return strcmp(a,b);
+}
+
+@ @c
+char * mp_str (MP mp, str_number ss) {
+  char *s;
+  int len;
+  if (ss==mp->str_ptr) {
+    return NULL;
+  } else {
+    len = length(ss);
+    s = xmalloc(len+1,sizeof(char));
+    strncpy(s,(char *)(mp->str_pool+(mp->str_start[ss])),len);
+    s[len] = 0;
+    return (char *)s;
+  }
+}
+str_number mp_rts (MP mp, const char *s) {
+  int r; /* the new string */ 
+  int old; /* a possible string in progress */
+  int i=0;
+  if (strlen(s)==0) {
+    return 256;
+  } else if (strlen(s)==1) {
+    return s[0];
+  } else {
+   old=0;
+   str_room((integer)strlen(s));
+   if (mp->str_start[mp->str_ptr]<mp->pool_ptr)
+     old = mp_make_string(mp);
+   while (*s) {
+     append_char(*s);
+     s++;
+   }
+   r = mp_make_string(mp);
+   if (old!=0) {
+      str_room(length(old));
+      while (i<length(old)) {
+        append_char((mp->str_start[old]+i));
+      } 
+      mp_flush_string(mp,old);
+    }
+    return r;
+  }
+}
+
+@ Except for |strs_used_up|, the following string statistics are only
+maintained when code between |stat| $\ldots$ |tats| delimiters is not
+commented out:
+
+@<Glob...@>=
+integer strs_used_up; /* strings in use or unused but not reclaimed */
+integer pool_in_use; /* total number of cells of |str_pool| actually in use */
+integer strs_in_use; /* total number of strings actually in use */
+integer max_pl_used; /* maximum |pool_in_use| so far */
+integer max_strs_used; /* maximum |strs_in_use| so far */
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of functions, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d str_stop(A) mp->str_start[mp->next_str[(A)]] /* one cell past the end of string
+  number \# */
+@d length(A) (str_stop((A))-mp->str_start[(A)]) /* the number of characters in string \# */
+
+@ The length of the current string is called |cur_length|.  If we decide that
+the current string is not needed, |flush_cur_string| resets |pool_ptr| so that
+|cur_length| becomes zero.
+
+@d cur_length   (mp->pool_ptr - mp->str_start[mp->str_ptr])
+@d flush_cur_string   mp->pool_ptr=mp->str_start[mp->str_ptr]
+
+@ Strings are created by appending character codes to |str_pool|.
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which tries to make sure there is enough room
+by compacting the string pool if necessary.  If this does not work,
+|do_compaction| aborts \MP\ and gives an apologetic error message.
+
+@d append_char(A)   /* put |ASCII_code| \# at the end of |str_pool| */
+{ mp->str_pool[mp->pool_ptr]=(A); incr(mp->pool_ptr);
+}
+@d str_room(A)   /* make sure that the pool hasn't overflowed */
+  { if ( mp->pool_ptr+(A) > mp->max_pool_ptr ) {
+    if ( mp->pool_ptr+(A) > mp->pool_size ) mp_do_compaction(mp, (A));
+    else mp->max_pool_ptr=mp->pool_ptr+(A); }
+  }
+
+@ The following routine is similar to |str_room(1)| but it uses the
+argument |mp->pool_size| to prevent |do_compaction| from aborting when
+string space is exhausted.
+
+@<Declare the procedure called |unit_str_room|@>=
+void mp_unit_str_room (MP mp);
+
+@ @c
+void mp_unit_str_room (MP mp) { 
+  if ( mp->pool_ptr>=mp->pool_size ) mp_do_compaction(mp, mp->pool_size);
+  if ( mp->pool_ptr>=mp->max_pool_ptr ) mp->max_pool_ptr=mp->pool_ptr+1;
+}
+
+@ \MP's string expressions are implemented in a brute-force way: Every
+new string or substring that is needed is simply copied into the string pool.
+Space is eventually reclaimed by a procedure called |do_compaction| with
+the aid of a simple system system of reference counts.
+@^reference counts@>
+
+The number of references to string number |s| will be |str_ref[s]|. The
+special value |str_ref[s]=max_str_ref=127| is used to denote an unknown
+positive number of references; such strings will never be recycled. If
+a string is ever referred to more than 126 times, simultaneously, we
+put it in this category. Hence a single byte suffices to store each |str_ref|.
+
+@d max_str_ref 127 /* ``infinite'' number of references */
+@d add_str_ref(A) { if ( mp->str_ref[(A)]<max_str_ref ) incr(mp->str_ref[(A)]);
+  }
+
+@<Glob...@>=
+int *str_ref;
+
+@ @<Allocate or initialize ...@>=
+mp->str_ref = xmalloc ((mp->max_strings+1),sizeof(int));
+
+@ @<Dealloc variables@>=
+xfree(mp->str_ref);
+
+@ Here's what we do when a string reference disappears:
+
+@d delete_str_ref(A)  { 
+    if ( mp->str_ref[(A)]<max_str_ref ) {
+       if ( mp->str_ref[(A)]>1 ) decr(mp->str_ref[(A)]); 
+       else mp_flush_string(mp, (A));
+    }
+  }
+
+@<Declare the procedure called |flush_string|@>=
+void mp_flush_string (MP mp,str_number s) ;
+
+
+@ We can't flush the first set of static strings at all, so there 
+is no point in trying
+
+@c
+void mp_flush_string (MP mp,str_number s) { 
+  if (length(s)>1) {
+    mp->pool_in_use=mp->pool_in_use-length(s);
+    decr(mp->strs_in_use);
+    if ( mp->next_str[s]!=mp->str_ptr ) {
+      mp->str_ref[s]=0;
+    } else { 
+      mp->str_ptr=s;
+      decr(mp->strs_used_up);
+    }
+    mp->pool_ptr=mp->str_start[mp->str_ptr];
+  }
+}
+
+@ C literals cannot be simply added, they need to be set so they can't
+be flushed.
+
+@d intern(A) mp_intern(mp,(A))
+
+@c
+str_number mp_intern (MP mp, const char *s) {
+  str_number r ;
+  r = rts(s);
+  mp->str_ref[r] = max_str_ref;
+  return r;
+}
+
+@ @<Declarations@>=
+str_number mp_intern (MP mp, const char *s);
+
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+When getting the next unused string number from the linked list, we pretend
+that
+$$ \hbox{|max_str_ptr+1|, |max_str_ptr+2|, $\ldots$, |mp->max_strings|} $$
+are linked sequentially even though the |next_str| entries have not been
+initialized yet.  We never allow |str_ptr| to reach |mp->max_strings|;
+|do_compaction| is responsible for making sure of this.
+
+@<Declarations@>=
+@<Declare the procedure called |do_compaction|@>
+@<Declare the procedure called |unit_str_room|@>
+str_number mp_make_string (MP mp);
+
+@ @c 
+str_number mp_make_string (MP mp) { /* current string enters the pool */
+  str_number s; /* the new string */
+RESTART: 
+  s=mp->str_ptr;
+  mp->str_ptr=mp->next_str[s];
+  if ( mp->str_ptr>mp->max_str_ptr ) {
+    if ( mp->str_ptr==mp->max_strings ) { 
+      mp->str_ptr=s;
+      mp_do_compaction(mp, 0);
+      goto RESTART;
+    } else {
+#ifdef DEBUG 
+      if ( mp->strs_used_up!=mp->max_str_ptr ) mp_confusion(mp, "s");
+@:this can't happen s}{\quad \.s@>
+#endif
+      mp->max_str_ptr=mp->str_ptr;
+      mp->next_str[mp->str_ptr]=mp->max_str_ptr+1;
+    }
+  }
+  mp->str_ref[s]=1;
+  mp->str_start[mp->str_ptr]=mp->pool_ptr;
+  incr(mp->strs_used_up);
+  incr(mp->strs_in_use);
+  mp->pool_in_use=mp->pool_in_use+length(s);
+  if ( mp->pool_in_use>mp->max_pl_used ) 
+    mp->max_pl_used=mp->pool_in_use;
+  if ( mp->strs_in_use>mp->max_strs_used ) 
+    mp->max_strs_used=mp->strs_in_use;
+  return s;
+}
+
+@ The most interesting string operation is string pool compaction.  The idea
+is to recover unused space in the |str_pool| array by recopying the strings
+to close the gaps created when some strings become unused.  All string
+numbers~$k$ where |str_ref[k]=0| are to be linked into the list of free string
+numbers after |str_ptr|.  If this fails to free enough pool space we issue an
+|overflow| error unless |needed=mp->pool_size|.  Calling |do_compaction|
+with |needed=mp->pool_size| supresses all overflow tests.
+
+The compaction process starts with |last_fixed_str| because all lower numbered
+strings are permanently allocated with |max_str_ref| in their |str_ref| entries.
+
+@<Glob...@>=
+str_number last_fixed_str; /* last permanently allocated string */
+str_number fixed_str_use; /* number of permanently allocated strings */
+
+@ @<Declare the procedure called |do_compaction|@>=
+void mp_do_compaction (MP mp, pool_pointer needed) ;
+
+@ @c
+void mp_do_compaction (MP mp, pool_pointer needed) {
+  str_number str_use; /* a count of strings in use */
+  str_number r,s,t; /* strings being manipulated */
+  pool_pointer p,q; /* destination and source for copying string characters */
+  @<Advance |last_fixed_str| as far as possible and set |str_use|@>;
+  r=mp->last_fixed_str;
+  s=mp->next_str[r];
+  p=mp->str_start[s];
+  while ( s!=mp->str_ptr ) { 
+    while ( mp->str_ref[s]==0 ) {
+      @<Advance |s| and add the old |s| to the list of free string numbers;
+        then |break| if |s=str_ptr|@>;
+    }
+    r=s; s=mp->next_str[s];
+    incr(str_use);
+    @<Move string |r| back so that |str_start[r]=p|; make |p| the location
+     after the end of the string@>;
+  }
+  @<Move the current string back so that it starts at |p|@>;
+  if ( needed<mp->pool_size ) {
+    @<Make sure that there is room for another string with |needed| characters@>;
+  }
+  @<Account for the compaction and make sure the statistics agree with the
+     global versions@>;
+  mp->strs_used_up=str_use;
+}
+
+@ @<Advance |last_fixed_str| as far as possible and set |str_use|@>=
+t=mp->next_str[mp->last_fixed_str];
+while (t!=mp->str_ptr && mp->str_ref[t]==max_str_ref) {
+  incr(mp->fixed_str_use);
+  mp->last_fixed_str=t;
+  t=mp->next_str[t];
+}
+str_use=mp->fixed_str_use
+
+@ Because of the way |flush_string| has been written, it should never be
+necessary to |break| here.  The extra line of code seems worthwhile to
+preserve the generality of |do_compaction|.
+
+@<Advance |s| and add the old |s| to the list of free string numbers;...@>=
+{
+t=s;
+s=mp->next_str[s];
+mp->next_str[r]=s;
+mp->next_str[t]=mp->next_str[mp->str_ptr];
+mp->next_str[mp->str_ptr]=t;
+if ( s==mp->str_ptr ) break;
+}
+
+@ The string currently starts at |str_start[r]| and ends just before
+|str_start[s]|.  We don't change |str_start[s]| because it might be needed
+to locate the next string.
+
+@<Move string |r| back so that |str_start[r]=p|; make |p| the location...@>=
+q=mp->str_start[r];
+mp->str_start[r]=p;
+while ( q<mp->str_start[s] ) { 
+  mp->str_pool[p]=mp->str_pool[q];
+  incr(p); incr(q);
+}
+
+@ Pointers |str_start[str_ptr]| and |pool_ptr| have not been updated.  When
+we do this, anything between them should be moved.
+
+@ @<Move the current string back so that it starts at |p|@>=
+q=mp->str_start[mp->str_ptr];
+mp->str_start[mp->str_ptr]=p;
+while ( q<mp->pool_ptr ) { 
+  mp->str_pool[p]=mp->str_pool[q];
+  incr(p); incr(q);
+}
+mp->pool_ptr=p
+
+@ We must remember that |str_ptr| is not allowed to reach |mp->max_strings|.
+
+@<Make sure that there is room for another string with |needed| char...@>=
+if ( str_use>=mp->max_strings-1 )
+  mp_reallocate_strings (mp,str_use);
+if ( mp->pool_ptr+needed>mp->max_pool_ptr ) {
+  mp_reallocate_pool(mp, mp->pool_ptr+needed);
+  mp->max_pool_ptr=mp->pool_ptr+needed;
+}
+
+@ @<Declarations@>=
+void mp_reallocate_strings (MP mp, str_number str_use) ;
+void mp_reallocate_pool(MP mp, pool_pointer needed) ;
+
+@ @c 
+void mp_reallocate_strings (MP mp, str_number str_use) { 
+  while ( str_use>=mp->max_strings-1 ) {
+    int l = mp->max_strings + (mp->max_strings>>2);
+    XREALLOC (mp->str_ref,   l, int);
+    XREALLOC (mp->str_start, l, pool_pointer);
+    XREALLOC (mp->next_str,  l, str_number);
+    mp->max_strings = l;
+  }
+}
+void mp_reallocate_pool(MP mp, pool_pointer needed) {
+  while ( needed>mp->pool_size ) {
+    int l = mp->pool_size + (mp->pool_size>>2);
+ 	XREALLOC (mp->str_pool, l, ASCII_code);
+    mp->pool_size = l;
+  }
+}
+
+@ @<Account for the compaction and make sure the statistics agree with...@>=
+if ( (mp->str_start[mp->str_ptr]!=mp->pool_in_use)||(str_use!=mp->strs_in_use) )
+  mp_confusion(mp, "string");
+@:this can't happen string}{\quad string@>
+incr(mp->pact_count);
+mp->pact_chars=mp->pact_chars+mp->pool_ptr-str_stop(mp->last_fixed_str);
+mp->pact_strs=mp->pact_strs+str_use-mp->fixed_str_use;
+#ifdef DEBUG
+s=mp->str_ptr; t=str_use;
+while ( s<=mp->max_str_ptr ){
+  if ( t>mp->max_str_ptr ) mp_confusion(mp, "\"");
+  incr(t); s=mp->next_str[s];
+};
+if ( t<=mp->max_str_ptr ) mp_confusion(mp, "\"");
+#endif
+
+@ A few more global variables are needed to keep track of statistics when
+|stat| $\ldots$ |tats| blocks are not commented out.
+
+@<Glob...@>=
+integer pact_count; /* number of string pool compactions so far */
+integer pact_chars; /* total number of characters moved during compactions */
+integer pact_strs; /* total number of strings moved during compactions */
+
+@ @<Initialize compaction statistics@>=
+mp->pact_count=0;
+mp->pact_chars=0;
+mp->pact_strs=0;
+
+@ The following subroutine compares string |s| with another string of the
+same length that appears in |buffer| starting at position |k|;
+the result is |true| if and only if the strings are equal.
+
+@c 
+boolean mp_str_eq_buf (MP mp,str_number s, integer k) {
+  /* test equality of strings */
+  pool_pointer j; /* running index */
+  j=mp->str_start[s];
+  while ( j<str_stop(s) ) { 
+    if ( mp->str_pool[j++]!=mp->buffer[k++] ) 
+      return false;
+  }
+  return true;
+}
+
+@ Here is a similar routine, but it compares two strings in the string pool,
+and it does not assume that they have the same length. If the first string
+is lexicographically greater than, less than, or equal to the second,
+the result is respectively positive, negative, or zero.
+
+@c 
+integer mp_str_vs_str (MP mp, str_number s, str_number t) {
+  /* test equality of strings */
+  pool_pointer j,k; /* running indices */
+  integer ls,lt; /* lengths */
+  integer l; /* length remaining to test */
+  ls=length(s); lt=length(t);
+  if ( ls<=lt ) l=ls; else l=lt;
+  j=mp->str_start[s]; k=mp->str_start[t];
+  while ( l-->0 ) { 
+    if ( mp->str_pool[j]!=mp->str_pool[k] ) {
+       return (mp->str_pool[j]-mp->str_pool[k]); 
+    }
+    incr(j); incr(k);
+  }
+  return (ls-lt);
+}
+
+@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
+and |str_ptr| are computed by the \.{INIMP} program, based in part
+on the information that \.{WEB} has output while processing \MP.
+@.INIMP@>
+@^string pool@>
+
+@c 
+void mp_get_strings_started (MP mp) { 
+  /* initializes the string pool,
+    but returns |false| if something goes wrong */
+  int k; /* small indices or counters */
+  str_number g; /* a new string */
+  mp->pool_ptr=0; mp->str_ptr=0; mp->max_pool_ptr=0; mp->max_str_ptr=0;
+  mp->str_start[0]=0;
+  mp->next_str[0]=1;
+  mp->pool_in_use=0; mp->strs_in_use=0;
+  mp->max_pl_used=0; mp->max_strs_used=0;
+  @<Initialize compaction statistics@>;
+  mp->strs_used_up=0;
+  @<Make the first 256 strings@>;
+  g=mp_make_string(mp); /* string 256 == "" */
+  mp->str_ref[g]=max_str_ref;
+  mp->last_fixed_str=mp->str_ptr-1;
+  mp->fixed_str_use=mp->str_ptr;
+  return;
+}
+
+@ @<Declarations@>=
+void mp_get_strings_started (MP mp);
+
+@ The first 256 strings will consist of a single character only.
+
+@<Make the first 256...@>=
+for (k=0;k<=255;k++) { 
+  append_char(k);
+  g=mp_make_string(mp); 
+  mp->str_ref[g]=max_str_ref;
+}
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[032]=@t\.{'^^Z'}@>|,
+would like string 032 to be printed as the single character 032 instead
+of the three characters 0136, 0136, 0132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+015 by \.{\^\^M}, since 015 is ASCII's ``carriage return'' code; the idea is
+to produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+The boolean expression defined here should be |true| unless \MP\ internal
+code number~|k| corresponds to a non-troublesome visible symbol in the
+local character set.
+If character |k| cannot be printed, and |k<0200|, then character |k+0100| or
+|k-0100| must be printable; moreover, ASCII codes |[060..071, 0141..0146]|
+must be printable.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Character |k| cannot be printed@>=
+  (k<' ')||(k>'~')
+
+@* \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `|print|' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable |selector|, which has the following possible
+values:
+
+\yskip
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+  transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases
+  before the transcript file is open.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used
+  by the |show_context| routine; when we get to that routine we shall discuss
+  the reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the
+  string pool.
+
+\hang |>=write_file| prints on one of the files used for the \&{write}
+@:write_}{\&{write} primitive@>
+  command.
+
+\yskip
+\noindent The symbolic names `|term_and_log|', etc., have been assigned
+numeric codes that satisfy the convenient relations |no_print+1=term_only|,
+|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.  These
+relations are not used when |selector| could be |pseudo|, or |new_string|.
+We need not check for unprintable characters when |selector<pseudo|.
+
+Three additional global variables, |tally|, |term_offset| and |file_offset|
+record the number of characters that have been printed
+since they were most recently cleared to zero. We use |tally| to record
+the length of (possibly very long) stretches of printing; |term_offset|,
+and |file_offset|, on the other hand, keep track of how many
+characters have appeared so far on the current line that has been output
+to the terminal, the transcript file, or the \ps\ output file, respectively.
+
+@d new_string 0 /* printing is deflected to the string pool */
+@d pseudo 2 /* special |selector| setting for |show_context| */
+@d no_print 3 /* |selector| setting that makes data disappear */
+@d term_only 4 /* printing is destined for the terminal only */
+@d log_only 5 /* printing is destined for the transcript file only */
+@d term_and_log 6 /* normal |selector| setting */
+@d write_file 7 /* first write file selector */
+
+@<Glob...@>=
+void * log_file; /* transcript of \MP\ session */
+void * ps_file; /* the generic font output goes here */
+unsigned int selector; /* where to print a message */
+unsigned char dig[23]; /* digits in a number being output */
+integer tally; /* the number of characters recently printed */
+unsigned int term_offset;
+  /* the number of characters on the current terminal line */
+unsigned int file_offset;
+  /* the number of characters on the current file line */
+ASCII_code *trick_buf; /* circular buffer for pseudoprinting */
+integer trick_count; /* threshold for pseudoprinting, explained later */
+integer first_count; /* another variable for pseudoprinting */
+
+@ @<Allocate or initialize ...@>=
+memset(mp->dig,0,23);
+mp->trick_buf = xmalloc((mp->error_line+1),sizeof(ASCII_code));
+
+@ @<Dealloc variables@>=
+xfree(mp->trick_buf);
+
+@ @<Initialize the output routines@>=
+mp->selector=term_only; mp->tally=0; mp->term_offset=0; mp->file_offset=0; 
+
+@ Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing |wterm|, |wterm_ln|, and |wterm_cr| here.
+@^system dependencies@>
+
+@d do_fprintf(f,b) (mp->write_ascii_file)(mp,f,b)
+@d wterm(A)     do_fprintf(mp->term_out,(A))
+@d wterm_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]=0; do_fprintf(mp->term_out,(char *)ss); }
+@d wterm_cr     do_fprintf(mp->term_out,"\n")
+@d wterm_ln(A)  { wterm_cr; do_fprintf(mp->term_out,(A)); }
+@d wlog(A)      do_fprintf(mp->log_file,(A))
+@d wlog_chr(A)  { unsigned char ss[2]; ss[0]=(A); ss[1]=0; do_fprintf(mp->log_file,(char *)ss); }
+@d wlog_cr      do_fprintf(mp->log_file, "\n")
+@d wlog_ln(A)   { wlog_cr; do_fprintf(mp->log_file,(A)); }
+
+
+@ To end a line of text output, we call |print_ln|.  Cases |0..max_write_files|
+use an array |wr_file| that will be declared later.
+
+@d mp_print_text(A) mp_print_str(mp,text((A)))
+
+@<Internal ...@>=
+void mp_print_ln (MP mp);
+void mp_print_visible_char (MP mp, ASCII_code s); 
+void mp_print_char (MP mp, ASCII_code k);
+void mp_print (MP mp, const char *s);
+void mp_print_str (MP mp, str_number s);
+void mp_print_nl (MP mp, const char *s);
+void mp_print_two (MP mp,scaled x, scaled y) ;
+void mp_print_scaled (MP mp,scaled s);
+
+@ @<Basic print...@>=
+void mp_print_ln (MP mp) { /* prints an end-of-line */
+ switch (mp->selector) {
+  case term_and_log: 
+    wterm_cr; wlog_cr;
+    mp->term_offset=0;  mp->file_offset=0;
+    break;
+  case log_only: 
+    wlog_cr; mp->file_offset=0;
+    break;
+  case term_only: 
+    wterm_cr; mp->term_offset=0;
+    break;
+  case no_print:
+  case pseudo: 
+  case new_string: 
+    break;
+  default: 
+    do_fprintf(mp->wr_file[(mp->selector-write_file)],"\n");
+  }
+} /* note that |tally| is not affected */
+
+@ The |print_visible_char| procedure sends one character to the desired
+destination, using the |xchr| array to map it into an external character
+compatible with |input_ln|.  (It assumes that it is always called with
+a visible ASCII character.)  All printing comes through |print_ln| or
+|print_char|, which ultimately calls |print_visible_char|, hence these
+routines are the ones that limit lines to at most |max_print_line| characters.
+But we must make an exception for the \ps\ output file since it is not safe
+to cut up lines arbitrarily in \ps.
+
+Procedure |unit_str_room| needs to be declared |forward| here because it calls
+|do_compaction| and |do_compaction| can call the error routines.  Actually,
+|unit_str_room| avoids |overflow| errors but it can call |confusion|.
+
+@<Basic printing...@>=
+void mp_print_visible_char (MP mp, ASCII_code s) { /* prints a single character */
+  switch (mp->selector) {
+  case term_and_log: 
+    wterm_chr(xchr(s)); wlog_chr(xchr(s));
+    incr(mp->term_offset); incr(mp->file_offset);
+    if ( mp->term_offset==(unsigned)mp->max_print_line ) { 
+       wterm_cr; mp->term_offset=0;
+    };
+    if ( mp->file_offset==(unsigned)mp->max_print_line ) { 
+       wlog_cr; mp->file_offset=0;
+    };
+    break;
+  case log_only: 
+    wlog_chr(xchr(s)); incr(mp->file_offset);
+    if ( mp->file_offset==(unsigned)mp->max_print_line ) mp_print_ln(mp);
+    break;
+  case term_only: 
+    wterm_chr(xchr(s)); incr(mp->term_offset);
+    if ( mp->term_offset==(unsigned)mp->max_print_line ) mp_print_ln(mp);
+    break;
+  case no_print: 
+    break;
+  case pseudo: 
+    if ( mp->tally<mp->trick_count ) 
+      mp->trick_buf[mp->tally % mp->error_line]=s;
+    break;
+  case new_string: 
+    if ( mp->pool_ptr>=mp->max_pool_ptr ) { 
+      mp_unit_str_room(mp);
+      if ( mp->pool_ptr>=mp->pool_size ) 
+        goto DONE; /* drop characters if string space is full */
+    };
+    append_char(s);
+    break;
+  default:
+    { char ss[2]; ss[0] = xchr(s); ss[1]=0;
+      do_fprintf(mp->wr_file[(mp->selector-write_file)],(char *)ss);
+    }
+  }
+DONE:
+  incr(mp->tally);
+}
+
+@ The |print_char| procedure sends one character to the desired destination.
+File names and string expressions might contain |ASCII_code| values that
+can't be printed using |print_visible_char|.  These characters will be
+printed in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}'.
+(This procedure assumes that it is safe to bypass all checks for unprintable
+characters when |selector| is in the range |0..max_write_files-1|.
+The user might want to write unprintable characters.
+
+@d print_lc_hex(A) do { l=(A);
+    mp_print_visible_char(mp, (l<10 ? l+'0' : l-10+'a'));
+  } while (0)
+
+@<Basic printing...@>=
+void mp_print_char (MP mp, ASCII_code k) { /* prints a single character */
+  int l; /* small index or counter */
+  if ( mp->selector<pseudo || mp->selector>=write_file) {
+    mp_print_visible_char(mp, k);
+  } else if ( @<Character |k| cannot be printed@> ) { 
+    mp_print(mp, "^^"); 
+    if ( k<0100 ) { 
+      mp_print_visible_char(mp, k+0100); 
+    } else if ( k<0200 ) { 
+      mp_print_visible_char(mp, k-0100); 
+    } else { 
+      print_lc_hex(k / 16);  
+      print_lc_hex(k % 16); 
+    }
+  } else {
+    mp_print_visible_char(mp, k);
+  }
+}
+
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \MP\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+@<Basic print...@>=
+void mp_do_print (MP mp, const char *ss, unsigned int len) { /* prints string |s| */
+  unsigned int j = 0;
+  while ( j<len ){ 
+    mp_print_char(mp, ss[j]); incr(j);
+  }
+}
+
+@ 
+@<Basic print...@>=
+void mp_print (MP mp, const char *ss) {
+  mp_do_print(mp, ss, strlen(ss));
+}
+void mp_print_str (MP mp, str_number s) {
+  pool_pointer j; /* current character code position */
+  if ( (s<0)||(s>mp->max_str_ptr) ) {
+     mp_do_print(mp,"???",3); /* this can't happen */
+@.???@>
+  }
+  j=mp->str_start[s];
+  mp_do_print(mp, (char *)(mp->str_pool+j), (str_stop(s)-j));
+}
+
+
+@ Here is the very first thing that \MP\ prints: a headline that identifies
+the version number and base name. The |term_offset| variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and mem identifier together will occupy at most |max_print_line|
+character positions.
+
+@<Initialize the output...@>=
+wterm (banner);
+wterm (version_string);
+if (mp->mem_ident!=NULL) 
+  mp_print(mp,mp->mem_ident); 
+mp_print_ln(mp);
+update_terminal;
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line.
+
+@<Basic print...@>=
+void mp_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */
+  switch(mp->selector) {
+  case term_and_log: 
+    if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_ln(mp);
+    break;
+  case log_only: 
+    if ( mp->file_offset>0 ) mp_print_ln(mp);
+    break;
+  case term_only: 
+    if ( mp->term_offset>0 ) mp_print_ln(mp);
+    break;
+  case no_print:
+  case pseudo:
+  case new_string: 
+	break;
+  } /* there are no other cases */
+  mp_print(mp, s);
+}
+
+@ An array of digits in the range |0..9| is printed by |print_the_digs|.
+
+@<Basic print...@>=
+void mp_print_the_digs (MP mp, eight_bits k) {
+  /* prints |dig[k-1]|$\,\ldots\,$|dig[0]| */
+  while ( k>0 ){ 
+    decr(k); mp_print_char(mp, '0'+mp->dig[k]);
+  }
+}
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |%| or |/|
+to negative arguments, since such operations are not implemented consistently
+on all platforms.
+
+@<Basic print...@>=
+void mp_print_int (MP mp,integer n) { /* prints an integer in decimal form */
+  integer m; /* used to negate |n| in possibly dangerous cases */
+  int k = 0; /* index to current digit; we assume that $|n|<10^{23}$ */
+  if ( n<0 ) { 
+    mp_print_char(mp, '-');
+    if ( n>-100000000 ) {
+	  negate(n);
+    } else  { 
+	  m=-1-n; n=m / 10; m=(m % 10)+1; k=1;
+      if ( m<10 ) {
+        mp->dig[0]=m;
+      } else { 
+        mp->dig[0]=0; incr(n);
+      }
+    }
+  }
+  do {  
+    mp->dig[k]=n % 10; n=n / 10; incr(k);
+  } while (n!=0);
+  mp_print_the_digs(mp, k);
+}
+
+@ @<Internal ...@>=
+void mp_print_int (MP mp,integer n);
+
+@ \MP\ also makes use of a trivial procedure to print two digits. The
+following subroutine is usually called with a parameter in the range |0<=n<=99|.
+
+@c 
+void mp_print_dd (MP mp,integer n) { /* prints two least significant digits */
+  n=abs(n) % 100; 
+  mp_print_char(mp, '0'+(n / 10));
+  mp_print_char(mp, '0'+(n % 10));
+}
+
+
+@ @<Internal ...@>=
+void mp_print_dd (MP mp,integer n);
+
+@ Here is a procedure that asks the user to type a line of input,
+assuming that the |selector| setting is either |term_only| or |term_and_log|.
+The input is placed into locations |first| through |last-1| of the
+|buffer| array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when |interaction<mp_scroll_mode|.
+
+@d prompt_input(A) do { 
+    if (!mp->noninteractive) {
+      wake_up_terminal; mp_print(mp, (A)); 
+    }
+    mp_term_input(mp);
+  } while (0) /* prints a string and gets a line of input */
+
+@c 
+void mp_term_input (MP mp) { /* gets a line from the terminal */
+  size_t k; /* index into |buffer| */
+  update_terminal; /* Now the user sees the prompt for sure */
+  if (!mp_input_ln(mp, mp->term_in )) {
+    if (!mp->noninteractive) {
+	  mp_fatal_error(mp, "End of file on the terminal!");
+@.End of file on the terminal@>
+    } else { /* we are done with this input chunk */
+	  longjmp(mp->jump_buf,1);      
+    }
+  }
+  if (!mp->noninteractive) {
+    mp->term_offset=0; /* the user's line ended with \<\rm return> */
+    decr(mp->selector); /* prepare to echo the input */
+    if ( mp->last!=mp->first ) {
+      for (k=mp->first;k<=mp->last-1;k++) {
+        mp_print_char(mp, mp->buffer[k]);
+      }
+    }
+    mp_print_ln(mp); 
+    mp->buffer[mp->last]='%'; 
+    incr(mp->selector); /* restore previous status */
+  }
+}
+
+@* \[6] Reporting errors.
+When something anomalous is detected, \MP\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+|print_err("Something anomalous has been detected");|\cr
+|help3("This is the first line of my offer to help.")|\cr
+|("This is the second line. I'm trying to")|\cr
+|("explain the best way for you to proceed.");|\cr
+|error;|\cr}}$$
+A two-line help message would be given using |help2|, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that |max_print_line| will not be exceeded.)
+
+The |print_err| procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The |error| procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if |interaction=error_stop_mode|,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+@^system dependencies@>
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@<Exported types@>=
+enum mp_interaction_mode { 
+ mp_unspecified_mode=0, /* extra value for command-line switch */
+ mp_batch_mode, /* omits all stops and omits terminal output */
+ mp_nonstop_mode, /* omits all stops */
+ mp_scroll_mode, /* omits error stops */
+ mp_error_stop_mode /* stops at every opportunity to interact */
+};
+
+@ @<Option variables@>=
+int interaction; /* current level of interaction */
+int noninteractive; /* do we have a terminal? */
+
+@ Set it here so it can be overwritten by the commandline
+
+@<Allocate or initialize ...@>=
+mp->interaction=opt->interaction;
+if (mp->interaction==mp_unspecified_mode || mp->interaction>mp_error_stop_mode) 
+  mp->interaction=mp_error_stop_mode;
+if (mp->interaction<mp_unspecified_mode) 
+  mp->interaction=mp_batch_mode;
+mp->noninteractive=opt->noninteractive;
+
+@ 
+
+@d print_err(A) mp_print_err(mp,(A))
+
+@<Internal ...@>=
+void mp_print_err(MP mp, const char * A);
+
+@ @c
+void mp_print_err(MP mp, const char * A) { 
+  if ( mp->interaction==mp_error_stop_mode ) 
+    wake_up_terminal;
+  mp_print_nl(mp, "! "); 
+  mp_print(mp, A);
+@.!\relax@>
+}
+
+
+@ \MP\ is careful not to call |error| when the print |selector| setting
+might be unusual. The only possible values of |selector| at the time of
+error messages are
+
+\yskip\hang|no_print| (when |interaction=mp_batch_mode|
+  and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>mp_batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=mp_batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>mp_batch_mode| and |log_file| is open).
+
+@<Initialize the print |selector| based on |interaction|@>=
+if ( mp->interaction==mp_batch_mode ) mp->selector=no_print; else mp->selector=term_only
+
+@ A global variable |deletions_allowed| is set |false| if the |get_next|
+routine is active when |error| is called; this ensures that |get_next|
+will never be called recursively.
+@^recursion@>
+
+The global variable |history| records the worst level of error that
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an
+|error| occurs without an interactive dialog, and it is reset to zero at
+the end of every statement.  If |error_count| reaches 100, \MP\ decides
+that there is no point in continuing further.
+
+@<Types...@>=
+enum mp_history_states {
+  mp_spotless=0, /* |history| value when nothing has been amiss yet */
+  mp_warning_issued, /* |history| value when |begin_diagnostic| has been called */
+  mp_error_message_issued, /* |history| value when |error| has been called */
+  mp_fatal_error_stop /* |history| value when termination was premature */
+};
+
+@ @<Glob...@>=
+boolean deletions_allowed; /* is it safe for |error| to call |get_next|? */
+int history; /* has the source input been clean so far? */
+int error_count; /* the number of scrolled errors since the last statement ended */
+
+@ The value of |history| is initially |fatal_error_stop|, but it will
+be changed to |spotless| if \MP\ survives the initialization process.
+
+@<Allocate or ...@>=
+mp->deletions_allowed=true; mp->error_count=0; /* |history| is initialized elsewhere */
+
+@ Since errors can be detected almost anywhere in \MP, we want to declare the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared |forward|
+before we get to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises
+when |get_next| is being used to delete a token, and/or if some fatal error
+occurs while \MP\ is trying to fix a non-fatal one. But such recursion
+@^recursion@>
+is never more than two levels deep.
+
+@<Declarations@>=
+void mp_get_next (MP mp);
+void mp_term_input (MP mp);
+void mp_show_context (MP mp);
+void mp_begin_file_reading (MP mp);
+void mp_open_log_file (MP mp);
+void mp_clear_for_error_prompt (MP mp);
+void mp_debug_help (MP mp);
+@<Declare the procedure called |flush_string|@>
+
+@ @<Internal ...@>=
+void mp_normalize_selector (MP mp);
+
+@ Individual lines of help are recorded in the array |help_line|, which
+contains entries in positions |0..(help_ptr-1)|. They should be printed
+in reverse order, i.e., with |help_line[0]| appearing last.
+
+@d hlp1(A) mp->help_line[0]=(A); }
+@d hlp2(A) mp->help_line[1]=(A); hlp1
+@d hlp3(A) mp->help_line[2]=(A); hlp2
+@d hlp4(A) mp->help_line[3]=(A); hlp3
+@d hlp5(A) mp->help_line[4]=(A); hlp4
+@d hlp6(A) mp->help_line[5]=(A); hlp5
+@d help0 mp->help_ptr=0 /* sometimes there might be no help */
+@d help1  { mp->help_ptr=1; hlp1 /* use this with one help line */
+@d help2  { mp->help_ptr=2; hlp2 /* use this with two help lines */
+@d help3  { mp->help_ptr=3; hlp3 /* use this with three help lines */
+@d help4  { mp->help_ptr=4; hlp4 /* use this with four help lines */
+@d help5  { mp->help_ptr=5; hlp5 /* use this with five help lines */
+@d help6  { mp->help_ptr=6; hlp6 /* use this with six help lines */
+
+@<Glob...@>=
+const char * help_line[6]; /* helps for the next |error| */
+unsigned int help_ptr; /* the number of help lines present */
+boolean use_err_help; /* should the |err_help| string be shown? */
+str_number err_help; /* a string set up by \&{errhelp} */
+str_number filename_template; /* a string set up by \&{filenametemplate} */
+
+@ @<Allocate or ...@>=
+mp->help_ptr=0; mp->use_err_help=false; mp->err_help=0; mp->filename_template=0;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and
+goes to |end_of_MP|. This is the only nonlocal |goto| statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+The program uses a |jump_buf| to handle this, this is initialized at three
+spots: the start of |mp_new|, the start of |mp_initialize|, and the start 
+of |mp_run|. Those are the only library enty points.
+
+@^system dependencies@>
+
+@<Glob...@>=
+jmp_buf jump_buf;
+
+@ @<Install and test the non-local jump buffer@>=
+if (setjmp(mp->jump_buf) != 0) { return mp->history; }
+
+@ @<Setup the non-local jump buffer in |mp_new|@>=
+if (setjmp(mp->jump_buf) != 0) return NULL;
+
+
+@ If the array of internals is still |NULL| when |jump_out| is called, a
+crash occured during initialization, and it is not safe to run the normal
+cleanup routine.
+
+@<Error hand...@>=
+void mp_jump_out (MP mp) { 
+  if(mp->internal!=NULL)
+    mp_close_files_and_terminate(mp);
+  longjmp(mp->jump_buf,1);
+}
+
+@ Here now is the general |error| routine.
+
+@<Error hand...@>=
+void mp_error (MP mp) { /* completes the job of error reporting */
+  ASCII_code c; /* what the user types */
+  integer s1,s2,s3; /* used to save global variables when deleting tokens */
+  pool_pointer j; /* character position being printed */
+  if ( mp->history<mp_error_message_issued ) 
+	mp->history=mp_error_message_issued;
+  mp_print_char(mp, '.'); mp_show_context(mp);
+  if ((!mp->noninteractive) && (mp->interaction==mp_error_stop_mode )) {
+    @<Get user's advice and |return|@>;
+  }
+  incr(mp->error_count);
+  if ( mp->error_count==100 ) { 
+    mp_print_nl(mp,"(That makes 100 errors; please try again.)");
+@.That makes 100 errors...@>
+    mp->history=mp_fatal_error_stop; mp_jump_out(mp);
+  }
+  @<Put help message on the transcript file@>;
+}
+void mp_warn (MP mp, const char *msg) {
+  int saved_selector = mp->selector;
+  mp_normalize_selector(mp);
+  mp_print_nl(mp,"Warning: ");
+  mp_print(mp,msg);
+  mp_print_ln(mp);
+  mp->selector = saved_selector;
+}
+
+@ @<Exported function ...@>=
+void mp_error (MP mp);
+void mp_warn (MP mp, const char *msg);
+
+
+@ @<Get user's advice...@>=
+while (1) { 
+CONTINUE:
+  mp_clear_for_error_prompt(mp); prompt_input("? ");
+@.?\relax@>
+  if ( mp->last==mp->first ) return;
+  c=mp->buffer[mp->first];
+  if ( c>='a' ) c=c+'A'-'a'; /* convert to uppercase */
+  @<Interpret code |c| and |return| if done@>;
+}
+
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \MP\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+@<Exported types@>=
+typedef void (*mp_run_editor_command)(MP, char *, int);
+
+@ @<Option variables@>=
+mp_run_editor_command run_editor;
+
+@ @<Allocate or initialize ...@>=
+set_callback_option(run_editor);
+
+@ @<Declarations@>=
+void mp_run_editor (MP mp, char *fname, int fline);
+
+@ @c void mp_run_editor (MP mp, char *fname, int fline) {
+    mp_print_nl(mp, "You want to edit file ");
+@.You want to edit file x@>
+    mp_print(mp, fname);
+    mp_print(mp, " at line "); 
+    mp_print_int(mp, fline);
+    mp->interaction=mp_scroll_mode; 
+    mp_jump_out(mp);
+}
+
+@ 
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+switch (c) {
+case '0': case '1': case '2': case '3': case '4':
+case '5': case '6': case '7': case '8': case '9': 
+  if ( mp->deletions_allowed ) {
+    @<Delete |c-"0"| tokens and |continue|@>;
+  }
+  break;
+#ifdef DEBUG
+case 'D': 
+  mp_debug_help(mp); continue; 
+  break;
+#endif
+case 'E': 
+  if ( mp->file_ptr>0 ){ 
+    (mp->run_editor)(mp, 
+                     str(mp->input_stack[mp->file_ptr].name_field), 
+                     mp_true_line(mp));
+  }
+  break;
+case 'H': 
+  @<Print the help information and |continue|@>;
+  break;
+case 'I':
+  @<Introduce new material from the terminal and |return|@>;
+  break;
+case 'Q': case 'R': case 'S':
+  @<Change the interaction level and |return|@>;
+  break;
+case 'X':
+  mp->interaction=mp_scroll_mode; mp_jump_out(mp);
+  break;
+default:
+  break;
+}
+@<Print the menu of available options@>
+
+@ @<Print the menu...@>=
+{ 
+  mp_print(mp, "Type <return> to proceed, S to scroll future error messages,");
+@.Type <return> to proceed...@>
+  mp_print_nl(mp, "R to run without stopping, Q to run quietly,");
+  mp_print_nl(mp, "I to insert something, ");
+  if ( mp->file_ptr>0 ) 
+    mp_print(mp, "E to edit your file,");
+  if ( mp->deletions_allowed )
+    mp_print_nl(mp, "1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
+  mp_print_nl(mp, "H for help, X to quit.");
+}
+
+@ Here the author of \MP\ apologizes for making use of the numerical
+relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
+|mp_batch_mode|, |mp_nonstop_mode|, |mp_scroll_mode|.
+@^Knuth, Donald Ervin@>
+
+@<Change the interaction...@>=
+{ 
+  mp->error_count=0; mp->interaction=mp_batch_mode+c-'Q';
+  mp_print(mp, "OK, entering ");
+  switch (c) {
+  case 'Q': mp_print(mp, "batchmode"); decr(mp->selector); break;
+  case 'R': mp_print(mp, "nonstopmode"); break;
+  case 'S': mp_print(mp, "scrollmode"); break;
+  } /* there are no other cases */
+  mp_print(mp, "..."); mp_print_ln(mp); update_terminal; return;
+}
+
+@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \MP's input stacks.
+
+@<Introduce new material...@>=
+{ 
+  mp_begin_file_reading(mp); /* enter a new syntactic level for terminal input */
+  if ( mp->last>mp->first+1 ) { 
+    loc=mp->first+1; mp->buffer[mp->first]=' ';
+  } else { 
+   prompt_input("insert>"); loc=mp->first;
+@.insert>@>
+  };
+  mp->first=mp->last+1; mp->cur_input.limit_field=mp->last; return;
+}
+
+@ We allow deletion of up to 99 tokens at a time.
+
+@<Delete |c-"0"| tokens...@>=
+{ 
+  s1=mp->cur_cmd; s2=mp->cur_mod; s3=mp->cur_sym; mp->OK_to_interrupt=false;
+  if ( (mp->last>mp->first+1) && (mp->buffer[mp->first+1]>='0')&&(mp->buffer[mp->first+1]<='9') )
+    c=c*10+mp->buffer[mp->first+1]-'0'*11;
+  else 
+    c=c-'0';
+  while ( c>0 ) { 
+    mp_get_next(mp); /* one-level recursive call of |error| is possible */
+    @<Decrease the string reference count, if the current token is a string@>;
+    decr(c);
+  };
+  mp->cur_cmd=s1; mp->cur_mod=s2; mp->cur_sym=s3; mp->OK_to_interrupt=true;
+  help2("I have just deleted some text, as you asked.")
+       ("You can now delete more, or insert, or whatever.");
+  mp_show_context(mp); 
+  goto CONTINUE;
+}
+
+@ @<Print the help info...@>=
+{ 
+  if ( mp->use_err_help ) { 
+    @<Print the string |err_help|, possibly on several lines@>;
+    mp->use_err_help=false;
+  } else { 
+    if ( mp->help_ptr==0 ) {
+      help2("Sorry, I don't know how to help in this situation.")
+           ("Maybe you should try asking a human?");
+     }
+    do { 
+      decr(mp->help_ptr); mp_print(mp, mp->help_line[mp->help_ptr]); mp_print_ln(mp);
+    } while (mp->help_ptr!=0);
+  };
+  help4("Sorry, I already gave what help I could...")
+       ("Maybe you should try asking a human?")
+       ("An error might have occurred before I noticed any problems.")
+       ("``If all else fails, read the instructions.''");
+  goto CONTINUE;
+}
+
+@ @<Print the string |err_help|, possibly on several lines@>=
+j=mp->str_start[mp->err_help];
+while ( j<str_stop(mp->err_help) ) { 
+  if ( mp->str_pool[j]!='%' ) mp_print_str(mp, mp->str_pool[j]);
+  else if ( j+1==str_stop(mp->err_help) ) mp_print_ln(mp);
+  else if ( mp->str_pool[j+1]!='%' ) mp_print_ln(mp);
+  else  { incr(j); mp_print_char(mp, '%'); };
+  incr(j);
+}
+
+@ @<Put help message on the transcript file@>=
+if ( mp->interaction>mp_batch_mode ) decr(mp->selector); /* avoid terminal output */
+if ( mp->use_err_help ) { 
+  mp_print_nl(mp, "");
+  @<Print the string |err_help|, possibly on several lines@>;
+} else { 
+  while ( mp->help_ptr>0 ){ 
+    decr(mp->help_ptr); mp_print_nl(mp, mp->help_line[mp->help_ptr]);
+  };
+}
+mp_print_ln(mp);
+if ( mp->interaction>mp_batch_mode ) incr(mp->selector); /* re-enable terminal output */
+mp_print_ln(mp)
+
+@ In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+@c 
+void mp_normalize_selector (MP mp) { 
+  if ( mp->log_opened ) mp->selector=term_and_log;
+  else mp->selector=term_only;
+  if ( mp->job_name==NULL ) mp_open_log_file(mp);
+  if ( mp->interaction==mp_batch_mode ) decr(mp->selector);
+}
+
+@ The following procedure prints \MP's last words before dying.
+
+@d succumb { if ( mp->interaction==mp_error_stop_mode )
+    mp->interaction=mp_scroll_mode; /* no more interaction */
+  if ( mp->log_opened ) mp_error(mp);
+  /*| if ( mp->interaction>mp_batch_mode ) mp_debug_help(mp); |*/
+  mp->history=mp_fatal_error_stop; mp_jump_out(mp); /* irrecoverable error */
+  }
+
+@<Error hand...@>=
+void mp_fatal_error (MP mp, const char *s) { /* prints |s|, and that's it */
+  mp_normalize_selector(mp);
+  print_err("Emergency stop"); help1(s); succumb;
+@.Emergency stop@>
+}
+
+@ @<Exported function ...@>=
+void mp_fatal_error (MP mp, const char *s);
+
+
+@ Here is the most dreaded error message.
+
+@<Error hand...@>=
+void mp_overflow (MP mp, const char *s, integer n) { /* stop due to finiteness */
+  mp_normalize_selector(mp);
+  print_err("MetaPost capacity exceeded, sorry [");
+@.MetaPost capacity exceeded ...@>
+  mp_print(mp, s); mp_print_char(mp, '='); mp_print_int(mp, n); mp_print_char(mp, ']');
+  help2("If you really absolutely need more capacity,")
+       ("you can ask a wizard to enlarge me.");
+  succumb;
+}
+
+@ @<Internal library declarations@>=
+void mp_overflow (MP mp, const char *s, integer n);
+
+@ The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \MP\
+maintenance person instead of the user (unless the user has been
+particularly diabolical).  The index entries for `this can't happen' may
+help to pinpoint the problem.
+@^dry rot@>
+
+@<Internal library ...@>=
+void mp_confusion (MP mp, const char *s);
+
+@ @<Error hand...@>=
+void mp_confusion (MP mp, const char *s) {
+  /* consistency check violated; |s| tells where */
+  mp_normalize_selector(mp);
+  if ( mp->history<mp_error_message_issued ) { 
+    print_err("This can't happen ("); mp_print(mp, s); mp_print_char(mp, ')');
+@.This can't happen@>
+    help1("I'm broken. Please show this to someone who can fix can fix");
+  } else { 
+    print_err("I can\'t go on meeting you like this");
+@.I can't go on...@>
+    help2("One of your faux pas seems to have wounded me deeply...")
+         ("in fact, I'm barely conscious. Please fix it and try again.");
+  }
+  succumb;
+}
+
+@ Users occasionally want to interrupt \MP\ while it's running.
+If the runtime system allows this, one can implement
+a routine that sets the global variable |interrupt| to some nonzero value
+when such an interrupt is signaled. Otherwise there is probably at least
+a way to make |interrupt| nonzero using the C debugger.
+@^system dependencies@>
+@^debugging@>
+
+@d check_interrupt { if ( mp->interrupt!=0 )
+   mp_pause_for_instructions(mp); }
+
+@<Global...@>=
+integer interrupt; /* should \MP\ pause for instructions? */
+boolean OK_to_interrupt; /* should interrupts be observed? */
+integer run_state; /* are we processing input ?*/
+
+@ @<Allocate or ...@>=
+mp->interrupt=0; mp->OK_to_interrupt=true; mp->run_state=0; 
+
+@ When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have the full flexibility of
+the |error| routine.  \MP\ checks for interrupts only at times when it is
+safe to do this.
+
+@c 
+void mp_pause_for_instructions (MP mp) { 
+  if ( mp->OK_to_interrupt ) { 
+    mp->interaction=mp_error_stop_mode;
+    if ( (mp->selector==log_only)||(mp->selector==no_print) )
+      incr(mp->selector);
+    print_err("Interruption");
+@.Interruption@>
+    help3("You rang?")
+         ("Try to insert some instructions for me (e.g.,`I show x'),")
+         ("unless you just want to quit by typing `X'.");
+    mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true;
+    mp->interrupt=0;
+  }
+}
+
+@ Many of \MP's error messages state that a missing token has been
+inserted behind the scenes. We can save string space and program space
+by putting this common code into a subroutine.
+
+@c 
+void mp_missing_err (MP mp, const char *s) { 
+  print_err("Missing `"); mp_print(mp, s); mp_print(mp, "' has been inserted");
+@.Missing...inserted@>
+}
+
+@* \[7] Arithmetic with scaled numbers.
+The principal computations performed by \MP\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones.
+@^small computers@>
+
+But C does not rigidly define the |/| operation in the case of negative
+dividends; for example, the result of |(-2*n-1) / 2| is |-(n+1)| on some
+computers and |-n| on others (is this true ?).  There are two principal
+types of arithmetic: ``translation-preserving,'' in which the identity
+|(a+q*b)/b=(a/b)+q| is valid; and ``negation-preserving,'' in which
+|(-a)/b=-(a/b)|. This leads to two \MP s, which can produce
+different results, although the differences should be negligible when the
+language is being used properly.  The \TeX\ processor has been defined
+carefully so that both varieties of arithmetic will produce identical
+output, but it would be too inefficient to constrain \MP\ in a similar way.
+
+@d el_gordo   017777777777 /* $2^{31}-1$, the largest value that \MP\ likes */
+
+@ One of \MP's most common operations is the calculation of
+$\lfloor{a+b\over2}\rfloor$,
+the midpoint of two given integers |a| and~|b|. The most decent way to do
+this is to write `|(a+b)/2|'; but on many machines it is more efficient 
+to calculate `|(a+b)>>1|'.
+
+Therefore the midpoint operation will always be denoted by `|half(a+b)|'
+in this program. If \MP\ is being implemented with languages that permit
+binary shifting, the |half| macro should be changed to make this operation
+as efficient as possible.  Since some systems have shift operators that can
+only be trusted to work on positive numbers, there is also a macro |halfp|
+that is used only when the quantity being halved is known to be positive
+or zero.
+
+@d half(A) ((A) / 2)
+@d halfp(A) ((A) >> 1)
+
+@ A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow. So the routines below set the global variable |arith_error| to |true|
+instead of reporting errors directly to the user.
+@^overflow in arithmetic@>
+
+@<Glob...@>=
+boolean arith_error; /* has arithmetic overflow occurred recently? */
+
+@ @<Allocate or ...@>=
+mp->arith_error=false;
+
+@ At crucial points the program will say |check_arith|, to test if
+an arithmetic error has been detected.
+
+@d check_arith { if ( mp->arith_error ) mp_clear_arith(mp); }
+
+@c 
+void mp_clear_arith (MP mp) { 
+  print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+  help4("Uh, oh. A little while ago one of the quantities that I was")
+       ("computing got too large, so I'm afraid your answers will be")
+       ("somewhat askew. You'll probably have to adopt different")
+       ("tactics next time. But I shall try to carry on anyway.");
+  mp_error(mp); 
+  mp->arith_error=false;
+}
+
+@ Addition is not always checked to make sure that it doesn't overflow,
+but in places where overflow isn't too unlikely the |slow_add| routine
+is used.
+
+@c integer mp_slow_add (MP mp,integer x, integer y) { 
+  if ( x>=0 )  {
+    if ( y<=el_gordo-x ) { 
+      return x+y;
+    } else  { 
+      mp->arith_error=true; 
+	  return el_gordo;
+    }
+  } else  if ( -y<=el_gordo+x ) {
+    return x+y;
+  } else { 
+    mp->arith_error=true; 
+	return -el_gordo;
+  }
+}
+
+@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+@d quarter_unit   040000 /* $2^{14}$, represents 0.250000 */
+@d half_unit   0100000 /* $2^{15}$, represents 0.50000 */
+@d three_quarter_unit   0140000 /* $3\cdot2^{14}$, represents 0.75000 */
+@d unity   0200000 /* $2^{16}$, represents 1.00000 */
+@d two   0400000 /* $2^{17}$, represents 2.00000 */
+@d three   0600000 /* $2^{17}+2^{16}$, represents 3.00000 */
+
+@<Types...@>=
+typedef integer scaled; /* this type is used for scaled integers */
+typedef unsigned char small_number; /* this type is self-explanatory */
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
+given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+@c 
+scaled mp_round_decimals (MP mp,small_number k) {
+  /* converts a decimal fraction */
+ integer a = 0; /* the accumulator */
+ while ( k-->0 ) { 
+    a=(a+mp->dig[k]*two) / 10;
+  }
+  return halfp(a+1);
+}
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \MP\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly. A decimal point is printed only if the value is
+not an integer. If there is more than one way to print the result with
+the optimum number of digits following the decimal point, the closest
+possible value is given.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@<Basic printing...@>=
+void mp_print_scaled (MP mp,scaled s) { /* prints scaled real, rounded to five  digits */
+  scaled delta; /* amount of allowable inaccuracy */
+  if ( s<0 ) { 
+	mp_print_char(mp, '-'); 
+    negate(s); /* print the sign, if negative */
+  }
+  mp_print_int(mp, s / unity); /* print the integer part */
+  s=10*(s % unity)+5;
+  if ( s!=5 ) { 
+    delta=10; 
+    mp_print_char(mp, '.');
+    do {  
+      if ( delta>unity )
+        s=s+0100000-(delta / 2); /* round the final digit */
+      mp_print_char(mp, '0'+(s / unity)); 
+      s=10*(s % unity); 
+      delta=delta*10;
+    } while (s>delta);
+  }
+}
+
+@ We often want to print two scaled quantities in parentheses,
+separated by a comma.
+
+@<Basic printing...@>=
+void mp_print_two (MP mp,scaled x, scaled y) { /* prints `|(x,y)|' */
+  mp_print_char(mp, '('); 
+  mp_print_scaled(mp, x); 
+  mp_print_char(mp, ','); 
+  mp_print_scaled(mp, y);
+  mp_print_char(mp, ')');
+}
+
+@ The |scaled| quantities in \MP\ programs are generally supposed to be
+less than $2^{12}$ in absolute value, so \MP\ does much of its internal
+arithmetic with 28~significant bits of precision. A |fraction| denotes
+a scaled integer whose binary point is assumed to be 28 bit positions
+from the right.
+
+@d fraction_half 01000000000 /* $2^{27}$, represents 0.50000000 */
+@d fraction_one 02000000000 /* $2^{28}$, represents 1.00000000 */
+@d fraction_two 04000000000 /* $2^{29}$, represents 2.00000000 */
+@d fraction_three 06000000000 /* $3\cdot2^{28}$, represents 3.00000000 */
+@d fraction_four 010000000000 /* $2^{30}$, represents 4.00000000 */
+
+@<Types...@>=
+typedef integer fraction; /* this type is used for scaled fractions */
+
+@ In fact, the two sorts of scaling discussed above aren't quite
+sufficient; \MP\ has yet another, used internally to keep track of angles
+in units of $2^{-20}$ degrees.
+
+@d forty_five_deg 0264000000 /* $45\cdot2^{20}$, represents $45^\circ$ */
+@d ninety_deg 0550000000 /* $90\cdot2^{20}$, represents $90^\circ$ */
+@d one_eighty_deg 01320000000 /* $180\cdot2^{20}$, represents $180^\circ$ */
+@d three_sixty_deg 02640000000 /* $360\cdot2^{20}$, represents $360^\circ$ */
+
+@<Types...@>=
+typedef integer angle; /* this type is used for scaled angles */
+
+@ The |make_fraction| routine produces the |fraction| equivalent of
+|p/q|, given integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If |p| and |q| are both of the same scaled type |t|,
+the ``type relation'' |make_fraction(t,t)=fraction| is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation |make_fraction(t,fraction)=t| between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_fraction|
+sets |arith_error:=true|. Most of \MP's internal computations have
+been designed to avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical
+machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a
+double-precision product can often be input to a fixed-point division
+instruction. But when we are restricted to int-eger arithmetic it
+is necessary either to resort to multiple-precision maneuvering
+or to use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MP's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MP\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+@^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+@^inner loop@>
+
+@<Internal ...@>=
+fraction mp_make_fraction (MP mp,integer p, integer q);
+integer mp_take_scaled (MP mp,integer q, scaled f) ;
+
+@ If FIXPT is not defined, we need these preprocessor values
+
+@d ELGORDO  0x7fffffff
+@d TWEXP31  2147483648.0
+@d TWEXP28  268435456.0
+@d TWEXP16 65536.0
+@d TWEXP_16 (1.0/65536.0)
+@d TWEXP_28 (1.0/268435456.0)
+
+
+@c 
+fraction mp_make_fraction (MP mp,integer p, integer q) {
+#ifdef FIXPT
+  integer f; /* the fraction bits, with a leading 1 bit */
+  integer n; /* the integer part of $\vert p/q\vert$ */
+  integer be_careful; /* disables certain compiler optimizations */
+  boolean negative = false; /* should the result be negated? */
+  if ( p<0 ) {
+    negate(p); negative=true;
+  }
+  if ( q<=0 ) { 
+#ifdef DEBUG
+    if ( q==0 ) mp_confusion(mp, '/');
+#endif
+@:this can't happen /}{\quad \./@>
+    negate(q); negative = ! negative;
+  };
+  n=p / q; p=p % q;
+  if ( n>=8 ){ 
+    mp->arith_error=true;
+    return ( negative ? -el_gordo : el_gordo);
+  } else { 
+    n=(n-1)*fraction_one;
+    @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
+    return (negative ? (-(f+n)) : (f+n));
+  }
+#else /* FIXPT */
+    register double d;
+	register integer i;
+#ifdef DEBUG
+	if (q==0) mp_confusion(mp,'/'); 
+#endif /* DEBUG */
+	d = TWEXP28 * (double)p /(double)q;
+	if ((p^q) >= 0) {
+		d += 0.5;
+		if (d>=TWEXP31) {mp->arith_error=true; return ELGORDO;}
+		i = (integer) d;
+		if (d==i && ( ((q>0 ? -q : q)&077777)
+				* (((i&037777)<<1)-1) & 04000)!=0) --i;
+	} else {
+		d -= 0.5;
+		if (d<= -TWEXP31) {mp->arith_error=true; return -ELGORDO;}
+		i = (integer) d;
+		if (d==i && ( ((q>0 ? q : -q)&077777)
+				* (((i&037777)<<1)+1) & 04000)!=0) ++i;
+	}
+	return i;
+#endif /* FIXPT */
+}
+
+@ The |repeat| loop here preserves the following invariant relations
+between |f|, |p|, and~|q|:
+(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable |be_careful| is used to emphasize the necessary
+order of computation. Optimizing compilers should keep |be_careful|
+in a register, not store it in memory.
+@^inner loop@>
+
+@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
+{
+  f=1;
+  do {  
+    be_careful=p-q; p=be_careful+p;
+    if ( p>=0 ) { 
+      f=f+f+1;
+    } else  { 
+      f+=f; p=p+q;
+    }
+  } while (f<fraction_one);
+  be_careful=p-q;
+  if ( be_careful+p>=0 ) incr(f);
+}
+
+@ The dual of |make_fraction| is |take_fraction|, which multiplies a
+given integer~|q| by a fraction~|f|. When the operands are positive, it
+computes $p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function
+of |q| and~|f|.
+
+This routine is even more ``inner loopy'' than |make_fraction|;
+the present implementation consumes almost 20\pct! of \MP's computation
+time during typical jobs, so a machine-language substitute is advisable.
+@^inner loop@> @^system dependencies@>
+
+@<Declarations@>=
+integer mp_take_fraction (MP mp,integer q, fraction f) ;
+
+@ @c 
+#ifdef FIXPT
+integer mp_take_fraction (MP mp,integer q, fraction f) {
+  integer p; /* the fraction so far */
+  boolean negative; /* should the result be negated? */
+  integer n; /* additional multiple of $q$ */
+  integer be_careful; /* disables certain compiler optimizations */
+  @<Reduce to the case that |f>=0| and |q>=0|@>;
+  if ( f<fraction_one ) { 
+    n=0;
+  } else { 
+    n=f / fraction_one; f=f % fraction_one;
+    if ( q<=el_gordo / n ) { 
+      n=n*q ; 
+    } else { 
+      mp->arith_error=true; n=el_gordo;
+    }
+  }
+  f=f+fraction_one;
+  @<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
+  be_careful=n-el_gordo;
+  if ( be_careful+p>0 ){ 
+    mp->arith_error=true; n=el_gordo-p;
+  }
+  if ( negative ) 
+	return (-(n+p));
+  else 
+    return (n+p);
+#else /* FIXPT */
+integer mp_take_fraction (MP mp,integer p, fraction q) {
+    register double d;
+	register integer i;
+	d = (double)p * (double)q * TWEXP_28;
+	if ((p^q) >= 0) {
+		d += 0.5;
+		if (d>=TWEXP31) {
+			if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0)
+				mp->arith_error = true;
+			return ELGORDO;
+		}
+		i = (integer) d;
+		if (d==i && (((p&077777)*(q&077777))&040000)!=0) --i;
+	} else {
+		d -= 0.5;
+		if (d<= -TWEXP31) {
+			if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0)
+				mp->arith_error = true;
+			return -ELGORDO;
+		}
+		i = (integer) d;
+		if (d==i && ((-(p&077777)*(q&077777))&040000)!=0) ++i;
+	}
+	return i;
+#endif /* FIXPT */
+}
+
+@ @<Reduce to the case that |f>=0| and |q>=0|@>=
+if ( f>=0 ) {
+  negative=false;
+} else { 
+  negate( f); negative=true;
+}
+if ( q<0 ) { 
+  negate(q); negative=! negative;
+}
+
+@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+@^inner loop@>
+
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p=fraction_half; /* that's $2^{27}$; the invariants hold now with $k=28$ */
+if ( q<fraction_four ) {
+  do {  
+    if ( odd(f) ) p=halfp(p+q); else p=halfp(p);
+    f=halfp(f);
+  } while (f!=1);
+} else  {
+  do {  
+    if ( odd(f) ) p=p+halfp(q-p); else p=halfp(p);
+    f=halfp(f);
+  } while (f!=1);
+}
+
+
+@ When we want to multiply something by a |scaled| quantity, we use a scheme
+analogous to |take_fraction| but with a different scaling.
+Given positive operands, |take_scaled|
+computes the quantity $p=\lfloor qf/2^{16}+{1\over2}\rfloor$.
+
+Once again it is a good idea to use a machine-language replacement if
+possible; otherwise |take_scaled| will use more than 2\pct! of the running time
+when the Computer Modern fonts are being generated.
+@^inner loop@>
+
+@c 
+#ifdef FIXPT
+integer mp_take_scaled (MP mp,integer q, scaled f) {
+  integer p; /* the fraction so far */
+  boolean negative; /* should the result be negated? */
+  integer n; /* additional multiple of $q$ */
+  integer be_careful; /* disables certain compiler optimizations */
+  @<Reduce to the case that |f>=0| and |q>=0|@>;
+  if ( f<unity ) { 
+    n=0;
+  } else  { 
+    n=f / unity; f=f % unity;
+    if ( q<=el_gordo / n ) {
+      n=n*q;
+    } else  { 
+      mp->arith_error=true; n=el_gordo;
+    }
+  }
+  f=f+unity;
+  @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>;
+  be_careful=n-el_gordo;
+  if ( be_careful+p>0 ) { 
+    mp->arith_error=true; n=el_gordo-p;
+  }
+  return ( negative ?(-(n+p)) :(n+p));
+#else /* FIXPT */
+integer mp_take_scaled (MP mp,integer p, scaled q) {
+    register double d;
+	register integer i;
+	d = (double)p * (double)q * TWEXP_16;
+	if ((p^q) >= 0) {
+		d += 0.5;
+		if (d>=TWEXP31) {
+			if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0)
+				mp->arith_error = true;
+			return ELGORDO;
+		}
+		i = (integer) d;
+		if (d==i && (((p&077777)*(q&077777))&040000)!=0) --i;
+	} else {
+		d -= 0.5;
+		if (d<= -TWEXP31) {
+			if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0)
+				mp->arith_error = true;
+			return -ELGORDO;
+		}
+		i = (integer) d;
+		if (d==i && ((-(p&077777)*(q&077777))&040000)!=0) ++i;
+	}
+	return i;
+#endif /* FIXPT */
+}
+
+@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>=
+p=half_unit; /* that's $2^{15}$; the invariants hold now with $k=16$ */
+@^inner loop@>
+if ( q<fraction_four ) {
+  do {  
+    p = (odd(f) ? halfp(p+q) : halfp(p));
+    f=halfp(f);
+  } while (f!=1);
+} else {
+  do {  
+    p = (odd(f) ? p+halfp(q-p) : halfp(p));
+    f=halfp(f);
+  } while (f!=1);
+}
+
+@ For completeness, there's also |make_scaled|, which computes a
+quotient as a |scaled| number instead of as a |fraction|.
+In other words, the result is $\lfloor2^{16}p/q+{1\over2}\rfloor$, if the
+operands are positive. \ (This procedure is not used especially often,
+so it is not part of \MP's inner loop.)
+
+@<Internal library ...@>=
+scaled mp_make_scaled (MP mp,integer p, integer q) ;
+
+@ @c 
+scaled mp_make_scaled (MP mp,integer p, integer q) {
+#ifdef FIXPT 
+  integer f; /* the fraction bits, with a leading 1 bit */
+  integer n; /* the integer part of $\vert p/q\vert$ */
+  boolean negative; /* should the result be negated? */
+  integer be_careful; /* disables certain compiler optimizations */
+  if ( p>=0 ) negative=false;
+  else  { negate(p); negative=true; };
+  if ( q<=0 ) { 
+#ifdef DEBUG 
+    if ( q==0 ) mp_confusion(mp, "/");
+@:this can't happen /}{\quad \./@>
+#endif
+    negate(q); negative=! negative;
+  }
+  n=p / q; p=p % q;
+  if ( n>=0100000 ) { 
+    mp->arith_error=true;
+    return (negative ? (-el_gordo) : el_gordo);
+  } else  { 
+    n=(n-1)*unity;
+    @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>;
+    return ( negative ? (-(f+n)) :(f+n));
+  }
+#else /* FIXPT */
+    register double d;
+	register integer i;
+#ifdef DEBUG
+	if (q==0) mp_confusion(mp,"/"); 
+#endif /* DEBUG */
+	d = TWEXP16 * (double)p /(double)q;
+	if ((p^q) >= 0) {
+		d += 0.5;
+		if (d>=TWEXP31) {mp->arith_error=true; return ELGORDO;}
+		i = (integer) d;
+		if (d==i && ( ((q>0 ? -q : q)&077777)
+				* (((i&037777)<<1)-1) & 04000)!=0) --i;
+	} else {
+		d -= 0.5;
+		if (d<= -TWEXP31) {mp->arith_error=true; return -ELGORDO;}
+		i = (integer) d;
+		if (d==i && ( ((q>0 ? q : -q)&077777)
+				* (((i&037777)<<1)+1) & 04000)!=0) ++i;
+	}
+	return i;
+#endif /* FIXPT */
+}
+
+@ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>=
+f=1;
+do {  
+  be_careful=p-q; p=be_careful+p;
+  if ( p>=0 ) f=f+f+1;
+  else  { f+=f; p=p+q; };
+} while (f<unity);
+be_careful=p-q;
+if ( be_careful+p>=0 ) incr(f)
+
+@ Here is a typical example of how the routines above can be used.
+It computes the function
+$${1\over3\tau}f(\theta,\phi)=
+{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi)
+ (\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over
+3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$
+where $\tau$ is a |scaled| ``tension'' parameter. This is \MP's magic
+fudge factor for placing the first control point of a curve that starts
+at an angle $\theta$ and ends at an angle $\phi$ from the straight path.
+(Actually, if the stated quantity exceeds 4, \MP\ reduces it to~4.)
+
+The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$.
+(It's a sum of eight terms whose absolute values can be bounded using
+relations such as $\sin\theta\cos\theta\L{1\over2}$.) Thus the numerator
+is positive; and since the tension $\tau$ is constrained to be at least
+$3\over4$, the numerator is less than $16\over3$. The denominator is
+nonnegative and at most~6.  Hence the fixed-point calculations below
+are guaranteed to stay within the bounds of a 32-bit computer word.
+
+The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction|
+arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$,
+$\sin\phi$, and $\cos\phi$, respectively.
+
+@c 
+fraction mp_velocity (MP mp,fraction st, fraction ct, fraction sf,
+                      fraction cf, scaled t) {
+  integer acc,num,denom; /* registers for intermediate calculations */
+  acc=mp_take_fraction(mp, st-(sf / 16), sf-(st / 16));
+  acc=mp_take_fraction(mp, acc,ct-cf);
+  num=fraction_two+mp_take_fraction(mp, acc,379625062);
+                   /* $2^{28}\sqrt2\approx379625062.497$ */
+  denom=fraction_three+mp_take_fraction(mp, ct,497706707)+mp_take_fraction(mp, cf,307599661);
+                      /* $3\cdot2^{27}\cdot(\sqrt5-1)\approx497706706.78$ and
+                         $3\cdot2^{27}\cdot(3-\sqrt5\,)\approx307599661.22$ */
+  if ( t!=unity ) num=mp_make_scaled(mp, num,t);
+  /* |make_scaled(fraction,scaled)=fraction| */
+  if ( num / 4>=denom ) 
+    return fraction_four;
+  else 
+    return mp_make_fraction(mp, num, denom);
+}
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+@d mp_ab_vs_cd(M,A,B,C,D) mp_do_ab_vs_cd(A,B,C,D)
+
+@c 
+integer mp_do_ab_vs_cd (integer a,integer b, integer c, integer d) {
+  integer q,r; /* temporary registers */
+  @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
+  while (1) { 
+    q = a / d; r = c / b;
+    if ( q!=r )
+      return ( q>r ? 1 : -1);
+    q = a % d; r = c % b;
+    if ( r==0 )
+      return (q ? 1 : 0);
+    if ( q==0 ) return -1;
+    a=b; b=q; c=d; d=r;
+  } /* now |a>d>0| and |c>b>0| */
+}
+
+@ @<Reduce to the case that |a...@>=
+if ( a<0 ) { negate(a); negate(b);  };
+if ( c<0 ) { negate(c); negate(d);  };
+if ( d<=0 ) { 
+  if ( b>=0 ) {
+    if ( (a==0||b==0)&&(c==0||d==0) ) return 0;
+    else return 1;
+  }
+  if ( d==0 )
+    return ( a==0 ? 0 : -1);
+  q=a; a=c; c=q; q=-b; b=-d; d=q;
+} else if ( b<=0 ) { 
+  if ( b<0 ) if ( a>0 ) return -1;
+  return (c==0 ? 0 : -1);
+}
+
+@ We conclude this set of elementary routines with some simple rounding
+and truncation operations.
+
+@<Internal library declarations@>=
+#define mp_floor_scaled(M,i) ((i)&(-65536))
+#define mp_round_unscaled(M,i) (((i>>15)+1)>>1)
+#define mp_round_fraction(M,i) (((i>>11)+1)>>1)
+
+
+@* \[8] Algebraic and transcendental functions.
+\MP\ computes all of the necessary special functions from scratch, without
+relying on |real| arithmetic or system subroutines for sines, cosines, etc.
+
+@ To get the square root of a |scaled| number |x|, we want to calculate
+$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique
+integer such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine
+determines $s$ by an iterative method that maintains the invariant
+relations $x=2^{46-2k}x_0\bmod 2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor
+-s^2+s\L q=2s$, where $x_0$ is the initial value of $x$. The value of~$y$
+might, however, be zero at the start of the first iteration.
+
+@<Declarations@>=
+scaled mp_square_rt (MP mp,scaled x) ;
+
+@ @c 
+scaled mp_square_rt (MP mp,scaled x) {
+  small_number k; /* iteration control counter */
+  integer y,q; /* registers for intermediate calculations */
+  if ( x<=0 ) { 
+    @<Handle square root of zero or negative argument@>;
+  } else { 
+    k=23; q=2;
+    while ( x<fraction_two ) { /* i.e., |while x<@t$2^{29}$@>|\unskip */
+      decr(k); x=x+x+x+x;
+    }
+    if ( x<fraction_four ) y=0;
+    else  { x=x-fraction_four; y=1; };
+    do {  
+      @<Decrease |k| by 1, maintaining the invariant
+      relations between |x|, |y|, and~|q|@>;
+    } while (k!=0);
+    return (halfp(q));
+  }
+}
+
+@ @<Handle square root of zero...@>=
+{ 
+  if ( x<0 ) { 
+    print_err("Square root of ");
+@.Square root...replaced by 0@>
+    mp_print_scaled(mp, x); mp_print(mp, " has been replaced by 0");
+    help2("Since I don't take square roots of negative numbers,")
+         ("I'm zeroing this one. Proceed, with fingers crossed.");
+    mp_error(mp);
+  };
+  return 0;
+}
+
+@ @<Decrease |k| by 1, maintaining...@>=
+x+=x; y+=y;
+if ( x>=fraction_four ) { /* note that |fraction_four=@t$2^{30}$@>| */
+  x=x-fraction_four; incr(y);
+};
+x+=x; y=y+y-q; q+=q;
+if ( x>=fraction_four ) { x=x-fraction_four; incr(y); };
+if ( y>q ){ y=y-q; q=q+2; }
+else if ( y<=0 )  { q=q-2; y=y+q;  };
+decr(k)
+
+@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant
+iterative scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal
+@^Moler, Cleve Barry@>
+@^Morrison, Donald Ross@>
+of Research and Development\/ \bf27} (1983), 577--581]. It modifies |a| and~|b|
+in such a way that their Pythagorean sum remains invariant, while the
+smaller argument decreases.
+
+@<Internal library ...@>=
+integer mp_pyth_add (MP mp,integer a, integer b);
+
+
+@ @c 
+integer mp_pyth_add (MP mp,integer a, integer b) {
+  fraction r; /* register used to transform |a| and |b| */
+  boolean big; /* is the result dangerously near $2^{31}$? */
+  a=abs(a); b=abs(b);
+  if ( a<b ) { r=b; b=a; a=r; }; /* now |0<=b<=a| */
+  if ( b>0 ) {
+    if ( a<fraction_two ) {
+      big=false;
+    } else { 
+      a=a / 4; b=b / 4; big=true;
+    }; /* we reduced the precision to avoid arithmetic overflow */
+    @<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>;
+    if ( big ) {
+      if ( a<fraction_two ) {
+        a=a+a+a+a;
+      } else  { 
+        mp->arith_error=true; a=el_gordo;
+      };
+    }
+  }
+  return a;
+}
+
+@ The key idea here is to reflect the vector $(a,b)$ about the
+line through $(a,b/2)$.
+
+@<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>=
+while (1) {  
+  r=mp_make_fraction(mp, b,a);
+  r=mp_take_fraction(mp, r,r); /* now $r\approx b^2/a^2$ */
+  if ( r==0 ) break;
+  r=mp_make_fraction(mp, r,fraction_four+r);
+  a=a+mp_take_fraction(mp, a+a,r); b=mp_take_fraction(mp, b,r);
+}
+
+
+@ Here is a similar algorithm for $\psqrt{a^2-b^2}$.
+It converges slowly when $b$ is near $a$, but otherwise it works fine.
+
+@c 
+integer mp_pyth_sub (MP mp,integer a, integer b) {
+  fraction r; /* register used to transform |a| and |b| */
+  boolean big; /* is the input dangerously near $2^{31}$? */
+  a=abs(a); b=abs(b);
+  if ( a<=b ) {
+    @<Handle erroneous |pyth_sub| and set |a:=0|@>;
+  } else { 
+    if ( a<fraction_four ) {
+      big=false;
+    } else  { 
+      a=halfp(a); b=halfp(b); big=true;
+    }
+    @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>;
+    if ( big ) double(a);
+  }
+  return a;
+}
+
+@ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>=
+while (1) { 
+  r=mp_make_fraction(mp, b,a);
+  r=mp_take_fraction(mp, r,r); /* now $r\approx b^2/a^2$ */
+  if ( r==0 ) break;
+  r=mp_make_fraction(mp, r,fraction_four-r);
+  a=a-mp_take_fraction(mp, a+a,r); b=mp_take_fraction(mp, b,r);
+}
+
+@ @<Handle erroneous |pyth_sub| and set |a:=0|@>=
+{ 
+  if ( a<b ){ 
+    print_err("Pythagorean subtraction "); mp_print_scaled(mp, a);
+    mp_print(mp, "+-+"); mp_print_scaled(mp, b); 
+    mp_print(mp, " has been replaced by 0");
+@.Pythagorean...@>
+    help2("Since I don't take square roots of negative numbers,")
+         ("I'm zeroing this one. Proceed, with fingers crossed.");
+    mp_error(mp);
+  }
+  a=0;
+}
+
+@ The subroutines for logarithm and exponential involve two tables.
+The first is simple: |two_to_the[k]| equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+@d two_to_the(A) (1<<(A))
+
+@<Constants ...@>=
+static const integer spec_log[29] = { 0, /* special logarithms */
+93032640, 38612034, 17922280, 8662214, 4261238, 2113709,
+1052693, 525315, 262400, 131136, 65552, 32772, 16385,
+8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16, 8, 4, 2, 1, 1 };
+
+@ @<Local variables for initialization@>=
+integer k; /* all-purpose loop index */
+
+
+@ Here is the routine that calculates $2^8$ times the natural logarithm
+of a |scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$,
+when |x| is a given positive integer.
+
+The method is based on exercise 1.2.2--25 in {\sl The Art of Computer
+Programming\/}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$,
+and the logarithm of $2^{30}x$ remains to be added to an accumulator
+register called~$y$. Three auxiliary bits of accuracy are retained in~$y$
+during the calculation, and sixteen auxiliary bits to extend |y| are
+kept in~|z| during the initial argument reduction. (We add
+$100\cdot2^{16}=6553600$ to~|z| and subtract 100 from~|y| so that |z| will
+not become negative; also, the actual amount subtracted from~|y| is~96,
+not~100, because we want to add~4 for rounding before the final division by~8.)
+
+@c 
+scaled mp_m_log (MP mp,scaled x) {
+  integer y,z; /* auxiliary registers */
+  integer k; /* iteration counter */
+  if ( x<=0 ) {
+     @<Handle non-positive logarithm@>;
+  } else  { 
+    y=1302456956+4-100; /* $14\times2^{27}\ln2\approx1302456956.421063$ */
+    z=27595+6553600; /* and $2^{16}\times .421063\approx 27595$ */
+    while ( x<fraction_four ) {
+       double(x); y-=93032639; z-=48782;
+    } /* $2^{27}\ln2\approx 93032639.74436163$ and $2^{16}\times.74436163\approx 48782$ */
+    y=y+(z / unity); k=2;
+    while ( x>fraction_four+4 ) {
+      @<Increase |k| until |x| can be multiplied by a
+        factor of $2^{-k}$, and adjust $y$ accordingly@>;
+    }
+    return (y / 8);
+  }
+}
+
+@ @<Increase |k| until |x| can...@>=
+{ 
+  z=((x-1) / two_to_the(k))+1; /* $z=\lceil x/2^k\rceil$ */
+  while ( x<fraction_four+z ) { z=halfp(z+1); incr(k); };
+  y+=spec_log[k]; x-=z;
+}
+
+@ @<Handle non-positive logarithm@>=
+{ 
+  print_err("Logarithm of ");
+@.Logarithm...replaced by 0@>
+  mp_print_scaled(mp, x); mp_print(mp, " has been replaced by 0");
+  help2("Since I don't take logs of non-positive numbers,")
+       ("I'm zeroing this one. Proceed, with fingers crossed.");
+  mp_error(mp); 
+  return 0;
+}
+
+@ Conversely, the exponential routine calculates $\exp(x/2^8)$,
+when |x| is |scaled|. The result is an integer approximation to
+$2^{16}\exp(x/2^{24})$, when |x| is regarded as an integer.
+
+@c 
+scaled mp_m_exp (MP mp,scaled x) {
+  small_number k; /* loop control index */
+  integer y,z; /* auxiliary registers */
+  if ( x>174436200 ) {
+    /* $2^{24}\ln((2^{31}-1)/2^{16})\approx 174436199.51$ */
+    mp->arith_error=true; 
+    return el_gordo;
+  } else if ( x<-197694359 ) {
+	/* $2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$ */
+    return 0;
+  } else { 
+    if ( x<=0 ) { 
+       z=-8*x; y=04000000; /* $y=2^{20}$ */
+    } else { 
+      if ( x<=127919879 ) { 
+        z=1023359037-8*x;
+        /* $2^{27}\ln((2^{31}-1)/2^{20})\approx 1023359037.125$ */
+      } else {
+       z=8*(174436200-x); /* |z| is always nonnegative */
+      }
+      y=el_gordo;
+    };
+    @<Multiply |y| by $\exp(-z/2^{27})$@>;
+    if ( x<=127919879 ) 
+       return ((y+8) / 16);
+     else 
+       return y;
+  }
+}
+
+@ The idea here is that subtracting |spec_log[k]| from |z| corresponds
+to multiplying |y| by $1-2^{-k}$.
+
+A subtle point (which had to be checked) was that if $x=127919879$, the
+value of~|y| will decrease so that |y+8| doesn't overflow. In fact,
+$z$ will be 5 in this case, and |y| will decrease by~64 when |k=25|
+and by~16 when |k=27|.
+
+@<Multiply |y| by...@>=
+k=1;
+while ( z>0 ) { 
+  while ( z>=spec_log[k] ) { 
+    z-=spec_log[k];
+    y=y-1-((y-two_to_the(k-1)) / two_to_the(k));
+  }
+  incr(k);
+}
+
+@ The trigonometric subroutines use an auxiliary table such that
+|spec_atan[k]| contains an approximation to the |angle| whose tangent
+is~$1/2^k$. $\arctan2^{-k}$ times $2^{20}\cdot180/\pi$ 
+
+@<Constants ...@>=
+static const angle spec_atan[27] = { 0, 27855475, 14718068, 7471121, 3750058, 
+1876857, 938658, 469357, 234682, 117342, 58671, 29335, 14668, 7334, 3667, 
+1833, 917, 458, 229, 115, 57, 29, 14, 7, 4, 2, 1 };
+
+@ Given integers |x| and |y|, not both zero, the |n_arg| function
+returns the |angle| whose tangent points in the direction $(x,y)$.
+This subroutine first determines the correct octant, then solves the
+problem for |0<=y<=x|, then converts the result appropriately to
+return an answer in the range |-one_eighty_deg<=@t$\theta$@><=one_eighty_deg|.
+(The answer is |+one_eighty_deg| if |y=0| and |x<0|, but an answer of
+|-one_eighty_deg| is possible if, for example, |y=-1| and $x=-2^{30}$.)
+
+The octants are represented in a ``Gray code,'' since that turns out
+to be computationally simplest.
+
+@d negate_x 1
+@d negate_y 2
+@d switch_x_and_y 4
+@d first_octant 1
+@d second_octant (first_octant+switch_x_and_y)
+@d third_octant (first_octant+switch_x_and_y+negate_x)
+@d fourth_octant (first_octant+negate_x)
+@d fifth_octant (first_octant+negate_x+negate_y)
+@d sixth_octant (first_octant+switch_x_and_y+negate_x+negate_y)
+@d seventh_octant (first_octant+switch_x_and_y+negate_y)
+@d eighth_octant (first_octant+negate_y)
+
+@c 
+angle mp_n_arg (MP mp,integer x, integer y) {
+  angle z; /* auxiliary register */
+  integer t; /* temporary storage */
+  small_number k; /* loop counter */
+  int octant; /* octant code */
+  if ( x>=0 ) {
+    octant=first_octant;
+  } else { 
+    negate(x); octant=first_octant+negate_x;
+  }
+  if ( y<0 ) { 
+    negate(y); octant=octant+negate_y;
+  }
+  if ( x<y ) { 
+    t=y; y=x; x=t; octant=octant+switch_x_and_y;
+  }
+  if ( x==0 ) { 
+    @<Handle undefined arg@>; 
+  } else { 
+    @<Set variable |z| to the arg of $(x,y)$@>;
+    @<Return an appropriate answer based on |z| and |octant|@>;
+  }
+}
+
+@ @<Handle undefined arg@>=
+{ 
+  print_err("angle(0,0) is taken as zero");
+@.angle(0,0)...zero@>
+  help2("The `angle' between two identical points is undefined.")
+       ("I'm zeroing this one. Proceed, with fingers crossed.");
+  mp_error(mp); 
+  return 0;
+}
+
+@ @<Return an appropriate answer...@>=
+switch (octant) {
+case first_octant: return z;
+case second_octant: return (ninety_deg-z);
+case third_octant: return (ninety_deg+z);
+case fourth_octant: return (one_eighty_deg-z);
+case fifth_octant: return (z-one_eighty_deg);
+case sixth_octant: return (-z-ninety_deg);
+case seventh_octant: return (z-ninety_deg);
+case eighth_octant: return (-z);
+}; /* there are no other cases */
+return 0
+
+@ At this point we have |x>=y>=0|, and |x>0|. The numbers are scaled up
+or down until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations
+will be made.
+
+@<Set variable |z| to the arg...@>=
+while ( x>=fraction_two ) { 
+  x=halfp(x); y=halfp(y);
+}
+z=0;
+if ( y>0 ) { 
+ while ( x<fraction_one ) { 
+    x+=x; y+=y; 
+ };
+ @<Increase |z| to the arg of $(x,y)$@>;
+}
+
+@ During the calculations of this section, variables |x| and~|y|
+represent actual coordinates $(x,2^{-k}y)$. We will maintain the
+condition |x>=y|, so that the tangent will be at most $2^{-k}$.
+If $x<2y$, the tangent is greater than $2^{-k-1}$. The transformation
+$(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces $(a,b)$ by
+coordinates whose angle has decreased by~$\phi$; in the special case
+$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces
+to the particularly simple iteration shown here. [Cf.~John E. Meggitt,
+@^Meggitt, John E.@>
+{\sl IBM Journal of Research and Development\/ \bf6} (1962), 210--226.]
+
+The initial value of |x| will be multiplied by at most
+$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence
+there is no chance of integer overflow.
+
+@<Increase |z|...@>=
+k=0;
+do {  
+  y+=y; incr(k);
+  if ( y>x ){ 
+    z=z+spec_atan[k]; t=x; x=x+(y / two_to_the(k+k)); y=y-t;
+  };
+} while (k!=15);
+do {  
+  y+=y; incr(k);
+  if ( y>x ) { z=z+spec_atan[k]; y=y-x; };
+} while (k!=26)
+
+@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine
+and cosine of that angle. The results of this routine are
+stored in global integer variables |n_sin| and |n_cos|.
+
+@<Glob...@>=
+fraction n_sin;fraction n_cos; /* results computed by |n_sin_cos| */
+
+@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees,
+the purpose of |n_sin_cos(z)| is to set
+|x=@t$r\cos\theta$@>| and |y=@t$r\sin\theta$@>| (approximately),
+for some rather large number~|r|. The maximum of |x| and |y|
+will be between $2^{28}$ and $2^{30}$, so that there will be hardly
+any loss of accuracy. Then |x| and~|y| are divided by~|r|.
+
+@c 
+void mp_n_sin_cos (MP mp,angle z) { /* computes a multiple of the sine
+                                       and cosine */ 
+  small_number k; /* loop control variable */
+  int q; /* specifies the quadrant */
+  fraction r; /* magnitude of |(x,y)| */
+  integer x,y,t; /* temporary registers */
+  while ( z<0 ) z=z+three_sixty_deg;
+  z=z % three_sixty_deg; /* now |0<=z<three_sixty_deg| */
+  q=z / forty_five_deg; z=z % forty_five_deg;
+  x=fraction_one; y=x;
+  if ( ! odd(q) ) z=forty_five_deg-z;
+  @<Subtract angle |z| from |(x,y)|@>;
+  @<Convert |(x,y)| to the octant determined by~|q|@>;
+  r=mp_pyth_add(mp, x,y); 
+  mp->n_cos=mp_make_fraction(mp, x,r); 
+  mp->n_sin=mp_make_fraction(mp, y,r);
+}
+
+@ In this case the octants are numbered sequentially.
+
+@<Convert |(x,...@>=
+switch (q) {
+case 0: break;
+case 1: t=x; x=y; y=t; break;
+case 2: t=x; x=-y; y=t; break;
+case 3: negate(x); break;
+case 4: negate(x); negate(y); break;
+case 5: t=x; x=-y; y=-t; break;
+case 6: t=x; x=y; y=-t; break;
+case 7: negate(y); break;
+} /* there are no other cases */
+
+@ The main iteration of |n_sin_cos| is similar to that of |n_arg| but
+applied in reverse. The values of |spec_atan[k]| decrease slowly enough
+that this loop is guaranteed to terminate before the (nonexistent) value
+|spec_atan[27]| would be required.
+
+@<Subtract angle |z|...@>=
+k=1;
+while ( z>0 ){ 
+  if ( z>=spec_atan[k] ) { 
+    z=z-spec_atan[k]; t=x;
+    x=t+y / two_to_the(k);
+    y=y-t / two_to_the(k);
+  }
+  incr(k);
+}
+if ( y<0 ) y=0 /* this precaution may never be needed */
+
+@ And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MP\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and |fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
+The global variable |j_random| tells which element has most recently
+been consumed.
+The global variable |random_seed| was introduced in version 0.9,
+for the sole reason of stressing the fact that the initial value of the
+random seed is system-dependant. The initialization code below will initialize
+this variable to |(internal[mp_time] div unity)+internal[mp_day]|, but this 
+is not good enough on modern fast machines that are capable of running
+multiple MetaPost processes within the same second.
+@^system dependencies@>
+
+@<Glob...@>=
+fraction randoms[55]; /* the last 55 random values generated */
+int j_random; /* the number of unused |randoms| */
+
+@ @<Option variables@>=
+int random_seed; /* the default random seed */
+
+@ @<Allocate or initialize ...@>=
+mp->random_seed = (scaled)opt->random_seed;
+
+@ To consume a random fraction, the program below will say `|next_random|'
+and then it will fetch |randoms[j_random]|.
+
+@d next_random { if ( mp->j_random==0 ) mp_new_randoms(mp);
+  else decr(mp->j_random); }
+
+@c 
+void mp_new_randoms (MP mp) {
+  int k; /* index into |randoms| */
+  fraction x; /* accumulator */
+  for (k=0;k<=23;k++) { 
+   x=mp->randoms[k]-mp->randoms[k+31];
+    if ( x<0 ) x=x+fraction_one;
+    mp->randoms[k]=x;
+  }
+  for (k=24;k<= 54;k++){ 
+    x=mp->randoms[k]-mp->randoms[k-24];
+    if ( x<0 ) x=x+fraction_one;
+    mp->randoms[k]=x;
+  }
+  mp->j_random=54;
+}
+
+@ @<Declarations@>=
+void mp_init_randoms (MP mp,scaled seed);
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@c 
+void mp_init_randoms (MP mp,scaled seed) {
+  fraction j,jj,k; /* more or less random integers */
+  int i; /* index into |randoms| */
+  j=abs(seed);
+  while ( j>=fraction_one ) j=halfp(j);
+  k=1;
+  for (i=0;i<=54;i++ ){ 
+    jj=k; k=j-k; j=jj;
+    if ( k<0 ) k=k+fraction_one;
+    mp->randoms[(i*21)% 55]=j;
+  }
+  mp_new_randoms(mp); 
+  mp_new_randoms(mp); 
+  mp_new_randoms(mp); /* ``warm up'' the array */
+}
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
+or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_fraction| will produce the values 0 and~|x|
+with about half the probability that it will produce any other particular
+values between 0 and~|x|, because it rounds its answers.
+
+@c 
+scaled mp_unif_rand (MP mp,scaled x) {
+  scaled y; /* trial value */
+  next_random; y=mp_take_fraction(mp, abs(x),mp->randoms[mp->j_random]);
+  if ( y==abs(x) ) return 0;
+  else if ( x>0 ) return y;
+  else return (-y);
+}
+
+@ Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+@c 
+scaled mp_norm_rand (MP mp) {
+  integer x,u,l; /* what the book would call $2^{16}X$, $2^{28}U$, and $-2^{24}\ln U$ */
+  do { 
+    do {  
+      next_random;
+      x=mp_take_fraction(mp, 112429,mp->randoms[mp->j_random]-fraction_half);
+      /* $2^{16}\sqrt{8/e}\approx 112428.82793$ */
+      next_random; u=mp->randoms[mp->j_random];
+    } while (abs(x)>=u);
+    x=mp_make_fraction(mp, x,u);
+    l=139548960-mp_m_log(mp, u); /* $2^{24}\cdot12\ln2\approx139548959.6165$ */
+  } while (mp_ab_vs_cd(mp, 1024,l,x,x)<0);
+  return x;
+}
+
+@* \[9] Packed data.
+In order to make efficient use of storage space, \MP\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a small number of fields that are one half or one
+quarter of the size used for storing integers.
+
+If |x| is a variable of type |memory_word|, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+|x|&.|int|&(an |integer|)\cr
+|x|&.|sc|\qquad&(a |scaled| integer)\cr
+|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
+|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
+  field)\cr
+|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
+  &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The code below gives a formal definition of |memory_word| and
+its subsidiary types, using packed variant records. \MP\ makes no
+assumptions about the relative positions of the fields within a word.
+
+@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
+@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
+
+@ Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+@<Check the ``constant''...@>=
+if (mp->ini_version) {
+  if ( mp->mem_max!=mp->mem_top ) mp->bad=8;
+} else {
+  if ( mp->mem_max<mp->mem_top ) mp->bad=8;
+}
+if ( max_quarterword<255 ) mp->bad=9;
+if ( max_halfword<65535 ) mp->bad=10;
+if ( max_quarterword>max_halfword ) mp->bad=11;
+if ( mp->mem_max>=max_halfword ) mp->bad=12;
+if ( mp->max_strings>max_halfword ) mp->bad=13;
+
+@ The macros |qi| and |qo| are used for input to and output 
+from quarterwords. These are legacy macros.
+@^system dependencies@>
+
+@d qo(A) (A) /* to read eight bits from a quarterword */
+@d qi(A) (A) /* to store eight bits in a quarterword */
+
+@ The reader should study the following definitions closely:
+@^system dependencies@>
+
+@d sc cint /* |scaled| data is equivalent to |integer| */
+
+@<Types...@>=
+typedef short quarterword; /* 1/4 of a word */
+typedef int halfword; /* 1/2 of a word */
+typedef union {
+  struct {
+    halfword RH, LH;
+  } v;
+  struct { /* Make B0,B1 overlap the most significant bytes of LH.  */
+    halfword junk;
+    quarterword B0, B1;
+  } u;
+} two_halves;
+typedef struct {
+  struct {
+    quarterword B2, B3, B0, B1;
+  } u;
+} four_quarters;
+typedef union {
+  two_halves hh;
+  integer cint;
+  four_quarters qqqq;
+} memory_word;
+#define	b0 u.B0
+#define	b1 u.B1
+#define	b2 u.B2
+#define	b3 u.B3
+#define rh v.RH
+#define lh v.LH
+
+@ When debugging, we may want to print a |memory_word| without knowing
+what type it is; so we print it in all modes.
+@^debugging@>
+
+@c 
+void mp_print_word (MP mp,memory_word w) {
+  /* prints |w| in all ways */
+  mp_print_int(mp, w.cint); mp_print_char(mp, ' ');
+  mp_print_scaled(mp, w.sc); mp_print_char(mp, ' '); 
+  mp_print_scaled(mp, w.sc / 010000); mp_print_ln(mp);
+  mp_print_int(mp, w.hh.lh); mp_print_char(mp, '='); 
+  mp_print_int(mp, w.hh.b0); mp_print_char(mp, ':');
+  mp_print_int(mp, w.hh.b1); mp_print_char(mp, ';'); 
+  mp_print_int(mp, w.hh.rh); mp_print_char(mp, ' ');
+  mp_print_int(mp, w.qqqq.b0); mp_print_char(mp, ':'); 
+  mp_print_int(mp, w.qqqq.b1); mp_print_char(mp, ':');
+  mp_print_int(mp, w.qqqq.b2); mp_print_char(mp, ':'); 
+  mp_print_int(mp, w.qqqq.b3);
+}
+
+
+@* \[10] Dynamic memory allocation.
+
+The \MP\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \MP\ are handled by providing a large array |mem| in
+which consecutive blocks of words are used as nodes by the \MP\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum memory
+index represents a null pointer.
+
+@d null 0 /* the null pointer */
+@d mp_void (null+1) /* a null pointer different from |null| */
+
+
+@<Types...@>=
+typedef halfword pointer; /* a flag or a location in |mem| or |eqtb| */
+
+@ The |mem| array is divided into two regions that are allocated separately,
+but the dividing line between these two regions is not fixed; they grow
+together until finding their ``natural'' size in a particular job.
+Locations less than or equal to |lo_mem_max| are used for storing
+variable-length records consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations greater than or equal to
+|hi_mem_min| are used for storing one-word records; a conventional
+\.{AVAIL} stack is used for allocation in this region.
+
+Locations of |mem| between |0| and |mem_top| may be dumped as part
+of preloaded mem files, by the \.{INIMP} preprocessor.
+@.INIMP@>
+Production versions of \MP\ may extend the memory at the top end in order to
+provide more space; these locations, between |mem_top| and |mem_max|,
+are always used for single-word nodes.
+
+The key pointers that govern |mem| allocation have a prescribed order:
+$$\hbox{|null=0<lo_mem_max<hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
+
+@<Glob...@>=
+memory_word *mem; /* the big dynamic storage area */
+pointer lo_mem_max; /* the largest location of variable-size memory in use */
+pointer hi_mem_min; /* the smallest location of one-word memory in use */
+
+
+@ 
+@d xfree(A) do { mp_xfree(A); A=NULL; } while (0)
+@d xrealloc(P,A,B) mp_xrealloc(mp,P,A,B)
+@d xmalloc(A,B)  mp_xmalloc(mp,A,B)
+@d xstrdup(A)  mp_xstrdup(mp,A)
+@d XREALLOC(a,b,c) a = xrealloc(a,(b+1),sizeof(c));
+
+@<Declare helpers@>=
+void mp_xfree (void *x);
+void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) ;
+void *mp_xmalloc (MP mp, size_t nmem, size_t size) ;
+char *mp_xstrdup(MP mp, const char *s);
+
+@ The |max_size_test| guards against overflow, on the assumption that
+|size_t| is at least 31bits wide.
+
+@d max_size_test 0x7FFFFFFF
+
+@c
+void mp_xfree (void *x) {
+  if (x!=NULL) free(x);
+}
+void  *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) {
+  void *w ; 
+  if ((max_size_test/size)<nmem) {
+    do_fprintf(mp->err_out,"Memory size overflow!\n");
+    mp->history =mp_fatal_error_stop;    mp_jump_out(mp);
+  }
+  w = realloc (p,(nmem*size));
+  if (w==NULL) {
+    do_fprintf(mp->err_out,"Out of memory!\n");
+    mp->history =mp_fatal_error_stop;    mp_jump_out(mp);
+  }
+  return w;
+}
+void  *mp_xmalloc (MP mp, size_t nmem, size_t size) {
+  void *w;
+  if ((max_size_test/size)<nmem) {
+    do_fprintf(mp->err_out,"Memory size overflow!\n");
+    mp->history =mp_fatal_error_stop;    mp_jump_out(mp);
+  }
+  w = malloc (nmem*size);
+  if (w==NULL) {
+    do_fprintf(mp->err_out,"Out of memory!\n");
+    mp->history =mp_fatal_error_stop;    mp_jump_out(mp);
+  }
+  return w;
+}
+char *mp_xstrdup(MP mp, const char *s) {
+  char *w; 
+  if (s==NULL)
+    return NULL;
+  w = strdup(s);
+  if (w==NULL) {
+    do_fprintf(mp->err_out,"Out of memory!\n");
+    mp->history =mp_fatal_error_stop;    mp_jump_out(mp);
+  }
+  return w;
+}
+
+
+@ 
+@<Allocate or initialize ...@>=
+mp->mem = xmalloc ((mp->mem_max+1),sizeof (memory_word));
+memset(mp->mem,0,(mp->mem_max+1)*sizeof (memory_word));
+
+@ @<Dealloc variables@>=
+xfree(mp->mem);
+
+@ Users who wish to study the memory requirements of particular applications can
+can use optional special features that keep track of current and
+maximum memory usage. When code between the delimiters |stat| $\ldots$
+|tats| is not ``commented out,'' \MP\ will run a bit slower but it will
+report these statistics when |mp_tracing_stats| is positive.
+
+@<Glob...@>=
+integer var_used; integer dyn_used; /* how much memory is in use */
+
+@ Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable |mem_end| holds the highest-numbered location
+of |mem| that has ever been used. The free locations of |mem| that
+occur between |hi_mem_min| and |mem_end|, inclusive, are of type
+|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
+and |rh| fields of |mem[p]| when it is of this type. The single-word
+free locations form a linked list
+$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
+terminated by |null|.
+
+@d link(A)   mp->mem[(A)].hh.rh /* the |link| field of a memory word */
+@d info(A)   mp->mem[(A)].hh.lh /* the |info| field of a memory word */
+
+@<Glob...@>=
+pointer avail; /* head of the list of available one-word nodes */
+pointer mem_end; /* the last one-word node used in |mem| */
+
+@ If one-word memory is exhausted, it might mean that the user has forgotten
+a token like `\&{enddef}' or `\&{endfor}'. We will define some procedures
+later that try to help pinpoint the trouble.
+
+@c 
+@<Declare the procedure called |show_token_list|@>
+@<Declare the procedure called |runaway|@>
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \MP\ will halt if there is no more room left.
+@^inner loop@>
+
+@c 
+pointer mp_get_avail (MP mp) { /* single-word node allocation */
+  pointer p; /* the new node being got */
+  p=mp->avail; /* get top location in the |avail| stack */
+  if ( p!=null ) {
+    mp->avail=link(mp->avail); /* and pop it off */
+  } else if ( mp->mem_end<mp->mem_max ) { /* or go into virgin territory */
+    incr(mp->mem_end); p=mp->mem_end;
+  } else { 
+    decr(mp->hi_mem_min); p=mp->hi_mem_min;
+    if ( mp->hi_mem_min<=mp->lo_mem_max ) { 
+      mp_runaway(mp); /* if memory is exhausted, display possible runaway text */
+      mp_overflow(mp, "main memory size",mp->mem_max);
+      /* quit; all one-word nodes are busy */
+@:MetaPost capacity exceeded main memory size}{\quad main memory size@>
+    }
+  }
+  link(p)=null; /* provide an oft-desired initialization of the new node */
+  incr(mp->dyn_used);/* maintain statistics */
+  return p;
+}
+
+@ Conversely, a one-word node is recycled by calling |free_avail|.
+
+@d free_avail(A)  /* single-word node liberation */
+  { link((A))=mp->avail; mp->avail=(A); decr(mp->dyn_used);  }
+
+@ There's also a |fast_get_avail| routine, which saves the procedure-call
+overhead at the expense of extra programming. This macro is used in
+the places that would otherwise account for the most calls of |get_avail|.
+@^inner loop@>
+
+@d fast_get_avail(A) { 
+  (A)=mp->avail; /* avoid |get_avail| if possible, to save time */
+  if ( (A)==null ) { (A)=mp_get_avail(mp); } 
+  else { mp->avail=link((A)); link((A))=null;  incr(mp->dyn_used); }
+  }
+
+@ The available-space list that keeps track of the variable-size portion
+of |mem| is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer |rover|.
+
+Each empty node has size 2 or more; the first word contains the special
+value |max_halfword| in its |link| field and the size in its |info| field;
+the second word contains the two pointers for double linking.
+
+Each nonempty node also has size 2 or more. Its first word is of type
+|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|.
+Otherwise there is complete flexibility with respect to the contents
+of its other fields and its other words.
+
+(We require |mem_max<max_halfword| because terrible things can happen
+when |max_halfword| appears in the |link| field of a nonempty node.)
+
+@d empty_flag   max_halfword /* the |link| of an empty variable-size node */
+@d is_empty(A)   (link((A))==empty_flag) /* tests for empty node */
+@d node_size   info /* the size field in empty variable-size nodes */
+@d llink(A)   info((A)+1) /* left link in doubly-linked list of empty nodes */
+@d rlink(A)   link((A)+1) /* right link in doubly-linked list of empty nodes */
+
+@<Glob...@>=
+pointer rover; /* points to some node in the list of empties */
+
+@ A call to |get_node| with argument |s| returns a pointer to a new node
+of size~|s|, which must be 2~or more. The |link| field of the first word
+of this new node is set to null. An overflow stop occurs if no suitable
+space exists.
+
+If |get_node| is called with $s=2^{30}$, it simply merges adjacent free
+areas and returns the value |max_halfword|.
+
+@<Internal library declarations@>=
+pointer mp_get_node (MP mp,integer s) ;
+
+@ @c 
+pointer mp_get_node (MP mp,integer s) { /* variable-size node allocation */
+  pointer p; /* the node currently under inspection */
+  pointer q;  /* the node physically after node |p| */
+  integer r; /* the newly allocated node, or a candidate for this honor */
+  integer t,tt; /* temporary registers */
+@^inner loop@>
+ RESTART: 
+  p=mp->rover; /* start at some free node in the ring */
+  do {  
+    @<Try to allocate within node |p| and its physical successors,
+     and |goto found| if allocation was possible@>;
+    if (rlink(p)==null || (rlink(p)==p && p!=mp->rover)) {
+      print_err("Free list garbled");
+      help3("I found an entry in the list of free nodes that links")
+       ("badly. I will try to ignore the broken link, but something")
+       ("is seriously amiss. It is wise to warn the maintainers.")
+	  mp_error(mp);
+      rlink(p)=mp->rover;
+    }
+	p=rlink(p); /* move to the next node in the ring */
+  } while (p!=mp->rover); /* repeat until the whole list has been traversed */
+  if ( s==010000000000 ) { 
+    return max_halfword;
+  };
+  if ( mp->lo_mem_max+2<mp->hi_mem_min ) {
+    if ( mp->lo_mem_max+2<=max_halfword ) {
+      @<Grow more variable-size memory and |goto restart|@>;
+    }
+  }
+  mp_overflow(mp, "main memory size",mp->mem_max);
+  /* sorry, nothing satisfactory is left */
+@:MetaPost capacity exceeded main memory size}{\quad main memory size@>
+FOUND: 
+  link(r)=null; /* this node is now nonempty */
+  mp->var_used+=s; /* maintain usage statistics */
+  return r;
+}
+
+@ The lower part of |mem| grows by 1000 words at a time, unless
+we are very close to going under. When it grows, we simply link
+a new node into the available-space list. This method of controlled
+growth helps to keep the |mem| usage consecutive when \MP\ is
+implemented on ``virtual memory'' systems.
+@^virtual memory@>
+
+@<Grow more variable-size memory and |goto restart|@>=
+{ 
+  if ( mp->hi_mem_min-mp->lo_mem_max>=1998 ) {
+    t=mp->lo_mem_max+1000;
+  } else {
+    t=mp->lo_mem_max+1+(mp->hi_mem_min-mp->lo_mem_max) / 2; 
+    /* |lo_mem_max+2<=t<hi_mem_min| */
+  }
+  if ( t>max_halfword ) t=max_halfword;
+  p=llink(mp->rover); q=mp->lo_mem_max; rlink(p)=q; llink(mp->rover)=q;
+  rlink(q)=mp->rover; llink(q)=p; link(q)=empty_flag; 
+  node_size(q)=t-mp->lo_mem_max;
+  mp->lo_mem_max=t; link(mp->lo_mem_max)=null; info(mp->lo_mem_max)=null;
+  mp->rover=q; 
+  goto RESTART;
+}
+
+@ @<Try to allocate...@>=
+q=p+node_size(p); /* find the physical successor */
+while ( is_empty(q) ) { /* merge node |p| with node |q| */
+  t=rlink(q); tt=llink(q);
+@^inner loop@>
+  if ( q==mp->rover ) mp->rover=t;
+  llink(t)=tt; rlink(tt)=t;
+  q=q+node_size(q);
+}
+r=q-s;
+if ( r>p+1 ) {
+  @<Allocate from the top of node |p| and |goto found|@>;
+}
+if ( r==p ) { 
+  if ( rlink(p)!=p ) {
+    @<Allocate entire node |p| and |goto found|@>;
+  }
+}
+node_size(p)=q-p /* reset the size in case it grew */
+
+@ @<Allocate from the top...@>=
+{ 
+  node_size(p)=r-p; /* store the remaining size */
+  mp->rover=p; /* start searching here next time */
+  goto FOUND;
+}
+
+@ Here we delete node |p| from the ring, and let |rover| rove around.
+
+@<Allocate entire...@>=
+{ 
+  mp->rover=rlink(p); t=llink(p);
+  llink(mp->rover)=t; rlink(t)=mp->rover;
+  goto FOUND;
+}
+
+@ Conversely, when some variable-size node |p| of size |s| is no longer needed,
+the operation |free_node(p,s)| will make its words available, by inserting
+|p| as a new empty node just before where |rover| now points.
+
+@<Internal library declarations@>=
+void mp_free_node (MP mp, pointer p, halfword s) ;
+
+@ @c 
+void mp_free_node (MP mp, pointer p, halfword s) { /* variable-size node
+  liberation */
+  pointer q; /* |llink(rover)| */
+  node_size(p)=s; link(p)=empty_flag;
+@^inner loop@>
+  q=llink(mp->rover); llink(p)=q; rlink(p)=mp->rover; /* set both links */
+  llink(mp->rover)=p; rlink(q)=p; /* insert |p| into the ring */
+  mp->var_used-=s; /* maintain statistics */
+}
+
+@ Just before \.{INIMP} writes out the memory, it sorts the doubly linked
+available space list. The list is probably very short at such times, so a
+simple insertion sort is used. The smallest available location will be
+pointed to by |rover|, the next-smallest by |rlink(rover)|, etc.
+
+@c 
+void mp_sort_avail (MP mp) { /* sorts the available variable-size nodes
+  by location */
+  pointer p,q,r; /* indices into |mem| */
+  pointer old_rover; /* initial |rover| setting */
+  p=mp_get_node(mp, 010000000000); /* merge adjacent free areas */
+  p=rlink(mp->rover); rlink(mp->rover)=max_halfword; old_rover=mp->rover;
+  while ( p!=old_rover ) {
+    @<Sort |p| into the list starting at |rover|
+     and advance |p| to |rlink(p)|@>;
+  }
+  p=mp->rover;
+  while ( rlink(p)!=max_halfword ) { 
+    llink(rlink(p))=p; p=rlink(p);
+  };
+  rlink(p)=mp->rover; llink(mp->rover)=p;
+}
+
+@ The following |while| loop is guaranteed to
+terminate, since the list that starts at
+|rover| ends with |max_halfword| during the sorting procedure.
+
+@<Sort |p|...@>=
+if ( p<mp->rover ) { 
+  q=p; p=rlink(q); rlink(q)=mp->rover; mp->rover=q;
+} else  { 
+  q=mp->rover;
+  while ( rlink(q)<p ) q=rlink(q);
+  r=rlink(p); rlink(p)=rlink(q); rlink(q)=p; p=r;
+}
+
+@* \[11] Memory layout.
+Some areas of |mem| are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, locations |0| to |1| are always used to store a
+two-word dummy token whose second word is zero.
+The following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. Static variable-size nodes appear
+in locations |0| through |lo_mem_stat_max|, and static single-word nodes
+appear in locations |hi_mem_stat_min| through |mem_top|, inclusive.
+
+@d null_dash (2) /* the first two words are reserved for a null value */
+@d dep_head (null_dash+3) /* we will define |dash_node_size=3| */
+@d zero_val (dep_head+2) /* two words for a permanently zero value */
+@d temp_val (zero_val+2) /* two words for a temporary value node */
+@d end_attr temp_val /* we use |end_attr+2| only */
+@d inf_val (end_attr+2) /* and |inf_val+1| only */
+@d test_pen (inf_val+2)
+  /* nine words for a pen used when testing the turning number */
+@d bad_vardef (test_pen+9) /* two words for \&{vardef} error recovery */
+@d lo_mem_stat_max (bad_vardef+1)  /* largest statically
+  allocated word in the variable-size |mem| */
+@#
+@d sentinel mp->mem_top /* end of sorted lists */
+@d temp_head (mp->mem_top-1) /* head of a temporary list of some kind */
+@d hold_head (mp->mem_top-2) /* head of a temporary list of another kind */
+@d spec_head (mp->mem_top-3) /* head of a list of unprocessed \&{special} items */
+@d hi_mem_stat_min (mp->mem_top-3) /* smallest statically allocated word in
+  the one-word |mem| */
+
+@ The following code gets the dynamic part of |mem| off to a good start,
+when \MP\ is initializing itself the slow way.
+
+@<Initialize table entries (done by \.{INIMP} only)@>=
+mp->rover=lo_mem_stat_max+1; /* initialize the dynamic memory */
+link(mp->rover)=empty_flag;
+node_size(mp->rover)=1000; /* which is a 1000-word available node */
+llink(mp->rover)=mp->rover; rlink(mp->rover)=mp->rover;
+mp->lo_mem_max=mp->rover+1000; 
+link(mp->lo_mem_max)=null; info(mp->lo_mem_max)=null;
+for (k=hi_mem_stat_min;k<=(int)mp->mem_top;k++) {
+  mp->mem[k]=mp->mem[mp->lo_mem_max]; /* clear list heads */
+}
+mp->avail=null; mp->mem_end=mp->mem_top;
+mp->hi_mem_min=hi_mem_stat_min; /* initialize the one-word memory */
+mp->var_used=lo_mem_stat_max+1; 
+mp->dyn_used=mp->mem_top+1-(hi_mem_stat_min);  /* initialize statistics */
+@<Initialize a pen at |test_pen| so that it fits in nine words@>;
+
+@ The procedure |flush_list(p)| frees an entire linked list of one-word
+nodes that starts at a given position, until coming to |sentinel| or a
+pointer that is not in the one-word region. Another procedure,
+|flush_node_list|, frees an entire linked list of one-word and two-word
+nodes, until coming to a |null| pointer.
+@^inner loop@>
+
+@c 
+void mp_flush_list (MP mp,pointer p) { /* makes list of single-word nodes  available */
+  pointer q,r; /* list traversers */
+  if ( p>=mp->hi_mem_min ) if ( p!=sentinel ) { 
+    r=p;
+    do {  
+      q=r; r=link(r); 
+      decr(mp->dyn_used);
+      if ( r<mp->hi_mem_min ) break;
+    } while (r!=sentinel);
+  /* now |q| is the last node on the list */
+    link(q)=mp->avail; mp->avail=p;
+  }
+}
+@#
+void mp_flush_node_list (MP mp,pointer p) {
+  pointer q; /* the node being recycled */
+  while ( p!=null ){ 
+    q=p; p=link(p);
+    if ( q<mp->hi_mem_min ) 
+      mp_free_node(mp, q,2);
+    else 
+      free_avail(q);
+  }
+}
+
+@ If \MP\ is extended improperly, the |mem| array might get screwed up.
+For example, some pointers might be wrong, or some ``dead'' nodes might not
+have been freed when the last reference to them disappeared. Procedures
+|check_mem| and |search_mem| are available to help diagnose such
+problems. These procedures make use of two arrays called |free| and
+|was_free| that are present only if \MP's debugging routines have
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+Because |boolean|s are typedef-d as ints, it is better to use
+unsigned chars here.
+
+@<Glob...@>=
+unsigned char *free; /* free cells */
+unsigned char *was_free; /* previously free cells */
+pointer was_mem_end; pointer was_lo_max; pointer was_hi_min;
+  /* previous |mem_end|, |lo_mem_max|,and |hi_mem_min| */
+boolean panicking; /* do we want to check memory constantly? */
+
+@ @<Allocate or initialize ...@>=
+mp->free = xmalloc ((mp->mem_max+1),sizeof (unsigned char));
+mp->was_free = xmalloc ((mp->mem_max+1), sizeof (unsigned char));
+
+@ @<Dealloc variables@>=
+xfree(mp->free);
+xfree(mp->was_free);
+
+@ @<Allocate or ...@>=
+mp->was_mem_end=0; /* indicate that everything was previously free */
+mp->was_lo_max=0; mp->was_hi_min=mp->mem_max;
+mp->panicking=false;
+
+@ @<Declare |mp_reallocate| functions@>=
+void mp_reallocate_memory(MP mp, int l) ;
+
+@ @c
+void mp_reallocate_memory(MP mp, int l) {
+   XREALLOC(mp->free,     l, unsigned char);
+   XREALLOC(mp->was_free, l, unsigned char);
+   if (mp->mem) {
+	 int newarea = l-mp->mem_max;
+     XREALLOC(mp->mem,      l, memory_word);
+     memset (mp->mem+(mp->mem_max+1),0,sizeof(memory_word)*(newarea));
+   } else {
+     XREALLOC(mp->mem,      l, memory_word);
+     memset(mp->mem,0,sizeof(memory_word)*(l+1));
+   }
+   mp->mem_max = l;
+   if (mp->ini_version) 
+     mp->mem_top = l;
+}
+
+
+
+@ Procedure |check_mem| makes sure that the available space lists of
+|mem| are well formed, and it optionally prints out all locations
+that are reserved now but were free the last time this procedure was called.
+
+@c 
+void mp_check_mem (MP mp,boolean print_locs ) {
+  pointer p,q,r; /* current locations of interest in |mem| */
+  boolean clobbered; /* is something amiss? */
+  for (p=0;p<=mp->lo_mem_max;p++) {
+    mp->free[p]=false; /* you can probably do this faster */
+  }
+  for (p=mp->hi_mem_min;p<= mp->mem_end;p++) {
+    mp->free[p]=false; /* ditto */
+  }
+  @<Check single-word |avail| list@>;
+  @<Check variable-size |avail| list@>;
+  @<Check flags of unavailable nodes@>;
+  @<Check the list of linear dependencies@>;
+  if ( print_locs ) {
+    @<Print newly busy locations@>;
+  }
+  memcpy(mp->was_free,mp->free, sizeof(char)*(mp->mem_end+1));
+  mp->was_mem_end=mp->mem_end; 
+  mp->was_lo_max=mp->lo_mem_max; 
+  mp->was_hi_min=mp->hi_mem_min;
+}
+
+@ @<Check single-word...@>=
+p=mp->avail; q=null; clobbered=false;
+while ( p!=null ) { 
+  if ( (p>mp->mem_end)||(p<mp->hi_mem_min) ) clobbered=true;
+  else if ( mp->free[p] ) clobbered=true;
+  if ( clobbered ) { 
+    mp_print_nl(mp, "AVAIL list clobbered at ");
+@.AVAIL list clobbered...@>
+    mp_print_int(mp, q); break;
+  }
+  mp->free[p]=true; q=p; p=link(q);
+}
+
+@ @<Check variable-size...@>=
+p=mp->rover; q=null; clobbered=false;
+do {  
+  if ( (p>=mp->lo_mem_max)||(p<0) ) clobbered=true;
+  else if ( (rlink(p)>=mp->lo_mem_max)||(rlink(p)<0) ) clobbered=true;
+  else if (  !(is_empty(p))||(node_size(p)<2)||
+   (p+node_size(p)>mp->lo_mem_max)|| (llink(rlink(p))!=p) ) clobbered=true;
+  if ( clobbered ) { 
+    mp_print_nl(mp, "Double-AVAIL list clobbered at ");
+@.Double-AVAIL list clobbered...@>
+    mp_print_int(mp, q); break;
+  }
+  for (q=p;q<=p+node_size(p)-1;q++) { /* mark all locations free */
+    if ( mp->free[q] ) { 
+      mp_print_nl(mp, "Doubly free location at ");
+@.Doubly free location...@>
+      mp_print_int(mp, q); break;
+    }
+    mp->free[q]=true;
+  }
+  q=p; p=rlink(p);
+} while (p!=mp->rover)
+
+
+@ @<Check flags...@>=
+p=0;
+while ( p<=mp->lo_mem_max ) { /* node |p| should not be empty */
+  if ( is_empty(p) ) {
+    mp_print_nl(mp, "Bad flag at "); mp_print_int(mp, p);
+@.Bad flag...@>
+  }
+  while ( (p<=mp->lo_mem_max) && ! mp->free[p] ) incr(p);
+  while ( (p<=mp->lo_mem_max) && mp->free[p] ) incr(p);
+}
+
+@ @<Print newly busy...@>=
+{ 
+  @<Do intialization required before printing new busy locations@>;
+  mp_print_nl(mp, "New busy locs:");
+@.New busy locs@>
+  for (p=0;p<= mp->lo_mem_max;p++ ) {
+    if ( ! mp->free[p] && ((p>mp->was_lo_max) || mp->was_free[p]) ) {
+      @<Indicate that |p| is a new busy location@>;
+    }
+  }
+  for (p=mp->hi_mem_min;p<=mp->mem_end;p++ ) {
+    if ( ! mp->free[p] &&
+        ((p<mp->was_hi_min) || (p>mp->was_mem_end) || mp->was_free[p]) ) {
+      @<Indicate that |p| is a new busy location@>;
+    }
+  }
+  @<Finish printing new busy locations@>;
+}
+
+@ There might be many new busy locations so we are careful to print contiguous
+blocks compactly.  During this operation |q| is the last new busy location and
+|r| is the start of the block containing |q|.
+
+@<Indicate that |p| is a new busy location@>=
+{ 
+  if ( p>q+1 ) { 
+    if ( q>r ) { 
+      mp_print(mp, ".."); mp_print_int(mp, q);
+    }
+    mp_print_char(mp, ' '); mp_print_int(mp, p);
+    r=p;
+  }
+  q=p;
+}
+
+@ @<Do intialization required before printing new busy locations@>=
+q=mp->mem_max; r=mp->mem_max
+
+@ @<Finish printing new busy locations@>=
+if ( q>r ) { 
+  mp_print(mp, ".."); mp_print_int(mp, q);
+}
+
+@ The |search_mem| procedure attempts to answer the question ``Who points
+to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem|
+that might not be of type |two_halves|. Strictly speaking, this is
+undefined, and it can lead to ``false drops'' (words that seem to
+point to |p| purely by coincidence). But for debugging purposes, we want
+to rule out the places that do {\sl not\/} point to |p|, so a few false
+drops are tolerable.
+
+@c
+void mp_search_mem (MP mp, pointer p) { /* look for pointers to |p| */
+  integer q; /* current position being searched */
+  for (q=0;q<=mp->lo_mem_max;q++) { 
+    if ( link(q)==p ){ 
+      mp_print_nl(mp, "LINK("); mp_print_int(mp, q); mp_print_char(mp, ')');
+    }
+    if ( info(q)==p ) { 
+      mp_print_nl(mp, "INFO("); mp_print_int(mp, q); mp_print_char(mp, ')');
+    }
+  }
+  for (q=mp->hi_mem_min;q<=mp->mem_end;q++) {
+    if ( link(q)==p ) {
+      mp_print_nl(mp, "LINK("); mp_print_int(mp, q); mp_print_char(mp, ')');
+    }
+    if ( info(q)==p ) {
+      mp_print_nl(mp, "INFO("); mp_print_int(mp, q); mp_print_char(mp, ')');
+    }
+  }
+  @<Search |eqtb| for equivalents equal to |p|@>;
+}
+
+@* \[12] The command codes.
+Before we can go much further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \MP. These codes
+are somewhat arbitrary, but not completely so. For example,
+some codes have been made adjacent so that |case| statements in the
+program need not consider cases that are widely spaced, or so that |case|
+statements can be replaced by |if| statements. A command can begin an
+expression if and only if its code lies between |min_primary_command| and
+|max_primary_command|, inclusive. The first token of a statement that doesn't
+begin with an expression has a command code between |min_command| and
+|max_statement_command|, inclusive. Anything less than |min_command| is
+eliminated during macro expansions, and anything no more than |max_pre_command|
+is eliminated when expanding \TeX\ material.  Ranges such as
+|min_secondary_command..max_secondary_command| are used when parsing
+expressions, but the relative ordering within such a range is generally not
+critical.
+
+The ordering of the highest-numbered commands
+(|comma<semicolon<end_group<stop|) is crucial for the parsing and
+error-recovery methods of this program as is the ordering |if_test<fi_or_else|
+for the smallest two commands.  The ordering is also important in the ranges
+|numeric_token..plus_or_minus| and |left_brace..ampersand|.
+
+At any rate, here is the list, for future reference.
+
+@d start_tex 1 /* begin \TeX\ material (\&{btex}, \&{verbatimtex}) */
+@d etex_marker 2 /* end \TeX\ material (\&{etex}) */
+@d mpx_break 3 /* stop reading an \.{MPX} file (\&{mpxbreak}) */
+@d max_pre_command mpx_break
+@d if_test 4 /* conditional text (\&{if}) */
+@d fi_or_else 5 /* delimiters for conditionals (\&{elseif}, \&{else}, \&{fi}) */
+@d input 6 /* input a source file (\&{input}, \&{endinput}) */
+@d iteration 7 /* iterate (\&{for}, \&{forsuffixes}, \&{forever}, \&{endfor}) */
+@d repeat_loop 8 /* special command substituted for \&{endfor} */
+@d exit_test 9 /* premature exit from a loop (\&{exitif}) */
+@d relax 10 /* do nothing (\.{\char`\\}) */
+@d scan_tokens 11 /* put a string into the input buffer */
+@d expand_after 12 /* look ahead one token */
+@d defined_macro 13 /* a macro defined by the user */
+@d min_command (defined_macro+1)
+@d save_command 14 /* save a list of tokens (\&{save}) */
+@d interim_command 15 /* save an internal quantity (\&{interim}) */
+@d let_command 16 /* redefine a symbolic token (\&{let}) */
+@d new_internal 17 /* define a new internal quantity (\&{newinternal}) */
+@d macro_def 18 /* define a macro (\&{def}, \&{vardef}, etc.) */
+@d ship_out_command 19 /* output a character (\&{shipout}) */
+@d add_to_command 20 /* add to edges (\&{addto}) */
+@d bounds_command 21  /* add bounding path to edges (\&{setbounds}, \&{clip}) */
+@d tfm_command 22 /* command for font metric info (\&{ligtable}, etc.) */
+@d protection_command 23 /* set protection flag (\&{outer}, \&{inner}) */
+@d show_command 24 /* diagnostic output (\&{show}, \&{showvariable}, etc.) */
+@d mode_command 25 /* set interaction level (\&{batchmode}, etc.) */
+@d mp_random_seed 26 /* initialize random number generator (\&{randomseed}) */
+@d message_command 27 /* communicate to user (\&{message}, \&{errmessage}) */
+@d every_job_command 28 /* designate a starting token (\&{everyjob}) */
+@d delimiters 29 /* define a pair of delimiters (\&{delimiters}) */
+@d special_command 30 /* output special info (\&{special})
+                       or font map info (\&{fontmapfile}, \&{fontmapline}) */
+@d write_command 31 /* write text to a file (\&{write}) */
+@d type_name 32 /* declare a type (\&{numeric}, \&{pair}, etc.) */
+@d max_statement_command type_name
+@d min_primary_command type_name
+@d left_delimiter 33 /* the left delimiter of a matching pair */
+@d begin_group 34 /* beginning of a group (\&{begingroup}) */
+@d nullary 35 /* an operator without arguments (e.g., \&{normaldeviate}) */
+@d unary 36 /* an operator with one argument (e.g., \&{sqrt}) */
+@d str_op 37 /* convert a suffix to a string (\&{str}) */
+@d cycle 38 /* close a cyclic path (\&{cycle}) */
+@d primary_binary 39 /* binary operation taking `\&{of}' (e.g., \&{point}) */
+@d capsule_token 40 /* a value that has been put into a token list */
+@d string_token 41 /* a string constant (e.g., |"hello"|) */
+@d internal_quantity 42 /* internal numeric parameter (e.g., \&{pausing}) */
+@d min_suffix_token internal_quantity
+@d tag_token 43 /* a symbolic token without a primitive meaning */
+@d numeric_token 44 /* a numeric constant (e.g., \.{3.14159}) */
+@d max_suffix_token numeric_token
+@d plus_or_minus 45 /* either `\.+' or `\.-' */
+@d max_primary_command plus_or_minus /* should also be |numeric_token+1| */
+@d min_tertiary_command plus_or_minus
+@d tertiary_secondary_macro 46 /* a macro defined by \&{secondarydef} */
+@d tertiary_binary 47 /* an operator at the tertiary level (e.g., `\.{++}') */
+@d max_tertiary_command tertiary_binary
+@d left_brace 48 /* the operator `\.{\char`\{}' */
+@d min_expression_command left_brace
+@d path_join 49 /* the operator `\.{..}' */
+@d ampersand 50 /* the operator `\.\&' */
+@d expression_tertiary_macro 51 /* a macro defined by \&{tertiarydef} */
+@d expression_binary 52 /* an operator at the expression level (e.g., `\.<') */
+@d equals 53 /* the operator `\.=' */
+@d max_expression_command equals
+@d and_command 54 /* the operator `\&{and}' */
+@d min_secondary_command and_command
+@d secondary_primary_macro 55 /* a macro defined by \&{primarydef} */
+@d slash 56 /* the operator `\./' */
+@d secondary_binary 57 /* an operator at the binary level (e.g., \&{shifted}) */
+@d max_secondary_command secondary_binary
+@d param_type 58 /* type of parameter (\&{primary}, \&{expr}, \&{suffix}, etc.) */
+@d controls 59 /* specify control points explicitly (\&{controls}) */
+@d tension 60 /* specify tension between knots (\&{tension}) */
+@d at_least 61 /* bounded tension value (\&{atleast}) */
+@d curl_command 62 /* specify curl at an end knot (\&{curl}) */
+@d macro_special 63 /* special macro operators (\&{quote}, \.{\#\AT!}, etc.) */
+@d right_delimiter 64 /* the right delimiter of a matching pair */
+@d left_bracket 65 /* the operator `\.[' */
+@d right_bracket 66 /* the operator `\.]' */
+@d right_brace 67 /* the operator `\.{\char`\}}' */
+@d with_option 68 /* option for filling (\&{withpen}, \&{withweight}, etc.) */
+@d thing_to_add 69
+  /* variant of \&{addto} (\&{contour}, \&{doublepath}, \&{also}) */
+@d of_token 70 /* the operator `\&{of}' */
+@d to_token 71 /* the operator `\&{to}' */
+@d step_token 72 /* the operator `\&{step}' */
+@d until_token 73 /* the operator `\&{until}' */
+@d within_token 74 /* the operator `\&{within}' */
+@d lig_kern_token 75
+  /* the operators `\&{kern}' and `\.{=:}' and `\.{=:\char'174}', etc. */
+@d assignment 76 /* the operator `\.{:=}' */
+@d skip_to 77 /* the operation `\&{skipto}' */
+@d bchar_label 78 /* the operator `\.{\char'174\char'174:}' */
+@d double_colon 79 /* the operator `\.{::}' */
+@d colon 80 /* the operator `\.:' */
+@#
+@d comma 81 /* the operator `\.,', must be |colon+1| */
+@d end_of_statement (mp->cur_cmd>comma)
+@d semicolon 82 /* the operator `\.;', must be |comma+1| */
+@d end_group 83 /* end a group (\&{endgroup}), must be |semicolon+1| */
+@d stop 84 /* end a job (\&{end}, \&{dump}), must be |end_group+1| */
+@d max_command_code stop
+@d outer_tag (max_command_code+1) /* protection code added to command code */
+
+@<Types...@>=
+typedef int command_code;
+
+@ Variables and capsules in \MP\ have a variety of ``types,''
+distinguished by the code numbers defined here. These numbers are also
+not completely arbitrary.  Things that get expanded must have types
+|>mp_independent|; a type remaining after expansion is numeric if and only if
+its code number is at least |numeric_type|; objects containing numeric
+parts must have types between |transform_type| and |pair_type|;
+all other types must be smaller than |transform_type|; and among the types
+that are not unknown or vacuous, the smallest two must be |boolean_type|
+and |string_type| in that order.
+ 
+@d undefined 0 /* no type has been declared */
+@d unknown_tag 1 /* this constant is added to certain type codes below */
+@d unknown_types mp_unknown_boolean: case mp_unknown_string:
+  case mp_unknown_pen: case mp_unknown_picture: case mp_unknown_path
+
+@<Types...@>=
+enum mp_variable_type {
+mp_vacuous=1, /* no expression was present */
+mp_boolean_type, /* \&{boolean} with a known value */
+mp_unknown_boolean,
+mp_string_type, /* \&{string} with a known value */
+mp_unknown_string,
+mp_pen_type, /* \&{pen} with a known value */
+mp_unknown_pen,
+mp_path_type, /* \&{path} with a known value */
+mp_unknown_path,
+mp_picture_type, /* \&{picture} with a known value */
+mp_unknown_picture,
+mp_transform_type, /* \&{transform} variable or capsule */
+mp_color_type, /* \&{color} variable or capsule */
+mp_cmykcolor_type, /* \&{cmykcolor} variable or capsule */
+mp_pair_type, /* \&{pair} variable or capsule */
+mp_numeric_type, /* variable that has been declared \&{numeric} but not used */
+mp_known, /* \&{numeric} with a known value */
+mp_dependent, /* a linear combination with |fraction| coefficients */
+mp_proto_dependent, /* a linear combination with |scaled| coefficients */
+mp_independent, /* \&{numeric} with unknown value */
+mp_token_list, /* variable name or suffix argument or text argument */
+mp_structured, /* variable with subscripts and attributes */
+mp_unsuffixed_macro, /* variable defined with \&{vardef} but no \.{\AT!\#} */
+mp_suffixed_macro /* variable defined with \&{vardef} and \.{\AT!\#} */
+} ;
+
+@ @<Declarations@>=
+void mp_print_type (MP mp,small_number t) ;
+
+@ @<Basic printing procedures@>=
+void mp_print_type (MP mp,small_number t) { 
+  switch (t) {
+  case mp_vacuous:mp_print(mp, "mp_vacuous"); break;
+  case mp_boolean_type:mp_print(mp, "boolean"); break;
+  case mp_unknown_boolean:mp_print(mp, "unknown boolean"); break;
+  case mp_string_type:mp_print(mp, "string"); break;
+  case mp_unknown_string:mp_print(mp, "unknown string"); break;
+  case mp_pen_type:mp_print(mp, "pen"); break;
+  case mp_unknown_pen:mp_print(mp, "unknown pen"); break;
+  case mp_path_type:mp_print(mp, "path"); break;
+  case mp_unknown_path:mp_print(mp, "unknown path"); break;
+  case mp_picture_type:mp_print(mp, "picture"); break;
+  case mp_unknown_picture:mp_print(mp, "unknown picture"); break;
+  case mp_transform_type:mp_print(mp, "transform"); break;
+  case mp_color_type:mp_print(mp, "color"); break;
+  case mp_cmykcolor_type:mp_print(mp, "cmykcolor"); break;
+  case mp_pair_type:mp_print(mp, "pair"); break;
+  case mp_known:mp_print(mp, "known numeric"); break;
+  case mp_dependent:mp_print(mp, "dependent"); break;
+  case mp_proto_dependent:mp_print(mp, "proto-dependent"); break;
+  case mp_numeric_type:mp_print(mp, "numeric"); break;
+  case mp_independent:mp_print(mp, "independent"); break;
+  case mp_token_list:mp_print(mp, "token list"); break;
+  case mp_structured:mp_print(mp, "mp_structured"); break;
+  case mp_unsuffixed_macro:mp_print(mp, "unsuffixed macro"); break;
+  case mp_suffixed_macro:mp_print(mp, "suffixed macro"); break;
+  default: mp_print(mp, "undefined"); break;
+  }
+}
+
+@ Values inside \MP\ are stored in two-word nodes that have a |name_type|
+as well as a |type|. The possibilities for |name_type| are defined
+here; they will be explained in more detail later.
+
+@<Types...@>=
+enum mp_name_type {
+ mp_root=0, /* |name_type| at the top level of a variable */
+ mp_saved_root, /* same, when the variable has been saved */
+ mp_structured_root, /* |name_type| where a |mp_structured| branch occurs */
+ mp_subscr, /* |name_type| in a subscript node */
+ mp_attr, /* |name_type| in an attribute node */
+ mp_x_part_sector, /* |name_type| in the \&{xpart} of a node */
+ mp_y_part_sector, /* |name_type| in the \&{ypart} of a node */
+ mp_xx_part_sector, /* |name_type| in the \&{xxpart} of a node */
+ mp_xy_part_sector, /* |name_type| in the \&{xypart} of a node */
+ mp_yx_part_sector, /* |name_type| in the \&{yxpart} of a node */
+ mp_yy_part_sector, /* |name_type| in the \&{yypart} of a node */
+ mp_red_part_sector, /* |name_type| in the \&{redpart} of a node */
+ mp_green_part_sector, /* |name_type| in the \&{greenpart} of a node */
+ mp_blue_part_sector, /* |name_type| in the \&{bluepart} of a node */
+ mp_cyan_part_sector, /* |name_type| in the \&{redpart} of a node */
+ mp_magenta_part_sector, /* |name_type| in the \&{greenpart} of a node */
+ mp_yellow_part_sector, /* |name_type| in the \&{bluepart} of a node */
+ mp_black_part_sector, /* |name_type| in the \&{greenpart} of a node */
+ mp_grey_part_sector, /* |name_type| in the \&{bluepart} of a node */
+ mp_capsule, /* |name_type| in stashed-away subexpressions */
+ mp_token  /* |name_type| in a numeric token or string token */
+};
+
+@ Primitive operations that produce values have a secondary identification
+code in addition to their command code; it's something like genera and species.
+For example, `\.*' has the command code |primary_binary|, and its
+secondary identification is |times|. The secondary codes start at 30 so that
+they don't overlap with the type codes; some type codes (e.g., |mp_string_type|)
+are used as operators as well as type identifications.  The relative values
+are not critical, except for |true_code..false_code|, |or_op..and_op|,
+and |filled_op..bounded_op|.  The restrictions are that
+|and_op-false_code=or_op-true_code|, that the ordering of
+|x_part...blue_part| must match that of |x_part_sector..mp_blue_part_sector|,
+and the ordering of |filled_op..bounded_op| must match that of the code
+values they test for.
+
+@d true_code 30 /* operation code for \.{true} */
+@d false_code 31 /* operation code for \.{false} */
+@d null_picture_code 32 /* operation code for \.{nullpicture} */
+@d null_pen_code 33 /* operation code for \.{nullpen} */
+@d job_name_op 34 /* operation code for \.{jobname} */
+@d read_string_op 35 /* operation code for \.{readstring} */
+@d pen_circle 36 /* operation code for \.{pencircle} */
+@d normal_deviate 37 /* operation code for \.{normaldeviate} */
+@d read_from_op 38 /* operation code for \.{readfrom} */
+@d close_from_op 39 /* operation code for \.{closefrom} */
+@d odd_op 40 /* operation code for \.{odd} */
+@d known_op 41 /* operation code for \.{known} */
+@d unknown_op 42 /* operation code for \.{unknown} */
+@d not_op 43 /* operation code for \.{not} */
+@d decimal 44 /* operation code for \.{decimal} */
+@d reverse 45 /* operation code for \.{reverse} */
+@d make_path_op 46 /* operation code for \.{makepath} */
+@d make_pen_op 47 /* operation code for \.{makepen} */
+@d oct_op 48 /* operation code for \.{oct} */
+@d hex_op 49 /* operation code for \.{hex} */
+@d ASCII_op 50 /* operation code for \.{ASCII} */
+@d char_op 51 /* operation code for \.{char} */
+@d length_op 52 /* operation code for \.{length} */
+@d turning_op 53 /* operation code for \.{turningnumber} */
+@d color_model_part 54 /* operation code for \.{colormodel} */
+@d x_part 55 /* operation code for \.{xpart} */
+@d y_part 56 /* operation code for \.{ypart} */
+@d xx_part 57 /* operation code for \.{xxpart} */
+@d xy_part 58 /* operation code for \.{xypart} */
+@d yx_part 59 /* operation code for \.{yxpart} */
+@d yy_part 60 /* operation code for \.{yypart} */
+@d red_part 61 /* operation code for \.{redpart} */
+@d green_part 62 /* operation code for \.{greenpart} */
+@d blue_part 63 /* operation code for \.{bluepart} */
+@d cyan_part 64 /* operation code for \.{cyanpart} */
+@d magenta_part 65 /* operation code for \.{magentapart} */
+@d yellow_part 66 /* operation code for \.{yellowpart} */
+@d black_part 67 /* operation code for \.{blackpart} */
+@d grey_part 68 /* operation code for \.{greypart} */
+@d font_part 69 /* operation code for \.{fontpart} */
+@d text_part 70 /* operation code for \.{textpart} */
+@d path_part 71 /* operation code for \.{pathpart} */
+@d pen_part 72 /* operation code for \.{penpart} */
+@d dash_part 73 /* operation code for \.{dashpart} */
+@d sqrt_op 74 /* operation code for \.{sqrt} */
+@d m_exp_op 75 /* operation code for \.{mexp} */
+@d m_log_op 76 /* operation code for \.{mlog} */
+@d sin_d_op 77 /* operation code for \.{sind} */
+@d cos_d_op 78 /* operation code for \.{cosd} */
+@d floor_op 79 /* operation code for \.{floor} */
+@d uniform_deviate 80 /* operation code for \.{uniformdeviate} */
+@d char_exists_op 81 /* operation code for \.{charexists} */
+@d font_size 82 /* operation code for \.{fontsize} */
+@d ll_corner_op 83 /* operation code for \.{llcorner} */
+@d lr_corner_op 84 /* operation code for \.{lrcorner} */
+@d ul_corner_op 85 /* operation code for \.{ulcorner} */
+@d ur_corner_op 86 /* operation code for \.{urcorner} */
+@d arc_length 87 /* operation code for \.{arclength} */
+@d angle_op 88 /* operation code for \.{angle} */
+@d cycle_op 89 /* operation code for \.{cycle} */
+@d filled_op 90 /* operation code for \.{filled} */
+@d stroked_op 91 /* operation code for \.{stroked} */
+@d textual_op 92 /* operation code for \.{textual} */
+@d clipped_op 93 /* operation code for \.{clipped} */
+@d bounded_op 94 /* operation code for \.{bounded} */
+@d plus 95 /* operation code for \.+ */
+@d minus 96 /* operation code for \.- */
+@d times 97 /* operation code for \.* */
+@d over 98 /* operation code for \./ */
+@d pythag_add 99 /* operation code for \.{++} */
+@d pythag_sub 100 /* operation code for \.{+-+} */
+@d or_op 101 /* operation code for \.{or} */
+@d and_op 102 /* operation code for \.{and} */
+@d less_than 103 /* operation code for \.< */
+@d less_or_equal 104 /* operation code for \.{<=} */
+@d greater_than 105 /* operation code for \.> */
+@d greater_or_equal 106 /* operation code for \.{>=} */
+@d equal_to 107 /* operation code for \.= */
+@d unequal_to 108 /* operation code for \.{<>} */
+@d concatenate 109 /* operation code for \.\& */
+@d rotated_by 110 /* operation code for \.{rotated} */
+@d slanted_by 111 /* operation code for \.{slanted} */
+@d scaled_by 112 /* operation code for \.{scaled} */
+@d shifted_by 113 /* operation code for \.{shifted} */
+@d transformed_by 114 /* operation code for \.{transformed} */
+@d x_scaled 115 /* operation code for \.{xscaled} */
+@d y_scaled 116 /* operation code for \.{yscaled} */
+@d z_scaled 117 /* operation code for \.{zscaled} */
+@d in_font 118 /* operation code for \.{infont} */
+@d intersect 119 /* operation code for \.{intersectiontimes} */
+@d double_dot 120 /* operation code for improper \.{..} */
+@d substring_of 121 /* operation code for \.{substring} */
+@d min_of substring_of
+@d subpath_of 122 /* operation code for \.{subpath} */
+@d direction_time_of 123 /* operation code for \.{directiontime} */
+@d point_of 124 /* operation code for \.{point} */
+@d precontrol_of 125 /* operation code for \.{precontrol} */
+@d postcontrol_of 126 /* operation code for \.{postcontrol} */
+@d pen_offset_of 127 /* operation code for \.{penoffset} */
+@d arc_time_of 128 /* operation code for \.{arctime} */
+@d mp_version 129 /* operation code for \.{mpversion} */
+@d envelope_of 130 /* operation code for \.{envelope} */
+
+@c void mp_print_op (MP mp,quarterword c) { 
+  if (c<=mp_numeric_type ) {
+    mp_print_type(mp, c);
+  } else {
+    switch (c) {
+    case true_code:mp_print(mp, "true"); break;
+    case false_code:mp_print(mp, "false"); break;
+    case null_picture_code:mp_print(mp, "nullpicture"); break;
+    case null_pen_code:mp_print(mp, "nullpen"); break;
+    case job_name_op:mp_print(mp, "jobname"); break;
+    case read_string_op:mp_print(mp, "readstring"); break;
+    case pen_circle:mp_print(mp, "pencircle"); break;
+    case normal_deviate:mp_print(mp, "normaldeviate"); break;
+    case read_from_op:mp_print(mp, "readfrom"); break;
+    case close_from_op:mp_print(mp, "closefrom"); break;
+    case odd_op:mp_print(mp, "odd"); break;
+    case known_op:mp_print(mp, "known"); break;
+    case unknown_op:mp_print(mp, "unknown"); break;
+    case not_op:mp_print(mp, "not"); break;
+    case decimal:mp_print(mp, "decimal"); break;
+    case reverse:mp_print(mp, "reverse"); break;
+    case make_path_op:mp_print(mp, "makepath"); break;
+    case make_pen_op:mp_print(mp, "makepen"); break;
+    case oct_op:mp_print(mp, "oct"); break;
+    case hex_op:mp_print(mp, "hex"); break;
+    case ASCII_op:mp_print(mp, "ASCII"); break;
+    case char_op:mp_print(mp, "char"); break;
+    case length_op:mp_print(mp, "length"); break;
+    case turning_op:mp_print(mp, "turningnumber"); break;
+    case x_part:mp_print(mp, "xpart"); break;
+    case y_part:mp_print(mp, "ypart"); break;
+    case xx_part:mp_print(mp, "xxpart"); break;
+    case xy_part:mp_print(mp, "xypart"); break;
+    case yx_part:mp_print(mp, "yxpart"); break;
+    case yy_part:mp_print(mp, "yypart"); break;
+    case red_part:mp_print(mp, "redpart"); break;
+    case green_part:mp_print(mp, "greenpart"); break;
+    case blue_part:mp_print(mp, "bluepart"); break;
+    case cyan_part:mp_print(mp, "cyanpart"); break;
+    case magenta_part:mp_print(mp, "magentapart"); break;
+    case yellow_part:mp_print(mp, "yellowpart"); break;
+    case black_part:mp_print(mp, "blackpart"); break;
+    case grey_part:mp_print(mp, "greypart"); break;
+    case color_model_part:mp_print(mp, "colormodel"); break;
+    case font_part:mp_print(mp, "fontpart"); break;
+    case text_part:mp_print(mp, "textpart"); break;
+    case path_part:mp_print(mp, "pathpart"); break;
+    case pen_part:mp_print(mp, "penpart"); break;
+    case dash_part:mp_print(mp, "dashpart"); break;
+    case sqrt_op:mp_print(mp, "sqrt"); break;
+    case m_exp_op:mp_print(mp, "mexp"); break;
+    case m_log_op:mp_print(mp, "mlog"); break;
+    case sin_d_op:mp_print(mp, "sind"); break;
+    case cos_d_op:mp_print(mp, "cosd"); break;
+    case floor_op:mp_print(mp, "floor"); break;
+    case uniform_deviate:mp_print(mp, "uniformdeviate"); break;
+    case char_exists_op:mp_print(mp, "charexists"); break;
+    case font_size:mp_print(mp, "fontsize"); break;
+    case ll_corner_op:mp_print(mp, "llcorner"); break;
+    case lr_corner_op:mp_print(mp, "lrcorner"); break;
+    case ul_corner_op:mp_print(mp, "ulcorner"); break;
+    case ur_corner_op:mp_print(mp, "urcorner"); break;
+    case arc_length:mp_print(mp, "arclength"); break;
+    case angle_op:mp_print(mp, "angle"); break;
+    case cycle_op:mp_print(mp, "cycle"); break;
+    case filled_op:mp_print(mp, "filled"); break;
+    case stroked_op:mp_print(mp, "stroked"); break;
+    case textual_op:mp_print(mp, "textual"); break;
+    case clipped_op:mp_print(mp, "clipped"); break;
+    case bounded_op:mp_print(mp, "bounded"); break;
+    case plus:mp_print_char(mp, '+'); break;
+    case minus:mp_print_char(mp, '-'); break;
+    case times:mp_print_char(mp, '*'); break;
+    case over:mp_print_char(mp, '/'); break;
+    case pythag_add:mp_print(mp, "++"); break;
+    case pythag_sub:mp_print(mp, "+-+"); break;
+    case or_op:mp_print(mp, "or"); break;
+    case and_op:mp_print(mp, "and"); break;
+    case less_than:mp_print_char(mp, '<'); break;
+    case less_or_equal:mp_print(mp, "<="); break;
+    case greater_than:mp_print_char(mp, '>'); break;
+    case greater_or_equal:mp_print(mp, ">="); break;
+    case equal_to:mp_print_char(mp, '='); break;
+    case unequal_to:mp_print(mp, "<>"); break;
+    case concatenate:mp_print(mp, "&"); break;
+    case rotated_by:mp_print(mp, "rotated"); break;
+    case slanted_by:mp_print(mp, "slanted"); break;
+    case scaled_by:mp_print(mp, "scaled"); break;
+    case shifted_by:mp_print(mp, "shifted"); break;
+    case transformed_by:mp_print(mp, "transformed"); break;
+    case x_scaled:mp_print(mp, "xscaled"); break;
+    case y_scaled:mp_print(mp, "yscaled"); break;
+    case z_scaled:mp_print(mp, "zscaled"); break;
+    case in_font:mp_print(mp, "infont"); break;
+    case intersect:mp_print(mp, "intersectiontimes"); break;
+    case substring_of:mp_print(mp, "substring"); break;
+    case subpath_of:mp_print(mp, "subpath"); break;
+    case direction_time_of:mp_print(mp, "directiontime"); break;
+    case point_of:mp_print(mp, "point"); break;
+    case precontrol_of:mp_print(mp, "precontrol"); break;
+    case postcontrol_of:mp_print(mp, "postcontrol"); break;
+    case pen_offset_of:mp_print(mp, "penoffset"); break;
+    case arc_time_of:mp_print(mp, "arctime"); break;
+    case mp_version:mp_print(mp, "mpversion"); break;
+    case envelope_of:mp_print(mp, "envelope"); break;
+    default: mp_print(mp, ".."); break;
+    }
+  }
+}
+
+@ \MP\ also has a bunch of internal parameters that a user might want to
+fuss with. Every such parameter has an identifying code number, defined here.
+
+@<Types...@>=
+enum mp_given_internal {
+  mp_tracing_titles=1, /* show titles online when they appear */
+  mp_tracing_equations, /* show each variable when it becomes known */
+  mp_tracing_capsules, /* show capsules too */
+  mp_tracing_choices, /* show the control points chosen for paths */
+  mp_tracing_specs, /* show path subdivision prior to filling with polygonal a pen */
+  mp_tracing_commands, /* show commands and operations before they are performed */
+  mp_tracing_restores, /* show when a variable or internal is restored */
+  mp_tracing_macros, /* show macros before they are expanded */
+  mp_tracing_output, /* show digitized edges as they are output */
+  mp_tracing_stats, /* show memory usage at end of job */
+  mp_tracing_lost_chars, /* show characters that aren't \&{infont} */
+  mp_tracing_online, /* show long diagnostics on terminal and in the log file */
+  mp_year, /* the current year (e.g., 1984) */
+  mp_month, /* the current month (e.g., 3 $\equiv$ March) */
+  mp_day, /* the current day of the month */
+  mp_time, /* the number of minutes past midnight when this job started */
+  mp_char_code, /* the number of the next character to be output */
+  mp_char_ext, /* the extension code of the next character to be output */
+  mp_char_wd, /* the width of the next character to be output */
+  mp_char_ht, /* the height of the next character to be output */
+  mp_char_dp, /* the depth of the next character to be output */
+  mp_char_ic, /* the italic correction of the next character to be output */
+  mp_design_size, /* the unit of measure used for |mp_char_wd..mp_char_ic|, in points */
+  mp_pausing, /* positive to display lines on the terminal before they are read */
+  mp_showstopping, /* positive to stop after each \&{show} command */
+  mp_fontmaking, /* positive if font metric output is to be produced */
+  mp_linejoin, /* as in \ps: 0 for mitered, 1 for round, 2 for beveled */
+  mp_linecap, /* as in \ps: 0 for butt, 1 for round, 2 for square */
+  mp_miterlimit, /* controls miter length as in \ps */
+  mp_warning_check, /* controls error message when variable value is large */
+  mp_boundary_char, /* the right boundary character for ligatures */
+  mp_prologues, /* positive to output conforming PostScript using built-in fonts */
+  mp_true_corners, /* positive to make \&{llcorner} etc. ignore \&{setbounds} */
+  mp_default_color_model, /* the default color model for unspecified items */
+  mp_restore_clip_color,
+  mp_procset, /* wether or not create PostScript command shortcuts */
+  mp_gtroffmode  /* whether the user specified |-troff| on the command line */
+};
+
+@
+
+@d max_given_internal mp_gtroffmode
+
+@<Glob...@>=
+scaled *internal;  /* the values of internal quantities */
+char **int_name;  /* their names */
+int int_ptr;  /* the maximum internal quantity defined so far */
+int max_internal; /* current maximum number of internal quantities */
+
+@ @<Option variables@>=
+int troff_mode; 
+
+@ @<Allocate or initialize ...@>=
+mp->max_internal=2*max_given_internal;
+mp->internal = xmalloc ((mp->max_internal+1), sizeof(scaled));
+mp->int_name = xmalloc ((mp->max_internal+1), sizeof(char *));
+mp->troff_mode=(opt->troff_mode>0 ? true : false);
+
+@ @<Exported function ...@>=
+int mp_troff_mode(MP mp);
+
+@ @c
+int mp_troff_mode(MP mp) { return mp->troff_mode; }
+
+@ @<Set initial ...@>=
+for (k=0;k<= mp->max_internal; k++ ) { 
+   mp->internal[k]=0; 
+   mp->int_name[k]=NULL; 
+}
+mp->int_ptr=max_given_internal;
+
+@ The symbolic names for internal quantities are put into \MP's hash table
+by using a routine called |primitive|, which will be defined later. Let us
+enter them now, so that we don't have to list all those names again
+anywhere else.
+
+@<Put each of \MP's primitives into the hash table@>=
+mp_primitive(mp, "tracingtitles",internal_quantity,mp_tracing_titles);
+@:tracingtitles_}{\&{tracingtitles} primitive@>
+mp_primitive(mp, "tracingequations",internal_quantity,mp_tracing_equations);
+@:mp_tracing_equations_}{\&{tracingequations} primitive@>
+mp_primitive(mp, "tracingcapsules",internal_quantity,mp_tracing_capsules);
+@:mp_tracing_capsules_}{\&{tracingcapsules} primitive@>
+mp_primitive(mp, "tracingchoices",internal_quantity,mp_tracing_choices);
+@:mp_tracing_choices_}{\&{tracingchoices} primitive@>
+mp_primitive(mp, "tracingspecs",internal_quantity,mp_tracing_specs);
+@:mp_tracing_specs_}{\&{tracingspecs} primitive@>
+mp_primitive(mp, "tracingcommands",internal_quantity,mp_tracing_commands);
+@:mp_tracing_commands_}{\&{tracingcommands} primitive@>
+mp_primitive(mp, "tracingrestores",internal_quantity,mp_tracing_restores);
+@:mp_tracing_restores_}{\&{tracingrestores} primitive@>
+mp_primitive(mp, "tracingmacros",internal_quantity,mp_tracing_macros);
+@:mp_tracing_macros_}{\&{tracingmacros} primitive@>
+mp_primitive(mp, "tracingoutput",internal_quantity,mp_tracing_output);
+@:mp_tracing_output_}{\&{tracingoutput} primitive@>
+mp_primitive(mp, "tracingstats",internal_quantity,mp_tracing_stats);
+@:mp_tracing_stats_}{\&{tracingstats} primitive@>
+mp_primitive(mp, "tracinglostchars",internal_quantity,mp_tracing_lost_chars);
+@:mp_tracing_lost_chars_}{\&{tracinglostchars} primitive@>
+mp_primitive(mp, "tracingonline",internal_quantity,mp_tracing_online);
+@:mp_tracing_online_}{\&{tracingonline} primitive@>
+mp_primitive(mp, "year",internal_quantity,mp_year);
+@:mp_year_}{\&{year} primitive@>
+mp_primitive(mp, "month",internal_quantity,mp_month);
+@:mp_month_}{\&{month} primitive@>
+mp_primitive(mp, "day",internal_quantity,mp_day);
+@:mp_day_}{\&{day} primitive@>
+mp_primitive(mp, "time",internal_quantity,mp_time);
+@:time_}{\&{time} primitive@>
+mp_primitive(mp, "charcode",internal_quantity,mp_char_code);
+@:mp_char_code_}{\&{charcode} primitive@>
+mp_primitive(mp, "charext",internal_quantity,mp_char_ext);
+@:mp_char_ext_}{\&{charext} primitive@>
+mp_primitive(mp, "charwd",internal_quantity,mp_char_wd);
+@:mp_char_wd_}{\&{charwd} primitive@>
+mp_primitive(mp, "charht",internal_quantity,mp_char_ht);
+@:mp_char_ht_}{\&{charht} primitive@>
+mp_primitive(mp, "chardp",internal_quantity,mp_char_dp);
+@:mp_char_dp_}{\&{chardp} primitive@>
+mp_primitive(mp, "charic",internal_quantity,mp_char_ic);
+@:mp_char_ic_}{\&{charic} primitive@>
+mp_primitive(mp, "designsize",internal_quantity,mp_design_size);
+@:mp_design_size_}{\&{designsize} primitive@>
+mp_primitive(mp, "pausing",internal_quantity,mp_pausing);
+@:mp_pausing_}{\&{pausing} primitive@>
+mp_primitive(mp, "showstopping",internal_quantity,mp_showstopping);
+@:mp_showstopping_}{\&{showstopping} primitive@>
+mp_primitive(mp, "fontmaking",internal_quantity,mp_fontmaking);
+@:mp_fontmaking_}{\&{fontmaking} primitive@>
+mp_primitive(mp, "linejoin",internal_quantity,mp_linejoin);
+@:mp_linejoin_}{\&{linejoin} primitive@>
+mp_primitive(mp, "linecap",internal_quantity,mp_linecap);
+@:mp_linecap_}{\&{linecap} primitive@>
+mp_primitive(mp, "miterlimit",internal_quantity,mp_miterlimit);
+@:mp_miterlimit_}{\&{miterlimit} primitive@>
+mp_primitive(mp, "warningcheck",internal_quantity,mp_warning_check);
+@:mp_warning_check_}{\&{warningcheck} primitive@>
+mp_primitive(mp, "boundarychar",internal_quantity,mp_boundary_char);
+@:mp_boundary_char_}{\&{boundarychar} primitive@>
+mp_primitive(mp, "prologues",internal_quantity,mp_prologues);
+@:mp_prologues_}{\&{prologues} primitive@>
+mp_primitive(mp, "truecorners",internal_quantity,mp_true_corners);
+@:mp_true_corners_}{\&{truecorners} primitive@>
+mp_primitive(mp, "mpprocset",internal_quantity,mp_procset);
+@:mp_procset_}{\&{mpprocset} primitive@>
+mp_primitive(mp, "troffmode",internal_quantity,mp_gtroffmode);
+@:troffmode_}{\&{troffmode} primitive@>
+mp_primitive(mp, "defaultcolormodel",internal_quantity,mp_default_color_model);
+@:mp_default_color_model_}{\&{defaultcolormodel} primitive@>
+mp_primitive(mp, "restoreclipcolor",internal_quantity,mp_restore_clip_color);
+@:mp_restore_clip_color_}{\&{restoreclipcolor} primitive@>
+
+@ Colors can be specified in four color models. In the special
+case of |no_model|, MetaPost does not output any color operator to
+the postscript output.
+
+Note: these values are passed directly on to |with_option|. This only
+works because the other possible values passed to |with_option| are
+8 and 10 respectively (from |with_pen| and |with_picture|).
+
+There is a first state, that is only used for |gs_colormodel|. It flags
+the fact that there has not been any kind of color specification by
+the user so far in the game.
+
+@<Types...@>=
+enum mp_color_model {
+  mp_no_model=1,
+  mp_grey_model=3,
+  mp_rgb_model=5,
+  mp_cmyk_model=7,
+  mp_uninitialized_model=9
+};
+
+
+@ @<Initialize table entries (done by \.{INIMP} only)@>=
+mp->internal[mp_default_color_model]=(mp_rgb_model*unity);
+mp->internal[mp_restore_clip_color]=unity;
+
+@ Well, we do have to list the names one more time, for use in symbolic
+printouts.
+
+@<Initialize table...@>=
+mp->int_name[mp_tracing_titles]=xstrdup("tracingtitles");
+mp->int_name[mp_tracing_equations]=xstrdup("tracingequations");
+mp->int_name[mp_tracing_capsules]=xstrdup("tracingcapsules");
+mp->int_name[mp_tracing_choices]=xstrdup("tracingchoices");
+mp->int_name[mp_tracing_specs]=xstrdup("tracingspecs");
+mp->int_name[mp_tracing_commands]=xstrdup("tracingcommands");
+mp->int_name[mp_tracing_restores]=xstrdup("tracingrestores");
+mp->int_name[mp_tracing_macros]=xstrdup("tracingmacros");
+mp->int_name[mp_tracing_output]=xstrdup("tracingoutput");
+mp->int_name[mp_tracing_stats]=xstrdup("tracingstats");
+mp->int_name[mp_tracing_lost_chars]=xstrdup("tracinglostchars");
+mp->int_name[mp_tracing_online]=xstrdup("tracingonline");
+mp->int_name[mp_year]=xstrdup("year");
+mp->int_name[mp_month]=xstrdup("month");
+mp->int_name[mp_day]=xstrdup("day");
+mp->int_name[mp_time]=xstrdup("time");
+mp->int_name[mp_char_code]=xstrdup("charcode");
+mp->int_name[mp_char_ext]=xstrdup("charext");
+mp->int_name[mp_char_wd]=xstrdup("charwd");
+mp->int_name[mp_char_ht]=xstrdup("charht");
+mp->int_name[mp_char_dp]=xstrdup("chardp");
+mp->int_name[mp_char_ic]=xstrdup("charic");
+mp->int_name[mp_design_size]=xstrdup("designsize");
+mp->int_name[mp_pausing]=xstrdup("pausing");
+mp->int_name[mp_showstopping]=xstrdup("showstopping");
+mp->int_name[mp_fontmaking]=xstrdup("fontmaking");
+mp->int_name[mp_linejoin]=xstrdup("linejoin");
+mp->int_name[mp_linecap]=xstrdup("linecap");
+mp->int_name[mp_miterlimit]=xstrdup("miterlimit");
+mp->int_name[mp_warning_check]=xstrdup("warningcheck");
+mp->int_name[mp_boundary_char]=xstrdup("boundarychar");
+mp->int_name[mp_prologues]=xstrdup("prologues");
+mp->int_name[mp_true_corners]=xstrdup("truecorners");
+mp->int_name[mp_default_color_model]=xstrdup("defaultcolormodel");
+mp->int_name[mp_procset]=xstrdup("mpprocset");
+mp->int_name[mp_gtroffmode]=xstrdup("troffmode");
+mp->int_name[mp_restore_clip_color]=xstrdup("restoreclipcolor");
+
+@ The following procedure, which is called just before \MP\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+
+Note that the values are |scaled| integers. Hence \MP\ can no longer
+be used after the year 32767.
+
+@c 
+void mp_fix_date_and_time (MP mp) { 
+  time_t aclock = time ((time_t *) 0);
+  struct tm *tmptr = localtime (&aclock);
+  mp->internal[mp_time]=
+      (tmptr->tm_hour*60+tmptr->tm_min)*unity; /* minutes since midnight */
+  mp->internal[mp_day]=(tmptr->tm_mday)*unity; /* fourth day of the month */
+  mp->internal[mp_month]=(tmptr->tm_mon+1)*unity; /* seventh month of the year */
+  mp->internal[mp_year]=(tmptr->tm_year+1900)*unity; /* Anno Domini */
+}
+
+@ @<Declarations@>=
+void mp_fix_date_and_time (MP mp) ;
+
+@ \MP\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless |mp_tracing_online| is positive.
+Now that we have defined |mp_tracing_online| we can define
+two routines that adjust the destination of print commands:
+
+@<Declarations@>=
+void mp_begin_diagnostic (MP mp) ;
+void mp_end_diagnostic (MP mp,boolean blank_line);
+void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) ;
+
+@ @<Basic printing...@>=
+@<Declare a function called |true_line|@>
+void mp_begin_diagnostic (MP mp) { /* prepare to do some tracing */
+  mp->old_setting=mp->selector;
+  if ((mp->internal[mp_tracing_online]<=0)&&(mp->selector==term_and_log)){ 
+    decr(mp->selector);
+    if ( mp->history==mp_spotless ) mp->history=mp_warning_issued;
+  }
+}
+@#
+void mp_end_diagnostic (MP mp,boolean blank_line) {
+  /* restore proper conditions after tracing */
+  mp_print_nl(mp, "");
+  if ( blank_line ) mp_print_ln(mp);
+  mp->selector=mp->old_setting;
+}
+
+@ 
+
+@<Glob...@>=
+unsigned int old_setting;
+
+@ We will occasionally use |begin_diagnostic| in connection with line-number
+printing, as follows. (The parameter |s| is typically |"Path"| or
+|"Cycle spec"|, etc.)
+
+@<Basic printing...@>=
+void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) { 
+  mp_begin_diagnostic(mp);
+  if ( nuline ) mp_print_nl(mp, s); else mp_print(mp, s);
+  mp_print(mp, " at line "); 
+  mp_print_int(mp, mp_true_line(mp));
+  mp_print(mp, t); mp_print_char(mp, ':');
+}
+
+@ The 256 |ASCII_code| characters are grouped into classes by means of
+the |char_class| table. Individual class numbers have no semantic
+or syntactic significance, except in a few instances defined here.
+There's also |max_class|, which can be used as a basis for additional
+class numbers in nonstandard extensions of \MP.
+
+@d digit_class 0 /* the class number of \.{0123456789} */
+@d period_class 1 /* the class number of `\..' */
+@d space_class 2 /* the class number of spaces and nonstandard characters */
+@d percent_class 3 /* the class number of `\.\%' */
+@d string_class 4 /* the class number of `\."' */
+@d right_paren_class 8 /* the class number of `\.)' */
+@d isolated_classes 5: case 6: case 7: case 8 /* characters that make length-one tokens only */
+@d letter_class 9 /* letters and the underline character */
+@d left_bracket_class 17 /* `\.[' */
+@d right_bracket_class 18 /* `\.]' */
+@d invalid_class 20 /* bad character in the input */
+@d max_class 20 /* the largest class number */
+
+@<Glob...@>=
+int char_class[256]; /* the class numbers */
+
+@ If changes are made to accommodate non-ASCII character sets, they should
+follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}.
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+@^system dependencies@>
+
+@<Set initial ...@>=
+for (k='0';k<='9';k++) 
+  mp->char_class[k]=digit_class;
+mp->char_class['.']=period_class;
+mp->char_class[' ']=space_class;
+mp->char_class['%']=percent_class;
+mp->char_class['"']=string_class;
+mp->char_class[',']=5;
+mp->char_class[';']=6;
+mp->char_class['(']=7;
+mp->char_class[')']=right_paren_class;
+for (k='A';k<= 'Z';k++ )
+  mp->char_class[k]=letter_class;
+for (k='a';k<='z';k++) 
+  mp->char_class[k]=letter_class;
+mp->char_class['_']=letter_class;
+mp->char_class['<']=10;
+mp->char_class['=']=10;
+mp->char_class['>']=10;
+mp->char_class[':']=10;
+mp->char_class['|']=10;
+mp->char_class['`']=11;
+mp->char_class['\'']=11;
+mp->char_class['+']=12;
+mp->char_class['-']=12;
+mp->char_class['/']=13;
+mp->char_class['*']=13;
+mp->char_class['\\']=13;
+mp->char_class['!']=14;
+mp->char_class['?']=14;
+mp->char_class['#']=15;
+mp->char_class['&']=15;
+mp->char_class['@@']=15;
+mp->char_class['$']=15;
+mp->char_class['^']=16;
+mp->char_class['~']=16;
+mp->char_class['[']=left_bracket_class;
+mp->char_class[']']=right_bracket_class;
+mp->char_class['{']=19;
+mp->char_class['}']=19;
+for (k=0;k<' ';k++)
+  mp->char_class[k]=invalid_class;
+mp->char_class['\t']=space_class;
+mp->char_class['\f']=space_class;
+for (k=127;k<=255;k++)
+  mp->char_class[k]=invalid_class;
+
+@* \[13] The hash table.
+Symbolic tokens are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a symbolic token enters the
+table, it is never removed.
+
+The actual sequence of characters forming a symbolic token is
+stored in the |str_pool| array together with all the other strings. An
+auxiliary array |hash| consists of items with two halfword fields per
+word. The first of these, called |next(p)|, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~|p|;
+and the other, called |text(p)|, points to the |str_start| entry for
+|p|'s identifier. If position~|p| of the hash table is empty, we have
+|text(p)=0|; if position |p| is either empty or the end of a coalesced
+hash list, we have |next(p)=0|.
+
+An auxiliary pointer variable called |hash_used| is maintained in such a
+way that all locations |p>=hash_used| are nonempty. The global variable
+|st_count| tells how many symbolic tokens have been defined, if statistics
+are being kept.
+
+The first 256 locations of |hash| are reserved for symbols of length one.
+
+There's a parallel array called |eqtb| that contains the current equivalent
+values of each symbolic token. The entries of this array consist of
+two halfwords called |eq_type| (a command code) and |equiv| (a secondary
+piece of information that qualifies the |eq_type|).
+
+@d next(A)   mp->hash[(A)].lh /* link for coalesced lists */
+@d text(A)   mp->hash[(A)].rh /* string number for symbolic token name */
+@d eq_type(A)   mp->eqtb[(A)].lh /* the current ``meaning'' of a symbolic token */
+@d equiv(A)   mp->eqtb[(A)].rh /* parametric part of a token's meaning */
+@d hash_base 257 /* hashing actually starts here */
+@d hash_is_full   (mp->hash_used==hash_base) /* are all positions occupied? */
+
+@<Glob...@>=
+pointer hash_used; /* allocation pointer for |hash| */
+integer st_count; /* total number of known identifiers */
+
+@ Certain entries in the hash table are ``frozen'' and not redefinable,
+since they are used in error recovery.
+
+@d hash_top (hash_base+mp->hash_size) /* the first location of the frozen area */
+@d frozen_inaccessible hash_top /* |hash| location to protect the frozen area */
+@d frozen_repeat_loop (hash_top+1) /* |hash| location of a loop-repeat token */
+@d frozen_right_delimiter (hash_top+2) /* |hash| location of a permanent `\.)' */
+@d frozen_left_bracket (hash_top+3) /* |hash| location of a permanent `\.[' */
+@d frozen_slash (hash_top+4) /* |hash| location of a permanent `\./' */
+@d frozen_colon (hash_top+5) /* |hash| location of a permanent `\.:' */
+@d frozen_semicolon (hash_top+6) /* |hash| location of a permanent `\.;' */
+@d frozen_end_for (hash_top+7) /* |hash| location of a permanent \&{endfor} */
+@d frozen_end_def (hash_top+8) /* |hash| location of a permanent \&{enddef} */
+@d frozen_fi (hash_top+9) /* |hash| location of a permanent \&{fi} */
+@d frozen_end_group (hash_top+10) /* |hash| location of a permanent `\.{endgroup}' */
+@d frozen_etex (hash_top+11) /* |hash| location of a permanent \&{etex} */
+@d frozen_mpx_break (hash_top+12) /* |hash| location of a permanent \&{mpxbreak} */
+@d frozen_bad_vardef (hash_top+13) /* |hash| location of `\.{a bad variable}' */
+@d frozen_undefined (hash_top+14) /* |hash| location that never gets defined */
+@d hash_end (hash_top+14) /* the actual size of the |hash| and |eqtb| arrays */
+
+@<Glob...@>=
+two_halves *hash; /* the hash table */
+two_halves *eqtb; /* the equivalents */
+
+@ @<Allocate or initialize ...@>=
+mp->hash = xmalloc((hash_end+1),sizeof(two_halves));
+mp->eqtb = xmalloc((hash_end+1),sizeof(two_halves));
+
+@ @<Dealloc variables@>=
+xfree(mp->hash);
+xfree(mp->eqtb);
+
+@ @<Set init...@>=
+next(1)=0; text(1)=0; eq_type(1)=tag_token; equiv(1)=null;
+for (k=2;k<=hash_end;k++)  { 
+  mp->hash[k]=mp->hash[1]; mp->eqtb[k]=mp->eqtb[1];
+}
+
+@ @<Initialize table entries...@>=
+mp->hash_used=frozen_inaccessible; /* nothing is used */
+mp->st_count=0;
+text(frozen_bad_vardef)=intern("a bad variable");
+text(frozen_etex)=intern("etex");
+text(frozen_mpx_break)=intern("mpxbreak");
+text(frozen_fi)=intern("fi");
+text(frozen_end_group)=intern("endgroup");
+text(frozen_end_def)=intern("enddef");
+text(frozen_end_for)=intern("endfor");
+text(frozen_semicolon)=intern(";");
+text(frozen_colon)=intern(":");
+text(frozen_slash)=intern("/");
+text(frozen_left_bracket)=intern("[");
+text(frozen_right_delimiter)=intern(")");
+text(frozen_inaccessible)=intern(" INACCESSIBLE");
+eq_type(frozen_right_delimiter)=right_delimiter;
+
+@ @<Check the ``constant'' values...@>=
+if ( hash_end+mp->max_internal>max_halfword ) mp->bad=17;
+
+@ Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length~|l| appearing in |buffer[j..
+(j+l-1)]|. If the identifier is not found, it is inserted; hence it
+will always be found, and the corresponding hash table address
+will be returned.
+
+@c 
+pointer mp_id_lookup (MP mp,integer j, integer l) { /* search the hash table */
+  integer h; /* hash code */
+  pointer p; /* index in |hash| array */
+  pointer k; /* index in |buffer| array */
+  if (l==1) {
+    @<Treat special case of length 1 and |break|@>;
+  }
+  @<Compute the hash code |h|@>;
+  p=h+hash_base; /* we start searching here; note that |0<=h<hash_prime| */
+  while (true)  { 
+	if (text(p)>0 && length(text(p))==l && mp_str_eq_buf(mp, text(p),j)) 
+      break;
+    if ( next(p)==0 ) {
+      @<Insert a new symbolic token after |p|, then
+        make |p| point to it and |break|@>;
+    }
+    p=next(p);
+  }
+  return p;
+}
+
+@ @<Treat special case of length 1...@>=
+ p=mp->buffer[j]+1; text(p)=p-1; return p;
+
+
+@ @<Insert a new symbolic...@>=
+{
+if ( text(p)>0 ) { 
+  do {  
+    if ( hash_is_full )
+      mp_overflow(mp, "hash size",mp->hash_size);
+@:MetaPost capacity exceeded hash size}{\quad hash size@>
+    decr(mp->hash_used);
+  } while (text(mp->hash_used)!=0); /* search for an empty location in |hash| */
+  next(p)=mp->hash_used; 
+  p=mp->hash_used;
+}
+str_room(l);
+for (k=j;k<=j+l-1;k++) {
+  append_char(mp->buffer[k]);
+}
+text(p)=mp_make_string(mp); 
+mp->str_ref[text(p)]=max_str_ref;
+incr(mp->st_count);
+break;
+}
+
+
+@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
+should be a prime number.  The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+@^Vitter, Jeffrey Scott@>
+
+@<Compute the hash code |h|@>=
+h=mp->buffer[j];
+for (k=j+1;k<=j+l-1;k++){ 
+  h=h+h+mp->buffer[k];
+  while ( h>=mp->hash_prime ) h=h-mp->hash_prime;
+}
+
+@ @<Search |eqtb| for equivalents equal to |p|@>=
+for (q=1;q<=hash_end;q++) { 
+  if ( equiv(q)==p ) { 
+    mp_print_nl(mp, "EQUIV("); 
+    mp_print_int(mp, q); 
+    mp_print_char(mp, ')');
+  }
+}
+
+@ We need to put \MP's ``primitive'' symbolic tokens into the hash
+table, together with their command code (which will be the |eq_type|)
+and an operand (which will be the |equiv|). The |primitive| procedure
+does this, in a way that no \MP\ user can. The global value |cur_sym|
+contains the new |eqtb| pointer after |primitive| has acted.
+
+@c 
+void mp_primitive (MP mp, const char *ss, halfword c, halfword o) {
+  pool_pointer k; /* index into |str_pool| */
+  small_number j; /* index into |buffer| */
+  small_number l; /* length of the string */
+  str_number s;
+  s = intern(ss);
+  k=mp->str_start[s]; l=str_stop(s)-k;
+  /* we will move |s| into the (empty) |buffer| */
+  for (j=0;j<=l-1;j++) {
+    mp->buffer[j]=mp->str_pool[k+j];
+  }
+  mp->cur_sym=mp_id_lookup(mp, 0,l);
+  if ( s>=256 ) { /* we don't want to have the string twice */
+    mp_flush_string(mp, text(mp->cur_sym)); text(mp->cur_sym)=s;
+  };
+  eq_type(mp->cur_sym)=c; 
+  equiv(mp->cur_sym)=o;
+}
+
+
+@ Many of \MP's primitives need no |equiv|, since they are identifiable
+by their |eq_type| alone. These primitives are loaded into the hash table
+as follows:
+
+@<Put each of \MP's primitives into the hash table@>=
+mp_primitive(mp, "..",path_join,0);
+@:.._}{\.{..} primitive@>
+mp_primitive(mp, "[",left_bracket,0); mp->eqtb[frozen_left_bracket]=mp->eqtb[mp->cur_sym];
+@:[ }{\.{[} primitive@>
+mp_primitive(mp, "]",right_bracket,0);
+@:] }{\.{]} primitive@>
+mp_primitive(mp, "}",right_brace,0);
+@:]]}{\.{\char`\}} primitive@>
+mp_primitive(mp, "{",left_brace,0);
+@:][}{\.{\char`\{} primitive@>
+mp_primitive(mp, ":",colon,0); mp->eqtb[frozen_colon]=mp->eqtb[mp->cur_sym];
+@:: }{\.{:} primitive@>
+mp_primitive(mp, "::",double_colon,0);
+@::: }{\.{::} primitive@>
+mp_primitive(mp, "||:",bchar_label,0);
+@:::: }{\.{\char'174\char'174:} primitive@>
+mp_primitive(mp, ":=",assignment,0);
+@::=_}{\.{:=} primitive@>
+mp_primitive(mp, ",",comma,0);
+@:, }{\., primitive@>
+mp_primitive(mp, ";",semicolon,0); mp->eqtb[frozen_semicolon]=mp->eqtb[mp->cur_sym];
+@:; }{\.; primitive@>
+mp_primitive(mp, "\\",relax,0);
+@:]]\\}{\.{\char`\\} primitive@>
+@#
+mp_primitive(mp, "addto",add_to_command,0);
+@:add_to_}{\&{addto} primitive@>
+mp_primitive(mp, "atleast",at_least,0);
+@:at_least_}{\&{atleast} primitive@>
+mp_primitive(mp, "begingroup",begin_group,0); mp->bg_loc=mp->cur_sym;
+@:begin_group_}{\&{begingroup} primitive@>
+mp_primitive(mp, "controls",controls,0);
+@:controls_}{\&{controls} primitive@>
+mp_primitive(mp, "curl",curl_command,0);
+@:curl_}{\&{curl} primitive@>
+mp_primitive(mp, "delimiters",delimiters,0);
+@:delimiters_}{\&{delimiters} primitive@>
+mp_primitive(mp, "endgroup",end_group,0);
+ mp->eqtb[frozen_end_group]=mp->eqtb[mp->cur_sym]; mp->eg_loc=mp->cur_sym;
+@:endgroup_}{\&{endgroup} primitive@>
+mp_primitive(mp, "everyjob",every_job_command,0);
+@:every_job_}{\&{everyjob} primitive@>
+mp_primitive(mp, "exitif",exit_test,0);
+@:exit_if_}{\&{exitif} primitive@>
+mp_primitive(mp, "expandafter",expand_after,0);
+@:expand_after_}{\&{expandafter} primitive@>
+mp_primitive(mp, "interim",interim_command,0);
+@:interim_}{\&{interim} primitive@>
+mp_primitive(mp, "let",let_command,0);
+@:let_}{\&{let} primitive@>
+mp_primitive(mp, "newinternal",new_internal,0);
+@:new_internal_}{\&{newinternal} primitive@>
+mp_primitive(mp, "of",of_token,0);
+@:of_}{\&{of} primitive@>
+mp_primitive(mp, "randomseed",mp_random_seed,0);
+@:mp_random_seed_}{\&{randomseed} primitive@>
+mp_primitive(mp, "save",save_command,0);
+@:save_}{\&{save} primitive@>
+mp_primitive(mp, "scantokens",scan_tokens,0);
+@:scan_tokens_}{\&{scantokens} primitive@>
+mp_primitive(mp, "shipout",ship_out_command,0);
+@:ship_out_}{\&{shipout} primitive@>
+mp_primitive(mp, "skipto",skip_to,0);
+@:skip_to_}{\&{skipto} primitive@>
+mp_primitive(mp, "special",special_command,0);
+@:special}{\&{special} primitive@>
+mp_primitive(mp, "fontmapfile",special_command,1);
+@:fontmapfile}{\&{fontmapfile} primitive@>
+mp_primitive(mp, "fontmapline",special_command,2);
+@:fontmapline}{\&{fontmapline} primitive@>
+mp_primitive(mp, "step",step_token,0);
+@:step_}{\&{step} primitive@>
+mp_primitive(mp, "str",str_op,0);
+@:str_}{\&{str} primitive@>
+mp_primitive(mp, "tension",tension,0);
+@:tension_}{\&{tension} primitive@>
+mp_primitive(mp, "to",to_token,0);
+@:to_}{\&{to} primitive@>
+mp_primitive(mp, "until",until_token,0);
+@:until_}{\&{until} primitive@>
+mp_primitive(mp, "within",within_token,0);
+@:within_}{\&{within} primitive@>
+mp_primitive(mp, "write",write_command,0);
+@:write_}{\&{write} primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of |eqtb| in symbolic form.
+Every call of |primitive| in this program is therefore accompanied by some
+straightforward code that forms part of the |print_cmd_mod| routine
+explained below.
+
+@<Cases of |print_cmd_mod| for symbolic printing of primitives@>=
+case add_to_command:mp_print(mp, "addto"); break;
+case assignment:mp_print(mp, ":="); break;
+case at_least:mp_print(mp, "atleast"); break;
+case bchar_label:mp_print(mp, "||:"); break;
+case begin_group:mp_print(mp, "begingroup"); break;
+case colon:mp_print(mp, ":"); break;
+case comma:mp_print(mp, ","); break;
+case controls:mp_print(mp, "controls"); break;
+case curl_command:mp_print(mp, "curl"); break;
+case delimiters:mp_print(mp, "delimiters"); break;
+case double_colon:mp_print(mp, "::"); break;
+case end_group:mp_print(mp, "endgroup"); break;
+case every_job_command:mp_print(mp, "everyjob"); break;
+case exit_test:mp_print(mp, "exitif"); break;
+case expand_after:mp_print(mp, "expandafter"); break;
+case interim_command:mp_print(mp, "interim"); break;
+case left_brace:mp_print(mp, "{"); break;
+case left_bracket:mp_print(mp, "["); break;
+case let_command:mp_print(mp, "let"); break;
+case new_internal:mp_print(mp, "newinternal"); break;
+case of_token:mp_print(mp, "of"); break;
+case path_join:mp_print(mp, ".."); break;
+case mp_random_seed:mp_print(mp, "randomseed"); break;
+case relax:mp_print_char(mp, '\\'); break;
+case right_brace:mp_print(mp, "}"); break;
+case right_bracket:mp_print(mp, "]"); break;
+case save_command:mp_print(mp, "save"); break;
+case scan_tokens:mp_print(mp, "scantokens"); break;
+case semicolon:mp_print(mp, ";"); break;
+case ship_out_command:mp_print(mp, "shipout"); break;
+case skip_to:mp_print(mp, "skipto"); break;
+case special_command: if ( m==2 ) mp_print(mp, "fontmapline"); else
+                 if ( m==1 ) mp_print(mp, "fontmapfile"); else
+                 mp_print(mp, "special"); break;
+case step_token:mp_print(mp, "step"); break;
+case str_op:mp_print(mp, "str"); break;
+case tension:mp_print(mp, "tension"); break;
+case to_token:mp_print(mp, "to"); break;
+case until_token:mp_print(mp, "until"); break;
+case within_token:mp_print(mp, "within"); break;
+case write_command:mp_print(mp, "write"); break;
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful.  For example,
+the primitives for macro definitions will be loaded when we consider the
+routines that define macros.
+It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where |"def"| entered |eqtb| is listed under `\&{def} primitive'.
+
+@* \[14] Token lists.
+A \MP\ token is either symbolic or numeric or a string, or it denotes
+a macro parameter or capsule; so there are five corresponding ways to encode it
+@^token@>
+internally: (1)~A symbolic token whose hash code is~|p|
+is represented by the number |p|, in the |info| field of a single-word
+node in~|mem|. (2)~A numeric token whose |scaled| value is~|v| is
+represented in a two-word node of~|mem|; the |type| field is |known|,
+the |name_type| field is |token|, and the |value| field holds~|v|.
+The fact that this token appears in a two-word node rather than a
+one-word node is, of course, clear from the node address.
+(3)~A string token is also represented in a two-word node; the |type|
+field is |mp_string_type|, the |name_type| field is |token|, and the
+|value| field holds the corresponding |str_number|.  (4)~Capsules have
+|name_type=capsule|, and their |type| and |value| fields represent
+arbitrary values (in ways to be explained later).  (5)~Macro parameters
+are like symbolic tokens in that they appear in |info| fields of
+one-word nodes. The $k$th parameter is represented by |expr_base+k| if it
+is of type \&{expr}, or by |suffix_base+k| if it is of type \&{suffix}, or
+by |text_base+k| if it is of type \&{text}.  (Here |0<=k<param_size|.)
+Actual values of these parameters are kept in a separate stack, as we will
+see later.  The constants |expr_base|, |suffix_base|, and |text_base| are,
+of course, chosen so that there will be no confusion between symbolic
+tokens and parameters of various types.
+
+Note that
+the `\\{type}' field of a node has nothing to do with ``type'' in a
+printer's sense. It's curious that the same word is used in such different ways.
+
+@d type(A)   mp->mem[(A)].hh.b0 /* identifies what kind of value this is */
+@d name_type(A)   mp->mem[(A)].hh.b1 /* a clue to the name of this value */
+@d token_node_size 2 /* the number of words in a large token node */
+@d value_loc(A) ((A)+1) /* the word that contains the |value| field */
+@d value(A) mp->mem[value_loc((A))].cint /* the value stored in a large token node */
+@d expr_base (hash_end+1) /* code for the zeroth \&{expr} parameter */
+@d suffix_base (expr_base+mp->param_size) /* code for the zeroth \&{suffix} parameter */
+@d text_base (suffix_base+mp->param_size) /* code for the zeroth \&{text} parameter */
+
+@<Check the ``constant''...@>=
+if ( text_base+mp->param_size>max_halfword ) mp->bad=18;
+
+@ We have set aside a two word node beginning at |null| so that we can have
+|value(null)=0|.  We will make use of this coincidence later.
+
+@<Initialize table entries...@>=
+link(null)=null; value(null)=0;
+
+@ A numeric token is created by the following trivial routine.
+
+@c 
+pointer mp_new_num_tok (MP mp,scaled v) {
+  pointer p; /* the new node */
+  p=mp_get_node(mp, token_node_size); value(p)=v;
+  type(p)=mp_known; name_type(p)=mp_token; 
+  return p;
+}
+
+@ A token list is a singly linked list of nodes in |mem|, where
+each node contains a token and a link.  Here's a subroutine that gets rid
+of a token list when it is no longer needed.
+
+@c void mp_flush_token_list (MP mp,pointer p) {
+  pointer q; /* the node being recycled */
+  while ( p!=null ) { 
+    q=p; p=link(p);
+    if ( q>=mp->hi_mem_min ) {
+     free_avail(q);
+    } else { 
+      switch (type(q)) {
+      case mp_vacuous: case mp_boolean_type: case mp_known:
+        break;
+      case mp_string_type:
+        delete_str_ref(value(q));
+        break;
+      case unknown_types: case mp_pen_type: case mp_path_type: 
+      case mp_picture_type: case mp_pair_type: case mp_color_type:
+      case mp_cmykcolor_type: case mp_transform_type: case mp_dependent:
+      case mp_proto_dependent: case mp_independent:
+        mp_recycle_value(mp,q);
+        break;
+      default: mp_confusion(mp, "token");
+@:this can't happen token}{\quad token@>
+      }
+      mp_free_node(mp, q,token_node_size);
+    }
+  }
+}
+
+@ The procedure |show_token_list|, which prints a symbolic form of
+the token list that starts at a given node |p|, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be fairly robust, so that if the
+memory links are awry or if |p| is not really a pointer to a token list,
+almost nothing catastrophic can happen.
+
+An additional parameter |q| is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, |q| is non-null when
+we are printing the two-line context information at the time of an error
+message; |q| marks the place corresponding to where the second line
+should begin.)
+
+The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
+of printing exceeds a given limit~|l|; the length of printing upon entry is
+assumed to be a given amount called |null_tally|. (Note that
+|show_token_list| sometimes uses itself recursively to print
+variable names within a capsule.)
+@^recursion@>
+
+Unusual entries are printed in the form of all-caps tokens
+preceded by a space, e.g., `\.{\char`\ BAD}'.
+
+@<Declare the procedure called |show_token_list|@>=
+void mp_show_token_list (MP mp, integer p, integer q, integer l,
+                         integer null_tally) ;
+
+@ @c
+void mp_show_token_list (MP mp, integer p, integer q, integer l,
+                         integer null_tally) {
+  small_number class,c; /* the |char_class| of previous and new tokens */
+  integer r,v; /* temporary registers */
+  class=percent_class;
+  mp->tally=null_tally;
+  while ( (p!=null) && (mp->tally<l) ) { 
+    if ( p==q ) 
+      @<Do magic computation@>;
+    @<Display token |p| and set |c| to its class;
+      but |return| if there are problems@>;
+    class=c; p=link(p);
+  }
+  if ( p!=null ) 
+     mp_print(mp, " ETC.");
+@.ETC@>
+  return;
+}
+
+@ @<Display token |p| and set |c| to its class...@>=
+c=letter_class; /* the default */
+if ( (p<0)||(p>mp->mem_end) ) { 
+  mp_print(mp, " CLOBBERED"); return;
+@.CLOBBERED@>
+}
+if ( p<mp->hi_mem_min ) { 
+  @<Display two-word token@>;
+} else { 
+  r=info(p);
+  if ( r>=expr_base ) {
+     @<Display a parameter token@>;
+  } else {
+    if ( r<1 ) {
+      if ( r==0 ) { 
+        @<Display a collective subscript@>
+      } else {
+        mp_print(mp, " IMPOSSIBLE");
+@.IMPOSSIBLE@>
+      }
+    } else { 
+      r=text(r);
+      if ( (r<0)||(r>mp->max_str_ptr) ) {
+        mp_print(mp, " NONEXISTENT");
+@.NONEXISTENT@>
+      } else {
+       @<Print string |r| as a symbolic token
+        and set |c| to its class@>;
+      }
+    }
+  }
+}
+
+@ @<Display two-word token@>=
+if ( name_type(p)==mp_token ) {
+  if ( type(p)==mp_known ) {
+    @<Display a numeric token@>;
+  } else if ( type(p)!=mp_string_type ) {
+    mp_print(mp, " BAD");
+@.BAD@>
+  } else { 
+    mp_print_char(mp, '"'); mp_print_str(mp, value(p)); mp_print_char(mp, '"');
+    c=string_class;
+  }
+} else if ((name_type(p)!=mp_capsule)||(type(p)<mp_vacuous)||(type(p)>mp_independent) ) {
+  mp_print(mp, " BAD");
+} else { 
+  mp_print_capsule(mp,p); c=right_paren_class;
+}
+
+@ @<Display a numeric token@>=
+if ( class==digit_class ) 
+  mp_print_char(mp, ' ');
+v=value(p);
+if ( v<0 ){ 
+  if ( class==left_bracket_class ) 
+    mp_print_char(mp, ' ');
+  mp_print_char(mp, '['); mp_print_scaled(mp, v); mp_print_char(mp, ']');
+  c=right_bracket_class;
+} else { 
+  mp_print_scaled(mp, v); c=digit_class;
+}
+
+
+@ Strictly speaking, a genuine token will never have |info(p)=0|.
+But we will see later (in the |print_variable_name| routine) that
+it is convenient to let |info(p)=0| stand for `\.{[]}'.
+
+@<Display a collective subscript@>=
+{
+if ( class==left_bracket_class ) 
+  mp_print_char(mp, ' ');
+mp_print(mp, "[]"); c=right_bracket_class;
+}
+
+@ @<Display a parameter token@>=
+{
+if ( r<suffix_base ) { 
+  mp_print(mp, "(EXPR"); r=r-(expr_base);
+@.EXPR@>
+} else if ( r<text_base ) { 
+  mp_print(mp, "(SUFFIX"); r=r-(suffix_base);
+@.SUFFIX@>
+} else { 
+  mp_print(mp, "(TEXT"); r=r-(text_base);
+@.TEXT@>
+}
+mp_print_int(mp, r); mp_print_char(mp, ')'); c=right_paren_class;
+}
+
+
+@ @<Print string |r| as a symbolic token...@>=
+{ 
+c=mp->char_class[mp->str_pool[mp->str_start[r]]];
+if ( c==class ) {
+  switch (c) {
+  case letter_class:mp_print_char(mp, '.'); break;
+  case isolated_classes: break;
+  default: mp_print_char(mp, ' '); break;
+  }
+}
+mp_print_str(mp, r);
+}
+
+@ @<Declarations@>=
+void mp_print_capsule (MP mp, pointer p);
+
+@ @<Declare miscellaneous procedures that were declared |forward|@>=
+void mp_print_capsule (MP mp, pointer p) { 
+  mp_print_char(mp, '('); mp_print_exp(mp,p,0); mp_print_char(mp, ')');
+}
+
+@ Macro definitions are kept in \MP's memory in the form of token lists
+that have a few extra one-word nodes at the beginning.
+
+The first node contains a reference count that is used to tell when the
+list is no longer needed. To emphasize the fact that a reference count is
+present, we shall refer to the |info| field of this special node as the
+|ref_count| field.
+@^reference counts@>
+
+The next node or nodes after the reference count serve to describe the
+formal parameters. They consist of zero or more parameter tokens followed
+by a code for the type of macro.
+
+@d ref_count info
+  /* reference count preceding a macro definition or picture header */
+@d add_mac_ref(A) incr(ref_count((A))) /* make a new reference to a macro list */
+@d general_macro 0 /* preface to a macro defined with a parameter list */
+@d primary_macro 1 /* preface to a macro with a \&{primary} parameter */
+@d secondary_macro 2 /* preface to a macro with a \&{secondary} parameter */
+@d tertiary_macro 3 /* preface to a macro with a \&{tertiary} parameter */
+@d expr_macro 4 /* preface to a macro with an undelimited \&{expr} parameter */
+@d of_macro 5 /* preface to a macro with
+  undelimited `\&{expr} |x| \&{of}~|y|' parameters */
+@d suffix_macro 6 /* preface to a macro with an undelimited \&{suffix} parameter */
+@d text_macro 7 /* preface to a macro with an undelimited \&{text} parameter */
+
+@c 
+void mp_delete_mac_ref (MP mp,pointer p) {
+  /* |p| points to the reference count of a macro list that is
+    losing one reference */
+  if ( ref_count(p)==null ) mp_flush_token_list(mp, p);
+  else decr(ref_count(p));
+}
+
+@ The following subroutine displays a macro, given a pointer to its
+reference count.
+
+@c 
+@<Declare the procedure called |print_cmd_mod|@>
+void mp_show_macro (MP mp, pointer p, integer q, integer l) {
+  pointer r; /* temporary storage */
+  p=link(p); /* bypass the reference count */
+  while ( info(p)>text_macro ){ 
+    r=link(p); link(p)=null;
+    mp_show_token_list(mp, p,null,l,0); link(p)=r; p=r;
+    if ( l>0 ) l=l-mp->tally; else return;
+  } /* control printing of `\.{ETC.}' */
+@.ETC@>
+  mp->tally=0;
+  switch(info(p)) {
+  case general_macro:mp_print(mp, "->"); break;
+@.->@>
+  case primary_macro: case secondary_macro: case tertiary_macro:
+    mp_print_char(mp, '<');
+    mp_print_cmd_mod(mp, param_type,info(p)); 
+    mp_print(mp, ">->");
+    break;
+  case expr_macro:mp_print(mp, "<expr>->"); break;
+  case of_macro:mp_print(mp, "<expr>of<primary>->"); break;
+  case suffix_macro:mp_print(mp, "<suffix>->"); break;
+  case text_macro:mp_print(mp, "<text>->"); break;
+  } /* there are no other cases */
+  mp_show_token_list(mp, link(p),q,l-mp->tally,0);
+}
+
+@* \[15] Data structures for variables.
+The variables of \MP\ programs can be simple, like `\.x', or they can
+combine the structural properties of arrays and records, like `\.{x20a.b}'.
+A \MP\ user assigns a type to a variable like \.{x20a.b} by saying, for
+example, `\.{boolean} \.{x[]a.b}'. It's time for us to study how such
+things are represented inside of the computer.
+
+Each variable value occupies two consecutive words, either in a two-word
+node called a value node, or as a two-word subfield of a larger node.  One
+of those two words is called the |value| field; it is an integer,
+containing either a |scaled| numeric value or the representation of some
+other type of quantity. (It might also be subdivided into halfwords, in
+which case it is referred to by other names instead of |value|.) The other
+word is broken into subfields called |type|, |name_type|, and |link|.  The
+|type| field is a quarterword that specifies the variable's type, and
+|name_type| is a quarterword from which \MP\ can reconstruct the
+variable's name (sometimes by using the |link| field as well).  Thus, only
+1.25 words are actually devoted to the value itself; the other
+three-quarters of a word are overhead, but they aren't wasted because they
+allow \MP\ to deal with sparse arrays and to provide meaningful diagnostics.
+
+In this section we shall be concerned only with the structural aspects of
+variables, not their values. Later parts of the program will change the
+|type| and |value| fields, but we shall treat those fields as black boxes
+whose contents should not be touched.
+
+However, if the |type| field is |mp_structured|, there is no |value| field,
+and the second word is broken into two pointer fields called |attr_head|
+and |subscr_head|. Those fields point to additional nodes that
+contain structural information, as we shall see.
+
+@d subscr_head_loc(A)   (A)+1 /* where |value|, |subscr_head| and |attr_head| are */
+@d attr_head(A)   info(subscr_head_loc((A))) /* pointer to attribute info */
+@d subscr_head(A)   link(subscr_head_loc((A))) /* pointer to subscript info */
+@d value_node_size 2 /* the number of words in a value node */
+
+@ An attribute node is three words long. Two of these words contain |type|
+and |value| fields as described above, and the third word contains
+additional information:  There is an |attr_loc| field, which contains the
+hash address of the token that names this attribute; and there's also a
+|parent| field, which points to the value node of |mp_structured| type at the
+next higher level (i.e., at the level to which this attribute is
+subsidiary).  The |name_type| in an attribute node is `|attr|'.  The
+|link| field points to the next attribute with the same parent; these are
+arranged in increasing order, so that |attr_loc(link(p))>attr_loc(p)|. The
+final attribute node links to the constant |end_attr|, whose |attr_loc|
+field is greater than any legal hash address. The |attr_head| in the
+parent points to a node whose |name_type| is |mp_structured_root|; this
+node represents the null attribute, i.e., the variable that is relevant
+when no attributes are attached to the parent. The |attr_head| node
+has the fields of either
+a value node, a subscript node, or an attribute node, depending on what
+the parent would be if it were not structured; but the subscript and
+attribute fields are ignored, so it effectively contains only the data of
+a value node. The |link| field in this special node points to an attribute
+node whose |attr_loc| field is zero; the latter node represents a collective
+subscript `\.{[]}' attached to the parent, and its |link| field points to
+the first non-special attribute node (or to |end_attr| if there are none).
+
+A subscript node likewise occupies three words, with |type| and |value| fields
+plus extra information; its |name_type| is |subscr|. In this case the
+third word is called the |subscript| field, which is a |scaled| integer.
+The |link| field points to the subscript node with the next larger
+subscript, if any; otherwise the |link| points to the attribute node
+for collective subscripts at this level. We have seen that the latter node
+contains an upward pointer, so that the parent can be deduced.
+
+The |name_type| in a parent-less value node is |root|, and the |link|
+is the hash address of the token that names this value.
+
+In other words, variables have a hierarchical structure that includes
+enough threads running around so that the program is able to move easily
+between siblings, parents, and children. An example should be helpful:
+(The reader is advised to draw a picture while reading the following
+description, since that will help to firm up the ideas.)
+Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
+and `\.{x20b}' have been mentioned in a user's program, where
+\.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|,
+and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then
+|eq_type(h(x))=name| and |equiv(h(x))=p|, where |p|~is a two-word value
+node with |name_type(p)=root| and |link(p)=h(x)|. We have |type(p)=mp_structured|,
+|attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value
+node and |r| to a subscript node. (Are you still following this? Use
+a pencil to draw a diagram.) The lone variable `\.x' is represented by
+|type(q)| and |value(q)|; furthermore
+|name_type(q)=mp_structured_root| and |link(q)=q1|, where |q1| points
+to an attribute node representing `\.{x[]}'. Thus |name_type(q1)=attr|,
+|attr_loc(q1)=collective_subscript=0|, |parent(q1)=p|,
+|type(q1)=mp_structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|;
+|qq| is a  three-word ``attribute-as-value'' node with |type(qq)=numeric_type|
+(assuming that \.{x5} is numeric, because |qq| represents `\.{x[]}' 
+with no further attributes), |name_type(qq)=structured_root|, 
+|attr_loc(qq)=0|, |parent(qq)=p|, and
+|link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is
+an attribute node representing `\.{x[][]}', which has never yet
+occurred; its |type| field is |undefined|, and its |value| field is
+undefined. We have |name_type(qq1)=attr|, |attr_loc(qq1)=collective_subscript|,
+|parent(qq1)=q1|, and |link(qq1)=qq2|. Since |qq2| represents
+`\.{x[]b}', |type(qq2)=mp_unknown_boolean|; also |attr_loc(qq2)=h(b)|,
+|parent(qq2)=q1|, |name_type(qq2)=attr|, |link(qq2)=end_attr|.
+(Maybe colored lines will help untangle your picture.)
+ Node |r| is a subscript node with |type| and |value|
+representing `\.{x5}'; |name_type(r)=subscr|, |subscript(r)=5.0|,
+and |link(r)=r1| is another subscript node. To complete the picture,
+see if you can guess what |link(r1)| is; give up? It's~|q1|.
+Furthermore |subscript(r1)=20.0|, |name_type(r1)=subscr|,
+|type(r1)=mp_structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|,
+and we finish things off with three more nodes
+|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again
+with a larger sheet of paper.) The value of variable \.{x20b}
+appears in node~|qqq2|, as you can well imagine.
+
+If the example in the previous paragraph doesn't make things crystal
+clear, a glance at some of the simpler subroutines below will reveal how
+things work out in practice.
+
+The only really unusual thing about these conventions is the use of
+collective subscript attributes. The idea is to avoid repeating a lot of
+type information when many elements of an array are identical macros
+(for which distinct values need not be stored) or when they don't have
+all of the possible attributes. Branches of the structure below collective
+subscript attributes do not carry actual values except for macro identifiers;
+branches of the structure below subscript nodes do not carry significant
+information in their collective subscript attributes.
+
+@d attr_loc_loc(A) ((A)+2) /* where the |attr_loc| and |parent| fields are */
+@d attr_loc(A) info(attr_loc_loc((A))) /* hash address of this attribute */
+@d parent(A) link(attr_loc_loc((A))) /* pointer to |mp_structured| variable */
+@d subscript_loc(A) ((A)+2) /* where the |subscript| field lives */
+@d subscript(A) mp->mem[subscript_loc((A))].sc /* subscript of this variable */
+@d attr_node_size 3 /* the number of words in an attribute node */
+@d subscr_node_size 3 /* the number of words in a subscript node */
+@d collective_subscript 0 /* code for the attribute `\.{[]}' */
+
+@<Initialize table...@>=
+attr_loc(end_attr)=hash_end+1; parent(end_attr)=null;
+
+@ Variables of type \&{pair} will have values that point to four-word
+nodes containing two numeric values. The first of these values has
+|name_type=mp_x_part_sector| and the second has |name_type=mp_y_part_sector|;
+the |link| in the first points back to the node whose |value| points
+to this four-word node.
+
+Variables of type \&{transform} are similar, but in this case their
+|value| points to a 12-word node containing six values, identified by
+|x_part_sector|, |y_part_sector|, |mp_xx_part_sector|, |mp_xy_part_sector|,
+|mp_yx_part_sector|, and |mp_yy_part_sector|.
+Finally, variables of type \&{color} have 3~values in 6~words
+identified by |mp_red_part_sector|, |mp_green_part_sector|, and |mp_blue_part_sector|.
+
+When an entire structured variable is saved, the |root| indication
+is temporarily replaced by |saved_root|.
+
+Some variables have no name; they just are used for temporary storage
+while expressions are being evaluated. We call them {\sl capsules}.
+
+@d x_part_loc(A) (A) /* where the \&{xpart} is found in a pair or transform node */
+@d y_part_loc(A) ((A)+2) /* where the \&{ypart} is found in a pair or transform node */
+@d xx_part_loc(A) ((A)+4) /* where the \&{xxpart} is found in a transform node */
+@d xy_part_loc(A) ((A)+6) /* where the \&{xypart} is found in a transform node */
+@d yx_part_loc(A) ((A)+8) /* where the \&{yxpart} is found in a transform node */
+@d yy_part_loc(A) ((A)+10) /* where the \&{yypart} is found in a transform node */
+@d red_part_loc(A) (A) /* where the \&{redpart} is found in a color node */
+@d green_part_loc(A) ((A)+2) /* where the \&{greenpart} is found in a color node */
+@d blue_part_loc(A) ((A)+4) /* where the \&{bluepart} is found in a color node */
+@d cyan_part_loc(A) (A) /* where the \&{cyanpart} is found in a color node */
+@d magenta_part_loc(A) ((A)+2) /* where the \&{magentapart} is found in a color node */
+@d yellow_part_loc(A) ((A)+4) /* where the \&{yellowpart} is found in a color node */
+@d black_part_loc(A) ((A)+6) /* where the \&{blackpart} is found in a color node */
+@d grey_part_loc(A) (A) /* where the \&{greypart} is found in a color node */
+@#
+@d pair_node_size 4 /* the number of words in a pair node */
+@d transform_node_size 12 /* the number of words in a transform node */
+@d color_node_size 6 /* the number of words in a color node */
+@d cmykcolor_node_size 8 /* the number of words in a color node */
+
+@<Glob...@>=
+small_number big_node_size[mp_pair_type+1];
+small_number sector0[mp_pair_type+1];
+small_number sector_offset[mp_black_part_sector+1];
+
+@ The |sector0| array gives for each big node type, |name_type| values
+for its first subfield; the |sector_offset| array gives for each
+|name_type| value, the offset from the first subfield in words;
+and the |big_node_size| array gives the size in words for each type of
+big node.
+
+@<Set init...@>=
+mp->big_node_size[mp_transform_type]=transform_node_size;
+mp->big_node_size[mp_pair_type]=pair_node_size;
+mp->big_node_size[mp_color_type]=color_node_size;
+mp->big_node_size[mp_cmykcolor_type]=cmykcolor_node_size;
+mp->sector0[mp_transform_type]=mp_x_part_sector;
+mp->sector0[mp_pair_type]=mp_x_part_sector;
+mp->sector0[mp_color_type]=mp_red_part_sector;
+mp->sector0[mp_cmykcolor_type]=mp_cyan_part_sector;
+for (k=mp_x_part_sector;k<= mp_yy_part_sector;k++ ) {
+  mp->sector_offset[k]=2*(k-mp_x_part_sector);
+}
+for (k=mp_red_part_sector;k<= mp_blue_part_sector ; k++) {
+  mp->sector_offset[k]=2*(k-mp_red_part_sector);
+}
+for (k=mp_cyan_part_sector;k<= mp_black_part_sector;k++ ) {
+  mp->sector_offset[k]=2*(k-mp_cyan_part_sector);
+}
+
+@ If |type(p)=mp_pair_type| or |mp_transform_type| and if |value(p)=null|, the
+procedure call |init_big_node(p)| will allocate a pair or transform node
+for~|p|.  The individual parts of such nodes are initially of type
+|mp_independent|.
+
+@c 
+void mp_init_big_node (MP mp,pointer p) {
+  pointer q; /* the new node */
+  small_number s; /* its size */
+  s=mp->big_node_size[type(p)]; q=mp_get_node(mp, s);
+  do {  
+    s=s-2; 
+    @<Make variable |q+s| newly independent@>;
+    name_type(q+s)=halfp(s)+mp->sector0[type(p)]; 
+    link(q+s)=null;
+  } while (s!=0);
+  link(q)=p; value(p)=q;
+}
+
+@ The |id_transform| function creates a capsule for the
+identity transformation.
+
+@c 
+pointer mp_id_transform (MP mp) {
+  pointer p,q,r; /* list manipulation registers */
+  p=mp_get_node(mp, value_node_size); type(p)=mp_transform_type;
+  name_type(p)=mp_capsule; value(p)=null; mp_init_big_node(mp, p); q=value(p);
+  r=q+transform_node_size;
+  do {  
+    r=r-2;
+    type(r)=mp_known; value(r)=0;
+  } while (r!=q);
+  value(xx_part_loc(q))=unity; 
+  value(yy_part_loc(q))=unity;
+  return p;
+}
+
+@ Tokens are of type |tag_token| when they first appear, but they point
+to |null| until they are first used as the root of a variable.
+The following subroutine establishes the root node on such grand occasions.
+
+@c 
+void mp_new_root (MP mp,pointer x) {
+  pointer p; /* the new node */
+  p=mp_get_node(mp, value_node_size); type(p)=undefined; name_type(p)=mp_root;
+  link(p)=x; equiv(x)=p;
+}
+
+@ These conventions for variable representation are illustrated by the
+|print_variable_name| routine, which displays the full name of a
+variable given only a pointer to its two-word value packet.
+
+@<Declarations@>=
+void mp_print_variable_name (MP mp, pointer p);
+
+@ @c 
+void mp_print_variable_name (MP mp, pointer p) {
+  pointer q; /* a token list that will name the variable's suffix */
+  pointer r; /* temporary for token list creation */
+  while ( name_type(p)>=mp_x_part_sector ) {
+    @<Preface the output with a part specifier; |return| in the
+      case of a capsule@>;
+  }
+  q=null;
+  while ( name_type(p)>mp_saved_root ) {
+    @<Ascend one level, pushing a token onto list |q|
+     and replacing |p| by its parent@>;
+  }
+  r=mp_get_avail(mp); info(r)=link(p); link(r)=q;
+  if ( name_type(p)==mp_saved_root ) mp_print(mp, "(SAVED)");
+@.SAVED@>
+  mp_show_token_list(mp, r,null,el_gordo,mp->tally); 
+  mp_flush_token_list(mp, r);
+}
+
+@ @<Ascend one level, pushing a token onto list |q|...@>=
+{ 
+  if ( name_type(p)==mp_subscr ) { 
+    r=mp_new_num_tok(mp, subscript(p));
+    do {  
+      p=link(p);
+    } while (name_type(p)!=mp_attr);
+  } else if ( name_type(p)==mp_structured_root ) {
+    p=link(p); goto FOUND;
+  } else { 
+    if ( name_type(p)!=mp_attr ) mp_confusion(mp, "var");
+@:this can't happen var}{\quad var@>
+    r=mp_get_avail(mp); info(r)=attr_loc(p);
+  }
+  link(r)=q; q=r;
+FOUND:  
+  p=parent(p);
+}
+
+@ @<Preface the output with a part specifier...@>=
+{ switch (name_type(p)) {
+  case mp_x_part_sector: mp_print_char(mp, 'x'); break;
+  case mp_y_part_sector: mp_print_char(mp, 'y'); break;
+  case mp_xx_part_sector: mp_print(mp, "xx"); break;
+  case mp_xy_part_sector: mp_print(mp, "xy"); break;
+  case mp_yx_part_sector: mp_print(mp, "yx"); break;
+  case mp_yy_part_sector: mp_print(mp, "yy"); break;
+  case mp_red_part_sector: mp_print(mp, "red"); break;
+  case mp_green_part_sector: mp_print(mp, "green"); break;
+  case mp_blue_part_sector: mp_print(mp, "blue"); break;
+  case mp_cyan_part_sector: mp_print(mp, "cyan"); break;
+  case mp_magenta_part_sector: mp_print(mp, "magenta"); break;
+  case mp_yellow_part_sector: mp_print(mp, "yellow"); break;
+  case mp_black_part_sector: mp_print(mp, "black"); break;
+  case mp_grey_part_sector: mp_print(mp, "grey"); break;
+  case mp_capsule: 
+    mp_print(mp, "%CAPSULE"); mp_print_int(mp, p-null); return;
+    break;
+@.CAPSULE@>
+  } /* there are no other cases */
+  mp_print(mp, "part "); 
+  p=link(p-mp->sector_offset[name_type(p)]);
+}
+
+@ The |interesting| function returns |true| if a given variable is not
+in a capsule, or if the user wants to trace capsules.
+
+@c 
+boolean mp_interesting (MP mp,pointer p) {
+  small_number t; /* a |name_type| */
+  if ( mp->internal[mp_tracing_capsules]>0 ) {
+    return true;
+  } else { 
+    t=name_type(p);
+    if ( t>=mp_x_part_sector ) if ( t!=mp_capsule )
+      t=name_type(link(p-mp->sector_offset[t]));
+    return (t!=mp_capsule);
+  }
+}
+
+@ Now here is a subroutine that converts an unstructured type into an
+equivalent structured type, by inserting a |mp_structured| node that is
+capable of growing. This operation is done only when |name_type(p)=root|,
+|subscr|, or |attr|.
+
+The procedure returns a pointer to the new node that has taken node~|p|'s
+place in the structure. Node~|p| itself does not move, nor are its
+|value| or |type| fields changed in any way.
+
+@c 
+pointer mp_new_structure (MP mp,pointer p) {
+  pointer q,r=0; /* list manipulation registers */
+  switch (name_type(p)) {
+  case mp_root: 
+    q=link(p); r=mp_get_node(mp, value_node_size); equiv(q)=r;
+    break;
+  case mp_subscr: 
+    @<Link a new subscript node |r| in place of node |p|@>;
+    break;
+  case mp_attr: 
+    @<Link a new attribute node |r| in place of node |p|@>;
+    break;
+  default: 
+    mp_confusion(mp, "struct");
+@:this can't happen struct}{\quad struct@>
+    break;
+  }
+  link(r)=link(p); type(r)=mp_structured; name_type(r)=name_type(p);
+  attr_head(r)=p; name_type(p)=mp_structured_root;
+  q=mp_get_node(mp, attr_node_size); link(p)=q; subscr_head(r)=q;
+  parent(q)=r; type(q)=undefined; name_type(q)=mp_attr; link(q)=end_attr;
+  attr_loc(q)=collective_subscript; 
+  return r;
+}
+
+@ @<Link a new subscript node |r| in place of node |p|@>=
+{ 
+  q=p;
+  do {  
+    q=link(q);
+  } while (name_type(q)!=mp_attr);
+  q=parent(q); r=subscr_head_loc(q); /* |link(r)=subscr_head(q)| */
+  do {  
+    q=r; r=link(r);
+  } while (r!=p);
+  r=mp_get_node(mp, subscr_node_size);
+  link(q)=r; subscript(r)=subscript(p);
+}
+
+@ If the attribute is |collective_subscript|, there are two pointers to
+node~|p|, so we must change both of them.
+
+@<Link a new attribute node |r| in place of node |p|@>=
+{ 
+  q=parent(p); r=attr_head(q);
+  do {  
+    q=r; r=link(r);
+  } while (r!=p);
+  r=mp_get_node(mp, attr_node_size); link(q)=r;
+  mp->mem[attr_loc_loc(r)]=mp->mem[attr_loc_loc(p)]; /* copy |attr_loc| and |parent| */
+  if ( attr_loc(p)==collective_subscript ) { 
+    q=subscr_head_loc(parent(p));
+    while ( link(q)!=p ) q=link(q);
+    link(q)=r;
+  }
+}
+
+@ The |find_variable| routine is given a pointer~|t| to a nonempty token
+list of suffixes; it returns a pointer to the corresponding two-word
+value. For example, if |t| points to token \.x followed by a numeric
+token containing the value~7, |find_variable| finds where the value of
+\.{x7} is stored in memory. This may seem a simple task, and it
+usually is, except when \.{x7} has never been referenced before.
+Indeed, \.x may never have even been subscripted before; complexities
+arise with respect to updating the collective subscript information.
+
+If a macro type is detected anywhere along path~|t|, or if the first
+item on |t| isn't a |tag_token|, the value |null| is returned.
+Otherwise |p| will be a non-null pointer to a node such that
+|undefined<type(p)<mp_structured|.
+
+@d abort_find { return null; }
+
+@c 
+pointer mp_find_variable (MP mp,pointer t) {
+  pointer p,q,r,s; /* nodes in the ``value'' line */
+  pointer pp,qq,rr,ss; /* nodes in the ``collective'' line */
+  integer n; /* subscript or attribute */
+  memory_word save_word; /* temporary storage for a word of |mem| */
+@^inner loop@>
+  p=info(t); t=link(t);
+  if ( (eq_type(p) % outer_tag) != tag_token ) abort_find;
+  if ( equiv(p)==null ) mp_new_root(mp, p);
+  p=equiv(p); pp=p;
+  while ( t!=null ) { 
+    @<Make sure that both nodes |p| and |pp| are of |mp_structured| type@>;
+    if ( t<mp->hi_mem_min ) {
+      @<Descend one level for the subscript |value(t)|@>
+    } else {
+      @<Descend one level for the attribute |info(t)|@>;
+    }
+    t=link(t);
+  }
+  if ( type(pp)>=mp_structured ) {
+    if ( type(pp)==mp_structured ) pp=attr_head(pp); else abort_find;
+  }
+  if ( type(p)==mp_structured ) p=attr_head(p);
+  if ( type(p)==undefined ) { 
+    if ( type(pp)==undefined ) { type(pp)=mp_numeric_type; value(pp)=null; };
+    type(p)=type(pp); value(p)=null;
+  };
+  return p;
+}
+
+@ Although |pp| and |p| begin together, they diverge when a subscript occurs;
+|pp|~stays in the collective line while |p|~goes through actual subscript
+values.
+
+@<Make sure that both nodes |p| and |pp|...@>=
+if ( type(pp)!=mp_structured ) { 
+  if ( type(pp)>mp_structured ) abort_find;
+  ss=mp_new_structure(mp, pp);
+  if ( p==pp ) p=ss;
+  pp=ss;
+}; /* now |type(pp)=mp_structured| */
+if ( type(p)!=mp_structured ) /* it cannot be |>mp_structured| */
+  p=mp_new_structure(mp, p) /* now |type(p)=mp_structured| */
+
+@ We want this part of the program to be reasonably fast, in case there are
+@^inner loop@>
+lots of subscripts at the same level of the data structure. Therefore
+we store an ``infinite'' value in the word that appears at the end of the
+subscript list, even though that word isn't part of a subscript node.
+
+@<Descend one level for the subscript |value(t)|@>=
+{ 
+  n=value(t);
+  pp=link(attr_head(pp)); /* now |attr_loc(pp)=collective_subscript| */
+  q=link(attr_head(p)); save_word=mp->mem[subscript_loc(q)];
+  subscript(q)=el_gordo; s=subscr_head_loc(p); /* |link(s)=subscr_head(p)| */
+  do {  
+    r=s; s=link(s);
+  } while (n>subscript(s));
+  if ( n==subscript(s) ) {
+    p=s;
+  } else { 
+    p=mp_get_node(mp, subscr_node_size); link(r)=p; link(p)=s;
+    subscript(p)=n; name_type(p)=mp_subscr; type(p)=undefined;
+  }
+  mp->mem[subscript_loc(q)]=save_word;
+}
+
+@ @<Descend one level for the attribute |info(t)|@>=
+{ 
+  n=info(t);
+  ss=attr_head(pp);
+  do {  
+    rr=ss; ss=link(ss);
+  } while (n>attr_loc(ss));
+  if ( n<attr_loc(ss) ) { 
+    qq=mp_get_node(mp, attr_node_size); link(rr)=qq; link(qq)=ss;
+    attr_loc(qq)=n; name_type(qq)=mp_attr; type(qq)=undefined;
+    parent(qq)=pp; ss=qq;
+  }
+  if ( p==pp ) { 
+    p=ss; pp=ss;
+  } else { 
+    pp=ss; s=attr_head(p);
+    do {  
+      r=s; s=link(s);
+    } while (n>attr_loc(s));
+    if ( n==attr_loc(s) ) {
+      p=s;
+    } else { 
+      q=mp_get_node(mp, attr_node_size); link(r)=q; link(q)=s;
+      attr_loc(q)=n; name_type(q)=mp_attr; type(q)=undefined;
+      parent(q)=p; p=q;
+    }
+  }
+}
+
+@ Variables lose their former values when they appear in a type declaration,
+or when they are defined to be macros or \&{let} equal to something else.
+A subroutine will be defined later that recycles the storage associated
+with any particular |type| or |value|; our goal now is to study a higher
+level process called |flush_variable|, which selectively frees parts of a
+variable structure.
+
+This routine has some complexity because of examples such as
+`\hbox{\tt numeric x[]a[]b}'
+which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
+`\hbox{\tt vardef x[]a[]=...}'
+discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
+suffix, except for the collective node \.{x[]a[]} itself. The obvious way
+to handle such examples is to use recursion; so that's what we~do.
+@^recursion@>
+
+Parameter |p| points to the root information of the variable;
+parameter |t| points to a list of one-word nodes that represent
+suffixes, with |info=collective_subscript| for subscripts.
+
+@<Declarations@>=
+@<Declare subroutines for printing expressions@>
+@<Declare basic dependency-list subroutines@>
+@<Declare the recycling subroutines@>
+void mp_flush_cur_exp (MP mp,scaled v) ;
+@<Declare the procedure called |flush_below_variable|@>
+
+@ @c 
+void mp_flush_variable (MP mp,pointer p, pointer t, boolean discard_suffixes) {
+  pointer q,r; /* list manipulation */
+  halfword n; /* attribute to match */
+  while ( t!=null ) { 
+    if ( type(p)!=mp_structured ) return;
+    n=info(t); t=link(t);
+    if ( n==collective_subscript ) { 
+      r=subscr_head_loc(p); q=link(r); /* |q=subscr_head(p)| */
+      while ( name_type(q)==mp_subscr ){ 
+        mp_flush_variable(mp, q,t,discard_suffixes);
+        if ( t==null ) {
+          if ( type(q)==mp_structured ) r=q;
+          else  { link(r)=link(q); mp_free_node(mp, q,subscr_node_size);   }
+        } else {
+          r=q;
+        }
+        q=link(r);
+      }
+    }
+    p=attr_head(p);
+    do {  
+      r=p; p=link(p);
+    } while (attr_loc(p)<n);
+    if ( attr_loc(p)!=n ) return;
+  }
+  if ( discard_suffixes ) {
+    mp_flush_below_variable(mp, p);
+  } else { 
+    if ( type(p)==mp_structured ) p=attr_head(p);
+    mp_recycle_value(mp, p);
+  }
+}
+
+@ The next procedure is simpler; it wipes out everything but |p| itself,
+which becomes undefined.
+
+@<Declare the procedure called |flush_below_variable|@>=
+void mp_flush_below_variable (MP mp, pointer p);
+
+@ @c
+void mp_flush_below_variable (MP mp,pointer p) {
+   pointer q,r; /* list manipulation registers */
+  if ( type(p)!=mp_structured ) {
+    mp_recycle_value(mp, p); /* this sets |type(p)=undefined| */
+  } else { 
+    q=subscr_head(p);
+    while ( name_type(q)==mp_subscr ) { 
+      mp_flush_below_variable(mp, q); r=q; q=link(q);
+      mp_free_node(mp, r,subscr_node_size);
+    }
+    r=attr_head(p); q=link(r); mp_recycle_value(mp, r);
+    if ( name_type(p)<=mp_saved_root ) mp_free_node(mp, r,value_node_size);
+    else mp_free_node(mp, r,subscr_node_size);
+    /* we assume that |subscr_node_size=attr_node_size| */
+    do {  
+      mp_flush_below_variable(mp, q); r=q; q=link(q); mp_free_node(mp, r,attr_node_size);
+    } while (q!=end_attr);
+    type(p)=undefined;
+  }
+}
+
+@ Just before assigning a new value to a variable, we will recycle the
+old value and make the old value undefined. The |und_type| routine
+determines what type of undefined value should be given, based on
+the current type before recycling.
+
+@c 
+small_number mp_und_type (MP mp,pointer p) { 
+  switch (type(p)) {
+  case undefined: case mp_vacuous:
+    return undefined;
+  case mp_boolean_type: case mp_unknown_boolean:
+    return mp_unknown_boolean;
+  case mp_string_type: case mp_unknown_string:
+    return mp_unknown_string;
+  case mp_pen_type: case mp_unknown_pen:
+    return mp_unknown_pen;
+  case mp_path_type: case mp_unknown_path:
+    return mp_unknown_path;
+  case mp_picture_type: case mp_unknown_picture:
+    return mp_unknown_picture;
+  case mp_transform_type: case mp_color_type: case mp_cmykcolor_type:
+  case mp_pair_type: case mp_numeric_type: 
+    return type(p);
+  case mp_known: case mp_dependent: case mp_proto_dependent: case mp_independent:
+    return mp_numeric_type;
+  } /* there are no other cases */
+  return 0;
+}
+
+@ The |clear_symbol| routine is used when we want to redefine the equivalent
+of a symbolic token. It must remove any variable structure or macro
+definition that is currently attached to that symbol. If the |saving|
+parameter is true, a subsidiary structure is saved instead of destroyed.
+
+@c 
+void mp_clear_symbol (MP mp,pointer p, boolean saving) {
+  pointer q; /* |equiv(p)| */
+  q=equiv(p);
+  switch (eq_type(p) % outer_tag)  {
+  case defined_macro:
+  case secondary_primary_macro:
+  case tertiary_secondary_macro:
+  case expression_tertiary_macro: 
+    if ( ! saving ) mp_delete_mac_ref(mp, q);
+    break;
+  case tag_token:
+    if ( q!=null ) {
+      if ( saving ) {
+        name_type(q)=mp_saved_root;
+      } else { 
+        mp_flush_below_variable(mp, q); 
+	    mp_free_node(mp,q,value_node_size); 
+      }
+    }
+    break;
+  default:
+    break;
+  }
+  mp->eqtb[p]=mp->eqtb[frozen_undefined];
+}
+
+@* \[16] Saving and restoring equivalents.
+The nested structure given by \&{begingroup} and \&{endgroup}
+allows |eqtb| entries to be saved and restored, so that temporary changes
+can be made without difficulty.  When the user requests a current value to
+be saved, \MP\ puts that value into its ``save stack.'' An appearance of
+\&{endgroup} ultimately causes the old values to be removed from the save
+stack and put back in their former places.
+
+The save stack is a linked list containing three kinds of entries,
+distinguished by their |info| fields. If |p| points to a saved item,
+then
+
+\smallskip\hang
+|info(p)=0| stands for a group boundary; each \&{begingroup} contributes
+such an item to the save stack and each \&{endgroup} cuts back the stack
+until the most recent such entry has been removed.
+
+\smallskip\hang
+|info(p)=q|, where |1<=q<=hash_end|, means that |mem[p+1]| holds the former
+contents of |eqtb[q]|. Such save stack entries are generated by \&{save}
+commands.
+
+\smallskip\hang
+|info(p)=hash_end+q|, where |q>0|, means that |value(p)| is a |scaled|
+integer to be restored to internal parameter number~|q|. Such entries
+are generated by \&{interim} commands.
+
+\smallskip\noindent
+The global variable |save_ptr| points to the top item on the save stack.
+
+@d save_node_size 2 /* number of words per non-boundary save-stack node */
+@d saved_equiv(A) mp->mem[(A)+1].hh /* where an |eqtb| entry gets saved */
+@d save_boundary_item(A) { (A)=mp_get_avail(mp); info((A))=0;
+  link((A))=mp->save_ptr; mp->save_ptr=(A);
+  }
+
+@<Glob...@>=
+pointer save_ptr; /* the most recently saved item */
+
+@ @<Set init...@>=mp->save_ptr=null;
+
+@ The |save_variable| routine is given a hash address |q|; it salts this
+address in the save stack, together with its current equivalent,
+then makes token~|q| behave as though it were brand new.
+
+Nothing is stacked when |save_ptr=null|, however; there's no way to remove
+things from the stack when the program is not inside a group, so there's
+no point in wasting the space.
+
+@c void mp_save_variable (MP mp,pointer q) {
+  pointer p; /* temporary register */
+  if ( mp->save_ptr!=null ){ 
+    p=mp_get_node(mp, save_node_size); info(p)=q; link(p)=mp->save_ptr;
+    saved_equiv(p)=mp->eqtb[q]; mp->save_ptr=p;
+  }
+  mp_clear_symbol(mp, q,(mp->save_ptr!=null));
+}
+
+@ Similarly, |save_internal| is given the location |q| of an internal
+quantity like |mp_tracing_pens|. It creates a save stack entry of the
+third kind.
+
+@c void mp_save_internal (MP mp,halfword q) {
+  pointer p; /* new item for the save stack */
+  if ( mp->save_ptr!=null ){ 
+     p=mp_get_node(mp, save_node_size); info(p)=hash_end+q;
+    link(p)=mp->save_ptr; value(p)=mp->internal[q]; mp->save_ptr=p;
+  }
+}
+
+@ At the end of a group, the |unsave| routine restores all of the saved
+equivalents in reverse order. This routine will be called only when there
+is at least one boundary item on the save stack.
+
+@c 
+void mp_unsave (MP mp) {
+  pointer q; /* index to saved item */
+  pointer p; /* temporary register */
+  while ( info(mp->save_ptr)!=0 ) {
+    q=info(mp->save_ptr);
+    if ( q>hash_end ) {
+      if ( mp->internal[mp_tracing_restores]>0 ) {
+        mp_begin_diagnostic(mp); mp_print_nl(mp, "{restoring ");
+        mp_print(mp, mp->int_name[q-(hash_end)]); mp_print_char(mp, '=');
+        mp_print_scaled(mp, value(mp->save_ptr)); mp_print_char(mp, '}');
+        mp_end_diagnostic(mp, false);
+      }
+      mp->internal[q-(hash_end)]=value(mp->save_ptr);
+    } else { 
+      if ( mp->internal[mp_tracing_restores]>0 ) {
+        mp_begin_diagnostic(mp); mp_print_nl(mp, "{restoring ");
+        mp_print_text(q); mp_print_char(mp, '}');
+        mp_end_diagnostic(mp, false);
+      }
+      mp_clear_symbol(mp, q,false);
+      mp->eqtb[q]=saved_equiv(mp->save_ptr);
+      if ( eq_type(q) % outer_tag==tag_token ) {
+        p=equiv(q);
+        if ( p!=null ) name_type(p)=mp_root;
+      }
+    }
+    p=link(mp->save_ptr); 
+    mp_free_node(mp, mp->save_ptr,save_node_size); mp->save_ptr=p;
+  }
+  p=link(mp->save_ptr); free_avail(mp->save_ptr); mp->save_ptr=p;
+}
+
+@* \[17] Data structures for paths.
+When a \MP\ user specifies a path, \MP\ will create a list of knots
+and control points for the associated cubic spline curves. If the
+knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
+$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
+$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
+@:Bezier}{B\'ezier, Pierre Etienne@>
+$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
+&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
+for |0<=t<=1|.
+
+There is a 8-word node for each knot $z_k$, containing one word of
+control information and six words for the |x| and |y| coordinates of
+$z_k^-$ and $z_k$ and~$z_k^+$. The control information appears in the
+|left_type| and |right_type| fields, which each occupy a quarter of
+the first word in the node; they specify properties of the curve as it
+enters and leaves the knot. There's also a halfword |link| field,
+which points to the following knot, and a final supplementary word (of
+which only a quarter is used).
+
+If the path is a closed contour, knots 0 and |n| are identical;
+i.e., the |link| in knot |n-1| points to knot~0. But if the path
+is not closed, the |left_type| of knot~0 and the |right_type| of knot~|n|
+are equal to |endpoint|. In the latter case the |link| in knot~|n| points
+to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
+
+@d left_type(A)   mp->mem[(A)].hh.b0 /* characterizes the path entering this knot */
+@d right_type(A)   mp->mem[(A)].hh.b1 /* characterizes the path leaving this knot */
+@d x_coord(A)   mp->mem[(A)+1].sc /* the |x| coordinate of this knot */
+@d y_coord(A)   mp->mem[(A)+2].sc /* the |y| coordinate of this knot */
+@d left_x(A)   mp->mem[(A)+3].sc /* the |x| coordinate of previous control point */
+@d left_y(A)   mp->mem[(A)+4].sc /* the |y| coordinate of previous control point */
+@d right_x(A)   mp->mem[(A)+5].sc /* the |x| coordinate of next control point */
+@d right_y(A)   mp->mem[(A)+6].sc /* the |y| coordinate of next control point */
+@d x_loc(A)   ((A)+1) /* where the |x| coordinate is stored in a knot */
+@d y_loc(A)   ((A)+2) /* where the |y| coordinate is stored in a knot */
+@d knot_coord(A)   mp->mem[(A)].sc /* |x| or |y| coordinate given |x_loc| or |y_loc| */
+@d left_coord(A)   mp->mem[(A)+2].sc
+  /* coordinate of previous control point given |x_loc| or |y_loc| */
+@d right_coord(A)   mp->mem[(A)+4].sc
+  /* coordinate of next control point given |x_loc| or |y_loc| */
+@d knot_node_size 8 /* number of words in a knot node */
+
+@<Types...@>=
+enum mp_knot_type {
+ mp_endpoint=0, /* |left_type| at path beginning and |right_type| at path end */
+ mp_explicit, /* |left_type| or |right_type| when control points are known */
+ mp_given, /* |left_type| or |right_type| when a direction is given */
+ mp_curl, /* |left_type| or |right_type| when a curl is desired */
+ mp_open, /* |left_type| or |right_type| when \MP\ should choose the direction */
+ mp_end_cycle
+};
+
+@ Before the B\'ezier control points have been calculated, the memory
+space they will ultimately occupy is taken up by information that can be
+used to compute them. There are four cases:
+
+\yskip
+\textindent{$\bullet$} If |right_type=mp_open|, the curve should leave
+the knot in the same direction it entered; \MP\ will figure out a
+suitable direction.
+
+\yskip
+\textindent{$\bullet$} If |right_type=mp_curl|, the curve should leave the
+knot in a direction depending on the angle at which it enters the next
+knot and on the curl parameter stored in |right_curl|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=mp_given|, the curve should leave the
+knot in a nonzero direction stored as an |angle| in |right_given|.
+
+\yskip
+\textindent{$\bullet$} If |right_type=mp_explicit|, the B\'ezier control
+point for leaving this knot has already been computed; it is in the
+|right_x| and |right_y| fields.
+
+\yskip\noindent
+The rules for |left_type| are similar, but they refer to the curve entering
+the knot, and to \\{left} fields instead of \\{right} fields.
+
+Non-|explicit| control points will be chosen based on ``tension'' parameters
+in the |left_tension| and |right_tension| fields. The
+`\&{atleast}' option is represented by negative tension values.
+@:at_least_}{\&{atleast} primitive@>
+
+For example, the \MP\ path specification
+$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
+  3 and 4..p},$$
+where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
+by the six knots
+\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
+$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
+|left_type|&\\{left} info&|x_coord,y_coord|&|right_type|&\\{right} info\cr
+\noalign{\yskip}
+|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
+|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
+|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
+|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
+|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
+|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
+Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|.
+Of course, this example is more complicated than anything a normal user
+would ever write.
+
+These types must satisfy certain restrictions because of the form of \MP's
+path syntax:
+(i)~|open| type never appears in the same node together with |endpoint|,
+|given|, or |curl|.
+(ii)~The |right_type| of a node is |explicit| if and only if the
+|left_type| of the following node is |explicit|.
+(iii)~|endpoint| types occur only at the ends, as mentioned above.
+
+@d left_curl left_x /* curl information when entering this knot */
+@d left_given left_x /* given direction when entering this knot */
+@d left_tension left_y /* tension information when entering this knot */
+@d right_curl right_x /* curl information when leaving this knot */
+@d right_given right_x /* given direction when leaving this knot */
+@d right_tension right_y /* tension information when leaving this knot */
+
+@ Knots can be user-supplied, or they can be created by program code,
+like the |split_cubic| function, or |copy_path|. The distinction is
+needed for the cleanup routine that runs after |split_cubic|, because
+it should only delete knots it has previously inserted, and never
+anything that was user-supplied. In order to be able to differentiate
+one knot from another, we will set |originator(p):=mp_metapost_user| when
+it appeared in the actual metapost program, and
+|originator(p):=mp_program_code| in all other cases.
+
+@d originator(A)   mp->mem[(A)+7].hh.b0 /* the creator of this knot */
+
+@<Types...@>=
+enum {
+  mp_program_code=0, /* not created by a user */
+  mp_metapost_user /* created by a user */
+};
+
+@ Here is a routine that prints a given knot list
+in symbolic form. It illustrates the conventions discussed above,
+and checks for anomalies that might arise while \MP\ is being debugged.
+
+@<Declare subroutines for printing expressions@>=
+void mp_pr_path (MP mp,pointer h);
+
+@ @c
+void mp_pr_path (MP mp,pointer h) {
+  pointer p,q; /* for list traversal */
+  p=h;
+  do {  
+    q=link(p);
+    if ( (p==null)||(q==null) ) { 
+      mp_print_nl(mp, "???"); return; /* this won't happen */
+@.???@>
+    }
+    @<Print information for adjacent knots |p| and |q|@>;
+  DONE1:
+    p=q;
+    if ( (p!=h)||(left_type(h)!=mp_endpoint) ) {
+      @<Print two dots, followed by |given| or |curl| if present@>;
+    }
+  } while (p!=h);
+  if ( left_type(h)!=mp_endpoint ) 
+    mp_print(mp, "cycle");
+}
+
+@ @<Print information for adjacent knots...@>=
+mp_print_two(mp, x_coord(p),y_coord(p));
+switch (right_type(p)) {
+case mp_endpoint: 
+  if ( left_type(p)==mp_open ) mp_print(mp, "{open?}"); /* can't happen */
+@.open?@>
+  if ( (left_type(q)!=mp_endpoint)||(q!=h) ) q=null; /* force an error */
+  goto DONE1;
+  break;
+case mp_explicit: 
+  @<Print control points between |p| and |q|, then |goto done1|@>;
+  break;
+case mp_open: 
+  @<Print information for a curve that begins |open|@>;
+  break;
+case mp_curl:
+case mp_given: 
+  @<Print information for a curve that begins |curl| or |given|@>;
+  break;
+default:
+  mp_print(mp, "???"); /* can't happen */
+@.???@>
+  break;
+}
+if ( left_type(q)<=mp_explicit ) {
+  mp_print(mp, "..control?"); /* can't happen */
+@.control?@>
+} else if ( (right_tension(p)!=unity)||(left_tension(q)!=unity) ) {
+  @<Print tension between |p| and |q|@>;
+}
+
+@ Since |n_sin_cos| produces |fraction| results, which we will print as if they
+were |scaled|, the magnitude of a |given| direction vector will be~4096.
+
+@<Print two dots...@>=
+{ 
+  mp_print_nl(mp, " ..");
+  if ( left_type(p)==mp_given ) { 
+    mp_n_sin_cos(mp, left_given(p)); mp_print_char(mp, '{');
+    mp_print_scaled(mp, mp->n_cos); mp_print_char(mp, ',');
+    mp_print_scaled(mp, mp->n_sin); mp_print_char(mp, '}');
+  } else if ( left_type(p)==mp_curl ){ 
+    mp_print(mp, "{curl "); 
+    mp_print_scaled(mp, left_curl(p)); mp_print_char(mp, '}');
+  }
+}
+
+@ @<Print tension between |p| and |q|@>=
+{ 
+  mp_print(mp, "..tension ");
+  if ( right_tension(p)<0 ) mp_print(mp, "atleast");
+  mp_print_scaled(mp, abs(right_tension(p)));
+  if ( right_tension(p)!=left_tension(q) ){ 
+    mp_print(mp, " and ");
+    if ( left_tension(q)<0 ) mp_print(mp, "atleast");
+    mp_print_scaled(mp, abs(left_tension(q)));
+  }
+}
+
+@ @<Print control points between |p| and |q|, then |goto done1|@>=
+{ 
+  mp_print(mp, "..controls "); 
+  mp_print_two(mp, right_x(p),right_y(p)); 
+  mp_print(mp, " and ");
+  if ( left_type(q)!=mp_explicit ) { 
+    mp_print(mp, "??"); /* can't happen */
+@.??@>
+  } else {
+    mp_print_two(mp, left_x(q),left_y(q));
+  }
+  goto DONE1;
+}
+
+@ @<Print information for a curve that begins |open|@>=
+if ( (left_type(p)!=mp_explicit)&&(left_type(p)!=mp_open) ) {
+  mp_print(mp, "{open?}"); /* can't happen */
+@.open?@>
+}
+
+@ A curl of 1 is shown explicitly, so that the user sees clearly that
+\MP's default curl is present.
+
+@<Print information for a curve that begins |curl|...@>=
+{ 
+  if ( left_type(p)==mp_open )  
+    mp_print(mp, "??"); /* can't happen */
+@.??@>
+  if ( right_type(p)==mp_curl ) { 
+    mp_print(mp, "{curl "); mp_print_scaled(mp, right_curl(p));
+  } else { 
+    mp_n_sin_cos(mp, right_given(p)); mp_print_char(mp, '{');
+    mp_print_scaled(mp, mp->n_cos); mp_print_char(mp, ','); 
+    mp_print_scaled(mp, mp->n_sin);
+  }
+  mp_print_char(mp, '}');
+}
+
+@ It is convenient to have another version of |pr_path| that prints the path
+as a diagnostic message.
+
+@<Declare subroutines for printing expressions@>=
+void mp_print_path (MP mp,pointer h, const char *s, boolean nuline) { 
+  mp_print_diagnostic(mp, "Path", s, nuline); mp_print_ln(mp);
+@.Path at line...@>
+  mp_pr_path(mp, h);
+  mp_end_diagnostic(mp, true);
+}
+
+@ If we want to duplicate a knot node, we can say |copy_knot|:
+
+@c 
+pointer mp_copy_knot (MP mp,pointer p) {
+  pointer q; /* the copy */
+  int k; /* runs through the words of a knot node */
+  q=mp_get_node(mp, knot_node_size);
+  for (k=0;k<knot_node_size;k++) {
+    mp->mem[q+k]=mp->mem[p+k];
+  }
+  originator(q)=originator(p);
+  return q;
+}
+
+@ The |copy_path| routine makes a clone of a given path.
+
+@c 
+pointer mp_copy_path (MP mp, pointer p) {
+  pointer q,pp,qq; /* for list manipulation */
+  q=mp_copy_knot(mp, p);
+  qq=q; pp=link(p);
+  while ( pp!=p ) { 
+    link(qq)=mp_copy_knot(mp, pp);
+    qq=link(qq);
+    pp=link(pp);
+  }
+  link(qq)=q;
+  return q;
+}
+
+
+@ Just before |ship_out|, knot lists are exported for printing.
+
+The |gr_XXXX| macros are defined in |mppsout.h|.
+
+@c 
+mp_knot *mp_export_knot (MP mp,pointer p) {
+  mp_knot *q; /* the copy */
+  if (p==null)
+     return NULL;
+  q = mp_xmalloc(mp, 1, sizeof (mp_knot));
+  memset(q,0,sizeof (mp_knot));
+  gr_left_type(q)  = left_type(p);
+  gr_right_type(q) = right_type(p);
+  gr_x_coord(q)    = x_coord(p);
+  gr_y_coord(q)    = y_coord(p);
+  gr_left_x(q)     = left_x(p);
+  gr_left_y(q)     = left_y(p);
+  gr_right_x(q)    = right_x(p);
+  gr_right_y(q)    = right_y(p);
+  gr_originator(q) = originator(p);
+  return q;
+}
+
+@ The |export_knot_list| routine therefore also makes a clone 
+of a given path.
+
+@c 
+mp_knot *mp_export_knot_list (MP mp, pointer p) {
+  mp_knot *q, *qq; /* for list manipulation */
+  pointer pp; /* for list manipulation */
+  if (p==null)
+     return NULL;
+  q=mp_export_knot(mp, p);
+  qq=q; pp=link(p);
+  while ( pp!=p ) { 
+    gr_next_knot(qq)=mp_export_knot(mp, pp);
+    qq=gr_next_knot(qq);
+    pp=link(pp);
+  }
+  gr_next_knot(qq)=q;
+  return q;
+}
+
+
+@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
+returns a pointer to the first node of the copy, if the path is a cycle,
+but to the final node of a non-cyclic copy. The global
+variable |path_tail| will point to the final node of the original path;
+this trick makes it easier to implement `\&{doublepath}'.
+
+All node types are assumed to be |endpoint| or |explicit| only.
+
+@c 
+pointer mp_htap_ypoc (MP mp,pointer p) {
+  pointer q,pp,qq,rr; /* for list manipulation */
+  q=mp_get_node(mp, knot_node_size); /* this will correspond to |p| */
+  qq=q; pp=p;
+  while (1) { 
+    right_type(qq)=left_type(pp); left_type(qq)=right_type(pp);
+    x_coord(qq)=x_coord(pp); y_coord(qq)=y_coord(pp);
+    right_x(qq)=left_x(pp); right_y(qq)=left_y(pp);
+    left_x(qq)=right_x(pp); left_y(qq)=right_y(pp);
+    originator(qq)=originator(pp);
+    if ( link(pp)==p ) { 
+      link(q)=qq; mp->path_tail=pp; return q;
+    }
+    rr=mp_get_node(mp, knot_node_size); link(rr)=qq; qq=rr; pp=link(pp);
+  }
+}
+
+@ @<Glob...@>=
+pointer path_tail; /* the node that links to the beginning of a path */
+
+@ When a cyclic list of knot nodes is no longer needed, it can be recycled by
+calling the following subroutine.
+
+@<Declare the recycling subroutines@>=
+void mp_toss_knot_list (MP mp,pointer p) ;
+
+@ @c
+void mp_toss_knot_list (MP mp,pointer p) {
+  pointer q; /* the node being freed */
+  pointer r; /* the next node */
+  q=p;
+  do {  
+    r=link(q); 
+    mp_free_node(mp, q,knot_node_size); q=r;
+  } while (q!=p);
+}
+
+@* \[18] Choosing control points.
+Now we must actually delve into one of \MP's more difficult routines,
+the |make_choices| procedure that chooses angles and control points for
+the splines of a curve when the user has not specified them explicitly.
+The parameter to |make_choices| points to a list of knots and
+path information, as described above.
+
+A path decomposes into independent segments at ``breakpoint'' knots,
+which are knots whose left and right angles are both prespecified in
+some way (i.e., their |left_type| and |right_type| aren't both open).
+
+@c 
+@<Declare the procedure called |solve_choices|@>
+void mp_make_choices (MP mp,pointer knots) {
+  pointer h; /* the first breakpoint */
+  pointer p,q; /* consecutive breakpoints being processed */
+  @<Other local variables for |make_choices|@>;
+  check_arith; /* make sure that |arith_error=false| */
+  if ( mp->internal[mp_tracing_choices]>0 )
+    mp_print_path(mp, knots,", before choices",true);
+  @<If consecutive knots are equal, join them explicitly@>;
+  @<Find the first breakpoint, |h|, on the path;
+    insert an artificial breakpoint if the path is an unbroken cycle@>;
+  p=h;
+  do {  
+    @<Fill in the control points between |p| and the next breakpoint,
+      then advance |p| to that breakpoint@>;
+  } while (p!=h);
+  if ( mp->internal[mp_tracing_choices]>0 )
+    mp_print_path(mp, knots,", after choices",true);
+  if ( mp->arith_error ) {
+    @<Report an unexpected problem during the choice-making@>;
+  }
+}
+
+@ @<Report an unexpected problem during the choice...@>=
+{ 
+  print_err("Some number got too big");
+@.Some number got too big@>
+  help2("The path that I just computed is out of range.")
+       ("So it will probably look funny. Proceed, for a laugh.");
+  mp_put_get_error(mp); mp->arith_error=false;
+}
+
+@ Two knots in a row with the same coordinates will always be joined
+by an explicit ``curve'' whose control points are identical with the
+knots.
+
+@<If consecutive knots are equal, join them explicitly@>=
+p=knots;
+do {  
+  q=link(p);
+  if ( x_coord(p)==x_coord(q) && y_coord(p)==y_coord(q) && right_type(p)>mp_explicit ) { 
+    right_type(p)=mp_explicit;
+    if ( left_type(p)==mp_open ) { 
+      left_type(p)=mp_curl; left_curl(p)=unity;
+    }
+    left_type(q)=mp_explicit;
+    if ( right_type(q)==mp_open ) { 
+      right_type(q)=mp_curl; right_curl(q)=unity;
+    }
+    right_x(p)=x_coord(p); left_x(q)=x_coord(p);
+    right_y(p)=y_coord(p); left_y(q)=y_coord(p);
+  }
+  p=q;
+} while (p!=knots)
+
+@ If there are no breakpoints, it is necessary to compute the direction
+angles around an entire cycle. In this case the |left_type| of the first
+node is temporarily changed to |end_cycle|.
+
+@<Find the first breakpoint, |h|, on the path...@>=
+h=knots;
+while (1) { 
+  if ( left_type(h)!=mp_open ) break;
+  if ( right_type(h)!=mp_open ) break;
+  h=link(h);
+  if ( h==knots ) { 
+    left_type(h)=mp_end_cycle; break;
+  }
+}
+
+@ If |right_type(p)<given| and |q=link(p)|, we must have
+|right_type(p)=left_type(q)=mp_explicit| or |endpoint|.
+
+@<Fill in the control points between |p| and the next breakpoint...@>=
+q=link(p);
+if ( right_type(p)>=mp_given ) { 
+  while ( (left_type(q)==mp_open)&&(right_type(q)==mp_open) ) q=link(q);
+  @<Fill in the control information between
+    consecutive breakpoints |p| and |q|@>;
+} else if ( right_type(p)==mp_endpoint ) {
+  @<Give reasonable values for the unused control points between |p| and~|q|@>;
+}
+p=q
+
+@ This step makes it possible to transform an explicitly computed path without
+checking the |left_type| and |right_type| fields.
+
+@<Give reasonable values for the unused control points between |p| and~|q|@>=
+{ 
+  right_x(p)=x_coord(p); right_y(p)=y_coord(p);
+  left_x(q)=x_coord(q); left_y(q)=y_coord(q);
+}
+
+@ Before we can go further into the way choices are made, we need to
+consider the underlying theory. The basic ideas implemented in |make_choices|
+are due to John Hobby, who introduced the notion of ``mock curvature''
+@^Hobby, John Douglas@>
+at a knot. Angles are chosen so that they preserve mock curvature when
+a knot is passed, and this has been found to produce excellent results.
+
+It is convenient to introduce some notations that simplify the necessary
+formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance
+between knots |k| and |k+1|; and let
+$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
+so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left
+through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$.
+The control points for the spline from $z_k$ to $z\k$ will be denoted by
+$$\eqalign{z_k^+&=z_k+
+  \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
+ z\k^-&=z\k-
+  \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
+where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the
+beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
+corresponding ``offset angles.'' These angles satisfy the condition
+$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
+whenever the curve leaves an intermediate knot~|k| in the direction that
+it enters.
+
+@ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of
+the curve at its beginning and ending points. This means that
+$\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$,
+where $f(\theta,\phi)$ is \MP's standard velocity function defined in
+the |velocity| subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+,
+z\k^-,z\k^{\phantom+};t)$
+has curvature
+@^curvature@>
+$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
+at |t=0| and |t=1|, respectively. The mock curvature is the linear
+@^mock curvature@>
+approximation to this true curvature that arises in the limit for
+small $\theta_k$ and~$\phi\k$, if second-order terms are discarded.
+The standard velocity function satisfies
+$$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
+hence the mock curvatures are respectively
+$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}}
+\qquad{\rm and}\qquad
+{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
+
+@ The turning angles $\psi_k$ are given, and equation $(*)$ above
+determines $\phi_k$ when $\theta_k$ is known, so the task of
+angle selection is essentially to choose appropriate values for each
+$\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables
+from $(**)$, we obtain a system of linear equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+where
+$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
+\qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}},
+\qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
+The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$
+will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and
+$C_k\G{5\over4}D_k$; hence the equations are diagonally dominant;
+hence they have a unique solution. Moreover, in most cases the tensions
+are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the
+solution numerically stable, and there is an exponential damping
+effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by
+a factor of~$O(2^{-j})$.
+
+@ However, we still must consider the angles at the starting and ending
+knots of a non-cyclic path. These angles might be given explicitly, or
+they might be specified implicitly in terms of an amount of ``curl.''
+
+Let's assume that angles need to be determined for a non-cyclic path
+starting at $z_0$ and ending at~$z_n$. Then equations of the form
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
+have been given for $0<k<n$, and it will be convenient to introduce
+equations of the same form for $k=0$ and $k=n$, where
+$$A_0=B_0=C_n=D_n=0.$$
+If $\theta_0$ is supposed to have a given value $E_0$, we simply
+define $C_0=1$, $D_0=0$, and $R_0=E_0$. Otherwise a curl
+parameter, $\gamma_0$, has been specified at~$z_0$; this means
+that the mock curvature at $z_0$ should be $\gamma_0$ times the
+mock curvature at $z_1$; i.e.,
+$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
+=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
+This equation simplifies to
+$$(\alpha_0\chi_0+3-\beta_1)\theta_0+
+ \bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
+ -\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
+where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
+\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$.
+It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$,
+hence the linear equations remain nonsingular.
+
+Similar considerations apply at the right end, when the final angle $\phi_n$
+may or may not need to be determined. It is convenient to let $\psi_n=0$,
+hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$,
+or we have
+$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
+(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
+  \chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
+
+When |make_choices| chooses angles, it must compute the coefficients of
+these linear equations, then solve the equations. To compute the coefficients,
+it is necessary to compute arctangents of the given turning angles~$\psi_k$.
+When the equations are solved, the chosen directions $\theta_k$ are put
+back into the form of control points by essentially computing sines and
+cosines.
+
+@ OK, we are ready to make the hard choices of |make_choices|.
+Most of the work is relegated to an auxiliary procedure
+called |solve_choices|, which has been introduced to keep
+|make_choices| from being extremely long.
+
+@<Fill in the control information between...@>=
+@<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$;
+  set $n$ to the length of the path@>;
+@<Remove |open| types at the breakpoints@>;
+mp_solve_choices(mp, p,q,n)
+
+@ It's convenient to precompute quantities that will be needed several
+times later. The values of |delta_x[k]| and |delta_y[k]| will be the
+coordinates of $z\k-z_k$, and the magnitude of this vector will be
+|delta[k]=@t$d_{k,k+1}$@>|. The path angle $\psi_k$ between $z_k-z_{k-1}$
+and $z\k-z_k$ will be stored in |psi[k]|.
+
+@<Glob...@>=
+int path_size; /* maximum number of knots between breakpoints of a path */
+scaled *delta_x;
+scaled *delta_y;
+scaled *delta; /* knot differences */
+angle  *psi; /* turning angles */
+
+@ @<Allocate or initialize ...@>=
+mp->delta_x = NULL;
+mp->delta_y = NULL;
+mp->delta = NULL;
+mp->psi = NULL;
+
+@ @<Dealloc variables@>=
+xfree(mp->delta_x);
+xfree(mp->delta_y);
+xfree(mp->delta);
+xfree(mp->psi);
+
+@ @<Other local variables for |make_choices|@>=
+  int k,n; /* current and final knot numbers */
+  pointer s,t; /* registers for list traversal */
+  scaled delx,dely; /* directions where |open| meets |explicit| */
+  fraction sine,cosine; /* trig functions of various angles */
+
+@ @<Calculate the turning angles...@>=
+{
+RESTART:
+  k=0; s=p; n=mp->path_size;
+  do {  
+    t=link(s);
+    mp->delta_x[k]=x_coord(t)-x_coord(s);
+    mp->delta_y[k]=y_coord(t)-y_coord(s);
+    mp->delta[k]=mp_pyth_add(mp, mp->delta_x[k],mp->delta_y[k]);
+    if ( k>0 ) { 
+      sine=mp_make_fraction(mp, mp->delta_y[k-1],mp->delta[k-1]);
+      cosine=mp_make_fraction(mp, mp->delta_x[k-1],mp->delta[k-1]);
+      mp->psi[k]=mp_n_arg(mp, mp_take_fraction(mp, mp->delta_x[k],cosine)+
+        mp_take_fraction(mp, mp->delta_y[k],sine),
+        mp_take_fraction(mp, mp->delta_y[k],cosine)-
+          mp_take_fraction(mp, mp->delta_x[k],sine));
+    }
+    incr(k); s=t;
+    if ( k==mp->path_size ) {
+      mp_reallocate_paths(mp, mp->path_size+(mp->path_size>>2));
+      goto RESTART; /* retry, loop size has changed */
+    }
+    if ( s==q ) n=k;
+  } while (!((k>=n)&&(left_type(s)!=mp_end_cycle)));
+  if ( k==n ) mp->psi[n]=0; else mp->psi[k]=mp->psi[1];
+}
+
+@ When we get to this point of the code, |right_type(p)| is either
+|given| or |curl| or |open|. If it is |open|, we must have
+|left_type(p)=mp_end_cycle| or |left_type(p)=mp_explicit|. In the latter
+case, the |open| type is converted to |given|; however, if the
+velocity coming into this knot is zero, the |open| type is
+converted to a |curl|, since we don't know the incoming direction.
+
+Similarly, |left_type(q)| is either |given| or |curl| or |open| or
+|mp_end_cycle|. The |open| possibility is reduced either to |given| or to |curl|.
+
+@<Remove |open| types at the breakpoints@>=
+if ( left_type(q)==mp_open ) { 
+  delx=right_x(q)-x_coord(q); dely=right_y(q)-y_coord(q);
+  if ( (delx==0)&&(dely==0) ) { 
+    left_type(q)=mp_curl; left_curl(q)=unity;
+  } else { 
+    left_type(q)=mp_given; left_given(q)=mp_n_arg(mp, delx,dely);
+  }
+}
+if ( (right_type(p)==mp_open)&&(left_type(p)==mp_explicit) ) { 
+  delx=x_coord(p)-left_x(p); dely=y_coord(p)-left_y(p);
+  if ( (delx==0)&&(dely==0) ) { 
+    right_type(p)=mp_curl; right_curl(p)=unity;
+  } else { 
+    right_type(p)=mp_given; right_given(p)=mp_n_arg(mp, delx,dely);
+  }
+}
+
+@ Linear equations need to be solved whenever |n>1|; and also when |n=1|
+and exactly one of the breakpoints involves a curl. The simplest case occurs
+when |n=1| and there is a curl at both breakpoints; then we simply draw
+a straight line.
+
+But before coding up the simple cases, we might as well face the general case,
+since we must deal with it sooner or later, and since the general case
+is likely to give some insight into the way simple cases can be handled best.
+
+When there is no cycle, the linear equations to be solved form a tridiagonal
+system, and we can apply the standard technique of Gaussian elimination
+to convert that system to a sequence of equations of the form
+$$\theta_0+u_0\theta_1=v_0,\quad
+\theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
+\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad
+\theta_n=v_n.$$
+It is possible to do this diagonalization while generating the equations.
+Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots,
+$\theta_1$, $\theta_0$; thus, the equations will be solved.
+
+The procedure is slightly more complex when there is a cycle, but the
+basic idea will be nearly the same. In the cyclic case the right-hand
+sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start
+the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not
+$\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate
+ending routine will take account of the fact that $\theta_n=\theta_0$ and
+eliminate the $w$'s from the system, after which the solution can be
+obtained as before.
+
+When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer
+variables |r|, |s|,~|t| will point respectively to knots |k-1|, |k|,
+and~|k+1|. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are
+of type |fraction|; the $\theta$'s and $v$'s are of type |angle|.
+
+@<Glob...@>=
+angle *theta; /* values of $\theta_k$ */
+fraction *uu; /* values of $u_k$ */
+angle *vv; /* values of $v_k$ */
+fraction *ww; /* values of $w_k$ */
+
+@ @<Allocate or initialize ...@>=
+mp->theta = NULL;
+mp->uu = NULL;
+mp->vv = NULL;
+mp->ww = NULL;
+
+@ @<Dealloc variables@>=
+xfree(mp->theta);
+xfree(mp->uu);
+xfree(mp->vv);
+xfree(mp->ww);
+
+@ @<Declare |mp_reallocate| functions@>=
+void mp_reallocate_paths (MP mp, int l);
+
+@ @c
+void mp_reallocate_paths (MP mp, int l) {
+  XREALLOC (mp->delta_x, l, scaled);
+  XREALLOC (mp->delta_y, l, scaled);
+  XREALLOC (mp->delta,   l, scaled);
+  XREALLOC (mp->psi,     l, angle);
+  XREALLOC (mp->theta,   l, angle);
+  XREALLOC (mp->uu,      l, fraction);
+  XREALLOC (mp->vv,      l, angle);
+  XREALLOC (mp->ww,      l, fraction);
+  mp->path_size = l;
+}
+
+@ Our immediate problem is to get the ball rolling by setting up the
+first equation or by realizing that no equations are needed, and to fit
+this initialization into a framework suitable for the overall computation.
+
+@<Declare the procedure called |solve_choices|@>=
+@<Declare subroutines needed by |solve_choices|@>
+void mp_solve_choices (MP mp,pointer p, pointer q, halfword n) {
+  int k; /* current knot number */
+  pointer r,s,t; /* registers for list traversal */
+  @<Other local variables for |solve_choices|@>;
+  k=0; s=p; r=0;
+  while (1) { 
+    t=link(s);
+    if ( k==0 ) {
+      @<Get the linear equations started; or |return|
+        with the control points in place, if linear equations
+        needn't be solved@>
+    } else  { 
+      switch (left_type(s)) {
+      case mp_end_cycle: case mp_open:
+        @<Set up equation to match mock curvatures
+          at $z_k$; then |goto found| with $\theta_n$
+          adjusted to equal $\theta_0$, if a cycle has ended@>;
+        break;
+      case mp_curl:
+        @<Set up equation for a curl at $\theta_n$
+          and |goto found|@>;
+        break;
+      case mp_given:
+        @<Calculate the given value of $\theta_n$
+          and |goto found|@>;
+        break;
+      } /* there are no other cases */
+    }
+    r=s; s=t; incr(k);
+  }
+FOUND:
+  @<Finish choosing angles and assigning control points@>;
+}
+
+@ On the first time through the loop, we have |k=0| and |r| is not yet
+defined. The first linear equation, if any, will have $A_0=B_0=0$.
+
+@<Get the linear equations started...@>=
+switch (right_type(s)) {
+case mp_given: 
+  if ( left_type(t)==mp_given ) {
+    @<Reduce to simple case of two givens  and |return|@>
+  } else {
+    @<Set up the equation for a given value of $\theta_0$@>;
+  }
+  break;
+case mp_curl: 
+  if ( left_type(t)==mp_curl ) {
+    @<Reduce to simple case of straight line and |return|@>
+  } else {
+    @<Set up the equation for a curl at $\theta_0$@>;
+  }
+  break;
+case mp_open: 
+  mp->uu[0]=0; mp->vv[0]=0; mp->ww[0]=fraction_one;
+  /* this begins a cycle */
+  break;
+} /* there are no other cases */
+
+@ The general equation that specifies equality of mock curvature at $z_k$ is
+$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
+as derived above. We want to combine this with the already-derived equation
+$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain
+a new equation
+$\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
+equation
+$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
+    -A_kw_{k-1}\theta_0$$
+by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with
+fixed-point arithmetic, avoiding the chance of overflow while retaining
+suitable precision.
+
+The calculations will be performed in several registers that
+provide temporary storage for intermediate quantities.
+
+@<Other local variables for |solve_choices|@>=
+fraction aa,bb,cc,ff,acc; /* temporary registers */
+scaled dd,ee; /* likewise, but |scaled| */
+scaled lt,rt; /* tension values */
+
+@ @<Set up equation to match mock curvatures...@>=
+{ @<Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$,
+    $\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$,
+    and $\\{cc}=(B_k-u_{k-1}A_k)/B_k$@>;
+  @<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>;
+  mp->uu[k]=mp_take_fraction(mp, ff,bb);
+  @<Calculate the values of $v_k$ and $w_k$@>;
+  if ( left_type(s)==mp_end_cycle ) {
+    @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>;
+  }
+}
+
+@ Since tension values are never less than 3/4, the values |aa| and
+|bb| computed here are never more than 4/5.
+
+@<Calculate the values $\\{aa}=...@>=
+if ( abs(right_tension(r))==unity) { 
+  aa=fraction_half; dd=2*mp->delta[k];
+} else { 
+  aa=mp_make_fraction(mp, unity,3*abs(right_tension(r))-unity);
+  dd=mp_take_fraction(mp, mp->delta[k],
+    fraction_three-mp_make_fraction(mp, unity,abs(right_tension(r))));
+}
+if ( abs(left_tension(t))==unity ){ 
+  bb=fraction_half; ee=2*mp->delta[k-1];
+} else { 
+  bb=mp_make_fraction(mp, unity,3*abs(left_tension(t))-unity);
+  ee=mp_take_fraction(mp, mp->delta[k-1],
+    fraction_three-mp_make_fraction(mp, unity,abs(left_tension(t))));
+}
+cc=fraction_one-mp_take_fraction(mp, mp->uu[k-1],aa)
+
+@ The ratio to be calculated in this step can be written in the form
+$$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot
+  \\{cc}\cdot\\{dd},$$
+because of the quantities just calculated. The values of |dd| and |ee|
+will not be needed after this step has been performed.
+
+@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>=
+dd=mp_take_fraction(mp, dd,cc); lt=abs(left_tension(s)); rt=abs(right_tension(s));
+if ( lt!=rt ) { /* $\beta_k^{-1}\ne\alpha_k^{-1}$ */
+  if ( lt<rt ) { 
+    ff=mp_make_fraction(mp, lt,rt);
+    ff=mp_take_fraction(mp, ff,ff); /* $\alpha_k^2/\beta_k^2$ */
+    dd=mp_take_fraction(mp, dd,ff);
+  } else { 
+    ff=mp_make_fraction(mp, rt,lt);
+    ff=mp_take_fraction(mp, ff,ff); /* $\beta_k^2/\alpha_k^2$ */
+    ee=mp_take_fraction(mp, ee,ff);
+  }
+}
+ff=mp_make_fraction(mp, ee,ee+dd)
+
+@ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous
+equation was specified by a curl. In that case we must use a special
+method of computation to prevent overflow.
+
+Fortunately, the calculations turn out to be even simpler in this ``hard''
+case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
+$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$.
+
+@<Calculate the values of $v_k$ and $w_k$@>=
+acc=-mp_take_fraction(mp, mp->psi[k+1],mp->uu[k]);
+if ( right_type(r)==mp_curl ) { 
+  mp->ww[k]=0;
+  mp->vv[k]=acc-mp_take_fraction(mp, mp->psi[1],fraction_one-ff);
+} else { 
+  ff=mp_make_fraction(mp, fraction_one-ff,cc); /* this is
+    $B_k/(C_k+B_k-u_{k-1}A_k)<5$ */
+  acc=acc-mp_take_fraction(mp, mp->psi[k],ff);
+  ff=mp_take_fraction(mp, ff,aa); /* this is $A_k/(C_k+B_k-u_{k-1}A_k)$ */
+  mp->vv[k]=acc-mp_take_fraction(mp, mp->vv[k-1],ff);
+  if ( mp->ww[k-1]==0 ) mp->ww[k]=0;
+  else mp->ww[k]=-mp_take_fraction(mp, mp->ww[k-1],ff);
+}
+
+@ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
+v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of
+$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$
+for |0<=k<n|, so that the cyclic case can be finished up just as if there
+were no cycle.
+
+The idea in the following code is to observe that
+$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
+&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
+  -u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0))\bigr),\cr}$$
+so we can solve for $\theta_n=\theta_0$.
+
+@<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>=
+{ 
+aa=0; bb=fraction_one; /* we have |k=n| */
+do {  decr(k);
+if ( k==0 ) k=n;
+  aa=mp->vv[k]-mp_take_fraction(mp, aa,mp->uu[k]);
+  bb=mp->ww[k]-mp_take_fraction(mp, bb,mp->uu[k]);
+} while (k!=n); /* now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$ */
+aa=mp_make_fraction(mp, aa,fraction_one-bb);
+mp->theta[n]=aa; mp->vv[0]=aa;
+for (k=1;k<=n-1;k++) {
+  mp->vv[k]=mp->vv[k]+mp_take_fraction(mp, aa,mp->ww[k]);
+}
+goto FOUND;
+}
+
+@ @d reduce_angle(A) if ( abs((A))>one_eighty_deg ) {
+  if ( (A)>0 ) (A)=(A)-three_sixty_deg; else (A)=(A)+three_sixty_deg; }
+
+@<Calculate the given value of $\theta_n$...@>=
+{ 
+  mp->theta[n]=left_given(s)-mp_n_arg(mp, mp->delta_x[n-1],mp->delta_y[n-1]);
+  reduce_angle(mp->theta[n]);
+  goto FOUND;
+}
+
+@ @<Set up the equation for a given value of $\theta_0$@>=
+{ 
+  mp->vv[0]=right_given(s)-mp_n_arg(mp, mp->delta_x[0],mp->delta_y[0]);
+  reduce_angle(mp->vv[0]);
+  mp->uu[0]=0; mp->ww[0]=0;
+}
+
+@ @<Set up the equation for a curl at $\theta_0$@>=
+{ cc=right_curl(s); lt=abs(left_tension(t)); rt=abs(right_tension(s));
+  if ( (rt==unity)&&(lt==unity) )
+    mp->uu[0]=mp_make_fraction(mp, cc+cc+unity,cc+two);
+  else 
+    mp->uu[0]=mp_curl_ratio(mp, cc,rt,lt);
+  mp->vv[0]=-mp_take_fraction(mp, mp->psi[1],mp->uu[0]); mp->ww[0]=0;
+}
+
+@ @<Set up equation for a curl at $\theta_n$...@>=
+{ cc=left_curl(s); lt=abs(left_tension(s)); rt=abs(right_tension(r));
+  if ( (rt==unity)&&(lt==unity) )
+    ff=mp_make_fraction(mp, cc+cc+unity,cc+two);
+  else 
+    ff=mp_curl_ratio(mp, cc,lt,rt);
+  mp->theta[n]=-mp_make_fraction(mp, mp_take_fraction(mp, mp->vv[n-1],ff),
+    fraction_one-mp_take_fraction(mp, ff,mp->uu[n-1]));
+  goto FOUND;
+}
+
+@ The |curl_ratio| subroutine has three arguments, which our previous notation
+encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is
+a somewhat tedious program to calculate
+$${(3-\alpha)\alpha^2\gamma+\beta^3\over
+  \alpha^3\gamma+(3-\beta)\beta^2},$$
+with the result reduced to 4 if it exceeds 4. (This reduction of curl
+is necessary only if the curl and tension are both large.)
+The values of $\alpha$ and $\beta$ will be at most~4/3.
+
+@<Declare subroutines needed by |solve_choices|@>=
+fraction mp_curl_ratio (MP mp,scaled gamma, scaled a_tension, 
+                        scaled b_tension) {
+  fraction alpha,beta,num,denom,ff; /* registers */
+  alpha=mp_make_fraction(mp, unity,a_tension);
+  beta=mp_make_fraction(mp, unity,b_tension);
+  if ( alpha<=beta ) {
+    ff=mp_make_fraction(mp, alpha,beta); ff=mp_take_fraction(mp, ff,ff);
+    gamma=mp_take_fraction(mp, gamma,ff);
+    beta=beta / 010000; /* convert |fraction| to |scaled| */
+    denom=mp_take_fraction(mp, gamma,alpha)+three-beta;
+    num=mp_take_fraction(mp, gamma,fraction_three-alpha)+beta;
+  } else { 
+    ff=mp_make_fraction(mp, beta,alpha); ff=mp_take_fraction(mp, ff,ff);
+    beta=mp_take_fraction(mp, beta,ff) / 010000; /* convert |fraction| to |scaled| */
+    denom=mp_take_fraction(mp, gamma,alpha)+(ff / 1365)-beta;
+      /* $1365\approx 2^{12}/3$ */
+    num=mp_take_fraction(mp, gamma,fraction_three-alpha)+beta;
+  }
+  if ( num>=denom+denom+denom+denom ) return fraction_four;
+  else return mp_make_fraction(mp, num,denom);
+}
+
+@ We're in the home stretch now.
+
+@<Finish choosing angles and assigning control points@>=
+for (k=n-1;k>=0;k--) {
+  mp->theta[k]=mp->vv[k]-mp_take_fraction(mp,mp->theta[k+1],mp->uu[k]);
+}
+s=p; k=0;
+do {  
+  t=link(s);
+  mp_n_sin_cos(mp, mp->theta[k]); mp->st=mp->n_sin; mp->ct=mp->n_cos;
+  mp_n_sin_cos(mp, -mp->psi[k+1]-mp->theta[k+1]); mp->sf=mp->n_sin; mp->cf=mp->n_cos;
+  mp_set_controls(mp, s,t,k);
+  incr(k); s=t;
+} while (k!=n)
+
+@ The |set_controls| routine actually puts the control points into
+a pair of consecutive nodes |p| and~|q|. Global variables are used to
+record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and
+$\cos\phi$ needed in this calculation.
+
+@<Glob...@>=
+fraction st;
+fraction ct;
+fraction sf;
+fraction cf; /* sines and cosines */
+
+@ @<Declare subroutines needed by |solve_choices|@>=
+void mp_set_controls (MP mp,pointer p, pointer q, integer k) {
+  fraction rr,ss; /* velocities, divided by thrice the tension */
+  scaled lt,rt; /* tensions */
+  fraction sine; /* $\sin(\theta+\phi)$ */
+  lt=abs(left_tension(q)); rt=abs(right_tension(p));
+  rr=mp_velocity(mp, mp->st,mp->ct,mp->sf,mp->cf,rt);
+  ss=mp_velocity(mp, mp->sf,mp->cf,mp->st,mp->ct,lt);
+  if ( (right_tension(p)<0)||(left_tension(q)<0) ) {
+    @<Decrease the velocities,
+      if necessary, to stay inside the bounding triangle@>;
+  }
+  right_x(p)=x_coord(p)+mp_take_fraction(mp, 
+                          mp_take_fraction(mp, mp->delta_x[k],mp->ct)-
+                          mp_take_fraction(mp, mp->delta_y[k],mp->st),rr);
+  right_y(p)=y_coord(p)+mp_take_fraction(mp, 
+                          mp_take_fraction(mp, mp->delta_y[k],mp->ct)+
+                          mp_take_fraction(mp, mp->delta_x[k],mp->st),rr);
+  left_x(q)=x_coord(q)-mp_take_fraction(mp, 
+                         mp_take_fraction(mp, mp->delta_x[k],mp->cf)+
+                         mp_take_fraction(mp, mp->delta_y[k],mp->sf),ss);
+  left_y(q)=y_coord(q)-mp_take_fraction(mp, 
+                         mp_take_fraction(mp, mp->delta_y[k],mp->cf)-
+                         mp_take_fraction(mp, mp->delta_x[k],mp->sf),ss);
+  right_type(p)=mp_explicit; left_type(q)=mp_explicit;
+}
+
+@ The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and
+$\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
+$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise
+there is no ``bounding triangle.''
+
+@<Decrease the velocities, if necessary...@>=
+if (((mp->st>=0)&&(mp->sf>=0))||((mp->st<=0)&&(mp->sf<=0)) ) {
+  sine=mp_take_fraction(mp, abs(mp->st),mp->cf)+
+                            mp_take_fraction(mp, abs(mp->sf),mp->ct);
+  if ( sine>0 ) {
+    sine=mp_take_fraction(mp, sine,fraction_one+unity); /* safety factor */
+    if ( right_tension(p)<0 )
+     if ( mp_ab_vs_cd(mp, abs(mp->sf),fraction_one,rr,sine)<0 )
+      rr=mp_make_fraction(mp, abs(mp->sf),sine);
+    if ( left_tension(q)<0 )
+     if ( mp_ab_vs_cd(mp, abs(mp->st),fraction_one,ss,sine)<0 )
+      ss=mp_make_fraction(mp, abs(mp->st),sine);
+  }
+}
+
+@ Only the simple cases remain to be handled.
+
+@<Reduce to simple case of two givens and |return|@>=
+{ 
+  aa=mp_n_arg(mp, mp->delta_x[0],mp->delta_y[0]);
+  mp_n_sin_cos(mp, right_given(p)-aa); mp->ct=mp->n_cos; mp->st=mp->n_sin;
+  mp_n_sin_cos(mp, left_given(q)-aa); mp->cf=mp->n_cos; mp->sf=-mp->n_sin;
+  mp_set_controls(mp, p,q,0); return;
+}
+
+@ @<Reduce to simple case of straight line and |return|@>=
+{ 
+  right_type(p)=mp_explicit; left_type(q)=mp_explicit;
+  lt=abs(left_tension(q)); rt=abs(right_tension(p));
+  if ( rt==unity ) {
+    if ( mp->delta_x[0]>=0 ) right_x(p)=x_coord(p)+((mp->delta_x[0]+1) / 3);
+    else right_x(p)=x_coord(p)+((mp->delta_x[0]-1) / 3);
+    if ( mp->delta_y[0]>=0 ) right_y(p)=y_coord(p)+((mp->delta_y[0]+1) / 3);
+    else right_y(p)=y_coord(p)+((mp->delta_y[0]-1) / 3);
+  } else { 
+    ff=mp_make_fraction(mp, unity,3*rt); /* $\alpha/3$ */
+    right_x(p)=x_coord(p)+mp_take_fraction(mp, mp->delta_x[0],ff);
+    right_y(p)=y_coord(p)+mp_take_fraction(mp, mp->delta_y[0],ff);
+  }
+  if ( lt==unity ) {
+    if ( mp->delta_x[0]>=0 ) left_x(q)=x_coord(q)-((mp->delta_x[0]+1) / 3);
+    else left_x(q)=x_coord(q)-((mp->delta_x[0]-1) / 3);
+    if ( mp->delta_y[0]>=0 ) left_y(q)=y_coord(q)-((mp->delta_y[0]+1) / 3);
+    else left_y(q)=y_coord(q)-((mp->delta_y[0]-1) / 3);
+  } else  { 
+    ff=mp_make_fraction(mp, unity,3*lt); /* $\beta/3$ */
+    left_x(q)=x_coord(q)-mp_take_fraction(mp, mp->delta_x[0],ff);
+    left_y(q)=y_coord(q)-mp_take_fraction(mp, mp->delta_y[0],ff);
+  }
+  return;
+}
+
+@* \[19] Measuring paths.
+\MP's \&{llcorner}, \&{lrcorner}, \&{ulcorner}, and \&{urcorner} operators
+allow the user to measure the bounding box of anything that can go into a
+picture.  It's easy to get rough bounds on the $x$ and $y$ extent of a path
+by just finding the bounding box of the knots and the control points. We
+need a more accurate version of the bounding box, but we can still use the
+easy estimate to save time by focusing on the interesting parts of the path.
+
+@ Computing an accurate bounding box involves a theme that will come up again
+and again. Given a Bernshte{\u\i}n polynomial
+@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
+$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
+we can conveniently bisect its range as follows:
+
+\smallskip
+\textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|.
+
+\smallskip
+\textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
+|0<=k<n-j|, for |0<=j<n|.
+
+\smallskip\noindent
+Then
+$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
+ =B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
+This formula gives us the coefficients of polynomials to use over the ranges
+$0\L t\L{1\over2}$ and ${1\over2}\L t\L1$.
+
+@ Now here's a subroutine that's handy for all sorts of path computations:
+Given a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function
+returns the unique |fraction| value |t| between 0 and~1 at which
+$B(a,b,c;t)$ changes from positive to negative, or returns
+|t=fraction_one+1| if no such value exists. If |a<0| (so that $B(a,b,c;t)$
+is already negative at |t=0|), |crossing_point| returns the value zero.
+
+@d no_crossing {  return (fraction_one+1); }
+@d one_crossing { return fraction_one; }
+@d zero_crossing { return 0; }
+@d mp_crossing_point(M,A,B,C) mp_do_crossing_point(A,B,C)
+
+@c fraction mp_do_crossing_point (integer a, integer b, integer c) {
+  integer d; /* recursive counter */
+  integer x,xx,x0,x1,x2; /* temporary registers for bisection */
+  if ( a<0 ) zero_crossing;
+  if ( c>=0 ) { 
+    if ( b>=0 ) {
+      if ( c>0 ) { no_crossing; }
+      else if ( (a==0)&&(b==0) ) { no_crossing;} 
+      else { one_crossing; } 
+    }
+    if ( a==0 ) zero_crossing;
+  } else if ( a==0 ) {
+    if ( b<=0 ) zero_crossing;
+  }
+  @<Use bisection to find the crossing point, if one exists@>;
+}
+
+@ The general bisection method is quite simple when $n=2$, hence
+|crossing_point| does not take much time. At each stage in the
+recursion we have a subinterval defined by |l| and~|j| such that
+$B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we want to ``zero in'' on
+the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$.
+
+It is convenient for purposes of calculation to combine the values
+of |l| and~|j| in a single variable $d=2^l+j$, because the operation
+of bisection then corresponds simply to doubling $d$ and possibly
+adding~1. Furthermore it proves to be convenient to modify
+our previous conventions for bisection slightly, maintaining the
+variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and $X_2=2^l(x_1-x_2)$.
+With these variables the conditions $x_0\ge0$ and $\min(x_1,x_2)<0$ are
+equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$.
+
+The following code maintains the invariant relations
+$0\L|x0|<\max(|x1|,|x1|+|x2|)$,
+$\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$;
+it has been constructed in such a way that no arithmetic overflow
+will occur if the inputs satisfy
+$a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert b-c\vert<2^{30}$.
+
+@<Use bisection to find the crossing point...@>=
+d=1; x0=a; x1=a-b; x2=b-c;
+do {  
+  x=half(x1+x2);
+  if ( x1-x0>x0 ) { 
+    x2=x; x0+=x0; d+=d;  
+  } else { 
+    xx=x1+x-x0;
+    if ( xx>x0 ) { 
+      x2=x; x0+=x0; d+=d;
+    }  else { 
+      x0=x0-xx;
+      if ( x<=x0 ) { if ( x+x2<=x0 ) no_crossing; }
+      x1=x; d=d+d+1;
+    }
+  }
+} while (d<fraction_one);
+return (d-fraction_one)
+
+@ Here is a routine that computes the $x$ or $y$ coordinate of the point on
+a cubic corresponding to the |fraction| value~|t|.
+
+It is convenient to define a \.{WEB} macro |t_of_the_way| such that
+|t_of_the_way(a,b)| expands to |a-(a-b)*t|, i.e., to |t[a,b]|.
+
+@d t_of_the_way(A,B) ((A)-mp_take_fraction(mp,((A)-(B)),t))
+
+@c scaled mp_eval_cubic (MP mp,pointer p, pointer q, fraction t) {
+  scaled x1,x2,x3; /* intermediate values */
+  x1=t_of_the_way(knot_coord(p),right_coord(p));
+  x2=t_of_the_way(right_coord(p),left_coord(q));
+  x3=t_of_the_way(left_coord(q),knot_coord(q));
+  x1=t_of_the_way(x1,x2);
+  x2=t_of_the_way(x2,x3);
+  return t_of_the_way(x1,x2);
+}
+
+@ The actual bounding box information is stored in global variables.
+Since it is convenient to address the $x$ and $y$ information
+separately, we define arrays indexed by |x_code..y_code| and use
+macros to give them more convenient names.
+
+@<Types...@>=
+enum mp_bb_code  {
+  mp_x_code=0, /* index for |minx| and |maxx| */
+  mp_y_code /* index for |miny| and |maxy| */
+} ;
+
+@ 
+@d minx mp->bbmin[mp_x_code]
+@d maxx mp->bbmax[mp_x_code]
+@d miny mp->bbmin[mp_y_code]
+@d maxy mp->bbmax[mp_y_code]
+
+@<Glob...@>=
+scaled bbmin[mp_y_code+1];
+scaled bbmax[mp_y_code+1]; 
+/* the result of procedures that compute bounding box information */
+
+@ Now we're ready for the key part of the bounding box computation.
+The |bound_cubic| procedure updates |bbmin[c]| and |bbmax[c]| based on
+$$B(\hbox{|knot_coord(p)|}, \hbox{|right_coord(p)|},
+    \hbox{|left_coord(q)|}, \hbox{|knot_coord(q)|};t)
+$$
+for $0<t\le1$.  In other words, the procedure adjusts the bounds to
+accommodate |knot_coord(q)| and any extremes over the range $0<t<1$.
+The |c| parameter is |x_code| or |y_code|.
+
+@c void mp_bound_cubic (MP mp,pointer p, pointer q, small_number c) {
+  boolean wavy; /* whether we need to look for extremes */
+  scaled del1,del2,del3,del,dmax; /* proportional to the control
+     points of a quadratic derived from a cubic */
+  fraction t,tt; /* where a quadratic crosses zero */
+  scaled x; /* a value that |bbmin[c]| and |bbmax[c]| must accommodate */
+  x=knot_coord(q);
+  @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+  @<Check the control points against the bounding box and set |wavy:=true|
+    if any of them lie outside@>;
+  if ( wavy ) {
+    del1=right_coord(p)-knot_coord(p);
+    del2=left_coord(q)-right_coord(p);
+    del3=knot_coord(q)-left_coord(q);
+    @<Scale up |del1|, |del2|, and |del3| for greater accuracy;
+      also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
+    if ( del<0 ) {
+      negate(del1); negate(del2); negate(del3);
+    };
+    t=mp_crossing_point(mp, del1,del2,del3);
+    if ( t<fraction_one ) {
+      @<Test the extremes of the cubic against the bounding box@>;
+    }
+  }
+}
+
+@ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>=
+if ( x<mp->bbmin[c] ) mp->bbmin[c]=x;
+if ( x>mp->bbmax[c] ) mp->bbmax[c]=x
+
+@ @<Check the control points against the bounding box and set...@>=
+wavy=true;
+if ( mp->bbmin[c]<=right_coord(p) )
+  if ( right_coord(p)<=mp->bbmax[c] )
+    if ( mp->bbmin[c]<=left_coord(q) )
+      if ( left_coord(q)<=mp->bbmax[c] )
+        wavy=false
+
+@ If |del1=del2=del3=0|, it's impossible to obey the title of this
+section. We just set |del=0| in that case.
+
+@<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>=
+if ( del1!=0 ) del=del1;
+else if ( del2!=0 ) del=del2;
+else del=del3;
+if ( del!=0 ) {
+  dmax=abs(del1);
+  if ( abs(del2)>dmax ) dmax=abs(del2);
+  if ( abs(del3)>dmax ) dmax=abs(del3);
+  while ( dmax<fraction_half ) {
+    dmax+=dmax; del1+=del1; del2+=del2; del3+=del3;
+  }
+}
+
+@ Since |crossing_point| has tried to choose |t| so that
+$B(|del1|,|del2|,|del3|;\tau)$ crosses zero at $\tau=|t|$ with negative
+slope, the value of |del2| computed below should not be positive.
+But rounding error could make it slightly positive in which case we
+must cut it to zero to avoid confusion.
+
+@<Test the extremes of the cubic against the bounding box@>=
+{ 
+  x=mp_eval_cubic(mp, p,q,t);
+  @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+  del2=t_of_the_way(del2,del3);
+    /* now |0,del2,del3| represent the derivative on the remaining interval */
+  if ( del2>0 ) del2=0;
+  tt=mp_crossing_point(mp, 0,-del2,-del3);
+  if ( tt<fraction_one ) {
+    @<Test the second extreme against the bounding box@>;
+  }
+}
+
+@ @<Test the second extreme against the bounding box@>=
+{
+   x=mp_eval_cubic(mp, p,q,t_of_the_way(tt,fraction_one));
+  @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
+}
+
+@ Finding the bounding box of a path is basically a matter of applying
+|bound_cubic| twice for each pair of adjacent knots.
+
+@c void mp_path_bbox (MP mp,pointer h) {
+  pointer p,q; /* a pair of adjacent knots */
+   minx=x_coord(h); miny=y_coord(h);
+  maxx=minx; maxy=miny;
+  p=h;
+  do {  
+    if ( right_type(p)==mp_endpoint ) return;
+    q=link(p);
+    mp_bound_cubic(mp, x_loc(p),x_loc(q),mp_x_code);
+    mp_bound_cubic(mp, y_loc(p),y_loc(q),mp_y_code);
+    p=q;
+  } while (p!=h);
+}
+
+@ Another important way to measure a path is to find its arc length.  This
+is best done by using the general bisection algorithm to subdivide the path
+until obtaining ``well behaved'' subpaths whose arc lengths can be approximated
+by simple means.
+
+Since the arc length is the integral with respect to time of the magnitude of
+the velocity, it is natural to use Simpson's rule for the approximation.
+@^Simpson's rule@>
+If $\dot B(t)$ is the spline velocity, Simpson's rule gives
+$$ \vb\dot B(0)\vb + 4\vb\dot B({1\over2})\vb + \vb\dot B(1)\vb \over 6 $$
+for the arc length of a path of length~1.  For a cubic spline
+$B(z_0,z_1,z_2,z_3;t)$, the time derivative $\dot B(t)$ is
+$3B(dz_0,dz_1,dz_2;t)$, where $dz_i=z_{i+1}-z_i$.  Hence the arc length
+approximation is
+$$ {\vb dz_0\vb \over 2} + 2\vb dz_{02}\vb + {\vb dz_2\vb \over 2}, $$
+where
+$$ dz_{02}={1\over2}\left({dz_0+dz_1\over 2}+{dz_1+dz_2\over 2}\right)$$
+is the result of the bisection algorithm.
+
+@ The remaining problem is how to decide when a subpath is ``well behaved.''
+This could be done via the theoretical error bound for Simpson's rule,
+@^Simpson's rule@>
+but this is impractical because it requires an estimate of the fourth
+derivative of the quantity being integrated.  It is much easier to just perform
+a bisection step and see how much the arc length estimate changes.  Since the
+error for Simpson's rule is proportional to the fourth power of the sample
+spacing, the remaining error is typically about $1\over16$ of the amount of
+the change.  We say ``typically'' because the error has a pseudo-random behavior
+that could cause the two estimates to agree when each contain large errors.
+
+To protect against disasters such as undetected cusps, the bisection process
+should always continue until all the $dz_i$ vectors belong to a single
+$90^\circ$ sector.  This ensures that no point on the spline can have velocity
+less than 70\% of the minimum of $\vb dz_0\vb$, $\vb dz_1\vb$ and $\vb dz_2\vb$.
+If such a spline happens to produce an erroneous arc length estimate that
+is little changed by bisection, the amount of the error is likely to be fairly
+small.  We will try to arrange things so that freak accidents of this type do
+not destroy the inverse relationship between the \&{arclength} and
+\&{arctime} operations.
+@:arclength_}{\&{arclength} primitive@>
+@:arctime_}{\&{arctime} primitive@>
+
+@ The \&{arclength} and \&{arctime} operations are both based on a recursive
+@^recursion@>
+function that finds the arc length of a cubic spline given $dz_0$, $dz_1$,
+$dz_2$. This |arc_test| routine also takes an arc length goal |a_goal| and
+returns the time when the arc length reaches |a_goal| if there is such a time.
+Thus the return value is either an arc length less than |a_goal| or, if the
+arc length would be at least |a_goal|, it returns a time value decreased by
+|two|.  This allows the caller to use the sign of the result to distinguish
+between arc lengths and time values.  On certain types of overflow, it is
+possible for |a_goal| and the result of |arc_test| both to be |el_gordo|.
+Otherwise, the result is always less than |a_goal|.
+
+Rather than halving the control point coordinates on each recursive call to
+|arc_test|, it is better to keep them proportional to velocity on the original
+curve and halve the results instead.  This means that recursive calls can
+potentially use larger error tolerances in their arc length estimates.  How
+much larger depends on to what extent the errors behave as though they are
+independent of each other.  To save computing time, we use optimistic assumptions
+and increase the tolerance by a factor of about $\sqrt2$ for each recursive
+call.
+
+In addition to the tolerance parameter, |arc_test| should also have parameters
+for ${1\over3}\vb\dot B(0)\vb$, ${2\over3}\vb\dot B({1\over2})\vb$, and
+${1\over3}\vb\dot B(1)\vb$.  These quantities are relatively expensive to compute
+and they are needed in different instances of |arc_test|.
+
+@c @<Declare subroutines needed by |arc_test|@>
+scaled mp_arc_test (MP mp, scaled dx0, scaled dy0, scaled dx1, scaled dy1, 
+                    scaled dx2, scaled dy2, scaled  v0, scaled v02, 
+                    scaled v2, scaled a_goal, scaled tol) {
+  boolean simple; /* are the control points confined to a $90^\circ$ sector? */
+  scaled dx01, dy01, dx12, dy12, dx02, dy02;  /* bisection results */
+  scaled v002, v022;
+    /* twice the velocity magnitudes at $t={1\over4}$ and $t={3\over4}$ */
+  scaled arc; /* best arc length estimate before recursion */
+  @<Other local variables in |arc_test|@>;
+  @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,
+    |dx2|, |dy2|@>;
+  @<Initialize |v002|, |v022|, and the arc length estimate |arc|; if it overflows
+    set |arc_test| and |return|@>;
+  @<Test if the control points are confined to one quadrant or rotating them
+    $45^\circ$ would put them in one quadrant.  Then set |simple| appropriately@>;
+  if ( simple && (abs(arc-v02-halfp(v0+v2)) <= tol) ) {
+    if ( arc < a_goal ) {
+      return arc;
+    } else {
+       @<Estimate when the arc length reaches |a_goal| and set |arc_test| to
+         that time minus |two|@>;
+    }
+  } else {
+    @<Use one or two recursive calls to compute the |arc_test| function@>;
+  }
+}
+
+@ The |tol| value should by multiplied by $\sqrt 2$ before making recursive
+calls, but $1.5$ is an adequate approximation.  It is best to avoid using
+|make_fraction| in this inner loop.
+@^inner loop@>
+
+@<Use one or two recursive calls to compute the |arc_test| function@>=
+{ 
+  @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is as
+    large as possible@>;
+  tol = tol + halfp(tol);
+  a = mp_arc_test(mp, dx0,dy0, dx01,dy01, dx02,dy02, v0, v002, 
+                  halfp(v02), a_new, tol);
+  if ( a<0 )  {
+     return (-halfp(two-a));
+  } else { 
+    @<Update |a_new| to reduce |a_new+a_aux| by |a|@>;
+    b = mp_arc_test(mp, dx02,dy02, dx12,dy12, dx2,dy2,
+                    halfp(v02), v022, v2, a_new, tol);
+    if ( b<0 )  
+      return (-halfp(-b) - half_unit);
+    else  
+      return (a + half(b-a));
+  }
+}
+
+@ @<Other local variables in |arc_test|@>=
+scaled a,b; /* results of recursive calls */
+scaled a_new,a_aux; /* the sum of these gives the |a_goal| */
+
+@ @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is...@>=
+a_aux = el_gordo - a_goal;
+if ( a_goal > a_aux ) {
+  a_aux = a_goal - a_aux;
+  a_new = el_gordo;
+} else { 
+  a_new = a_goal + a_goal;
+  a_aux = 0;
+}
+
+@ There is no need to maintain |a_aux| at this point so we use it as a temporary
+to force the additions and subtractions to be done in an order that avoids
+overflow.
+
+@<Update |a_new| to reduce |a_new+a_aux| by |a|@>=
+if ( a > a_aux ) {
+  a_aux = a_aux - a;
+  a_new = a_new + a_aux;
+}
+
+@ This code assumes all {\it dx} and {\it dy} variables have magnitude less than
+|fraction_four|.  To simplify the rest of the |arc_test| routine, we strengthen
+this assumption by requiring the norm of each $({\it dx},{\it dy})$ pair to obey
+this bound.  Note that recursive calls will maintain this invariant.
+
+@<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,...@>=
+dx01 = half(dx0 + dx1);
+dx12 = half(dx1 + dx2);
+dx02 = half(dx01 + dx12);
+dy01 = half(dy0 + dy1);
+dy12 = half(dy1 + dy2);
+dy02 = half(dy01 + dy12)
+
+@ We should be careful to keep |arc<el_gordo| so that calling |arc_test| with
+|a_goal=el_gordo| is guaranteed to yield the arc length.
+
+@<Initialize |v002|, |v022|, and the arc length estimate |arc|;...@>=
+v002 = mp_pyth_add(mp, dx01+half(dx0+dx02), dy01+half(dy0+dy02));
+v022 = mp_pyth_add(mp, dx12+half(dx02+dx2), dy12+half(dy02+dy2));
+tmp = halfp(v02+2);
+arc1 = v002 + half(halfp(v0+tmp) - v002);
+arc = v022 + half(halfp(v2+tmp) - v022);
+if ( (arc < el_gordo-arc1) )  {
+  arc = arc+arc1;
+} else { 
+  mp->arith_error = true;
+  if ( a_goal==el_gordo )  return (el_gordo);
+  else return (-two);
+}
+
+@ @<Other local variables in |arc_test|@>=
+scaled tmp, tmp2; /* all purpose temporary registers */
+scaled arc1; /* arc length estimate for the first half */
+
+@ @<Test if the control points are confined to one quadrant or rotating...@>=
+simple = ((dx0>=0) && (dx1>=0) && (dx2>=0)) ||
+         ((dx0<=0) && (dx1<=0) && (dx2<=0));
+if ( simple )
+  simple = ((dy0>=0) && (dy1>=0) && (dy2>=0)) ||
+           ((dy0<=0) && (dy1<=0) && (dy2<=0));
+if ( ! simple ) {
+  simple = ((dx0>=dy0) && (dx1>=dy1) && (dx2>=dy2)) ||
+           ((dx0<=dy0) && (dx1<=dy1) && (dx2<=dy2));
+  if ( simple ) 
+    simple = ((-dx0>=dy0) && (-dx1>=dy1) && (-dx2>=dy2)) ||
+             ((-dx0<=dy0) && (-dx1<=dy1) && (-dx2<=dy2));
+}
+
+@ Since Simpson's rule is based on approximating the integrand by a parabola,
+@^Simpson's rule@>
+it is appropriate to use the same approximation to decide when the integral
+reaches the intermediate value |a_goal|.  At this point
+$$\eqalign{
+    {\vb\dot B(0)\vb\over 3} &= \hbox{|v0|}, \qquad
+    {\vb\dot B({1\over4})\vb\over 3} = {\hbox{|v002|}\over 2}, \qquad
+    {\vb\dot B({1\over2})\vb\over 3} = {\hbox{|v02|}\over 2}, \cr
+    {\vb\dot B({3\over4})\vb\over 3} &= {\hbox{|v022|}\over 2}, \qquad
+    {\vb\dot B(1)\vb\over 3} = \hbox{|v2|} \cr
+}
+$$
+and
+$$ {\vb\dot B(t)\vb\over 3} \approx
+  \cases{B\left(\hbox{|v0|},
+      \hbox{|v002|}-{1\over 2}\hbox{|v0|}-{1\over 4}\hbox{|v02|},
+      {1\over 2}\hbox{|v02|}; 2t \right)&
+    if $t\le{1\over 2}$\cr
+  B\left({1\over 2}\hbox{|v02|},
+      \hbox{|v022|}-{1\over 4}\hbox{|v02|}-{1\over 2}\hbox{|v2|},
+      \hbox{|v2|}; 2t-1 \right)&
+    if $t\ge{1\over 2}$.\cr}
+ \eqno (*)
+$$
+We can integrate $\vb\dot B(t)\vb$ by using
+$$\int 3B(a,b,c;\tau)\,dt =
+  {B(0,a,a+b,a+b+c;\tau) + {\rm constant} \over {d\tau\over dt}}.
+$$
+
+This construction allows us to find the time when the arc length reaches
+|a_goal| by solving a cubic equation of the form
+$$ B(0,a,a+b,a+b+c;\tau) = x, $$
+where $\tau$ is $2t$ or $2t+1$, $x$ is |a_goal| or |a_goal-arc1|, and $a$, $b$,
+and $c$ are the Bernshte{\u\i}n coefficients from $(*)$ divided by
+@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
+$d\tau\over dt$.  We shall define a function |solve_rising_cubic| that finds
+$\tau$ given $a$, $b$, $c$, and $x$.
+
+@<Estimate when the arc length reaches |a_goal| and set |arc_test| to...@>=
+{ 
+  tmp = (v02 + 2) / 4;
+  if ( a_goal<=arc1 ) {
+    tmp2 = halfp(v0);
+    return 
+      (halfp(mp_solve_rising_cubic(mp, tmp2, arc1-tmp2-tmp, tmp, a_goal))- two);
+  } else { 
+    tmp2 = halfp(v2);
+    return ((half_unit - two) +
+      halfp(mp_solve_rising_cubic(mp, tmp, arc-arc1-tmp-tmp2, tmp2, a_goal-arc1)));
+  }
+}
+
+@ Here is the |solve_rising_cubic| routine that finds the time~$t$ when
+$$ B(0, a, a+b, a+b+c; t) = x. $$
+This routine is based on |crossing_point| but is simplified by the
+assumptions that $B(a,b,c;t)\ge0$ for $0\le t\le1$ and that |0<=x<=a+b+c|.
+If rounding error causes this condition to be violated slightly, we just ignore
+it and proceed with binary search.  This finds a time when the function value
+reaches |x| and the slope is positive.
+
+@<Declare subroutines needed by |arc_test|@>=
+scaled mp_solve_rising_cubic (MP mp,scaled a, scaled b,  scaled c, scaled x) {
+  scaled ab, bc, ac; /* bisection results */
+  integer t; /* $2^k+q$ where unscaled answer is in $[q2^{-k},(q+1)2^{-k})$ */
+  integer xx; /* temporary for updating |x| */
+  if ( (a<0) || (c<0) ) mp_confusion(mp, "rising?");
+@:this can't happen rising?}{\quad rising?@>
+  if ( x<=0 ) {
+	return 0;
+  } else if ( x >= a+b+c ) {
+    return unity;
+  } else { 
+    t = 1;
+    @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than
+      |el_gordo div 3|@>;
+    do {  
+      t+=t;
+      @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>;
+      xx = x - a - ab - ac;
+      if ( xx < -x ) { x+=x; b=ab; c=ac;  }
+      else { x = x + xx;  a=ac; b=bc; t = t+1; };
+    } while (t < unity);
+    return (t - unity);
+  }
+}
+
+@ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>=
+ab = half(a+b);
+bc = half(b+c);
+ac = half(ab+bc)
+
+@ @d one_third_el_gordo 05252525252 /* upper bound on |a|, |b|, and |c| */
+
+@<Rescale if necessary to make sure |a|, |b|, and |c| are all less than...@>=
+while ((a>one_third_el_gordo)||(b>one_third_el_gordo)||(c>one_third_el_gordo)) { 
+  a = halfp(a);
+  b = half(b);
+  c = halfp(c);
+  x = halfp(x);
+}
+
+@ It is convenient to have a simpler interface to |arc_test| that requires no
+unnecessary arguments and ensures that each $({\it dx},{\it dy})$ pair has
+length less than |fraction_four|.
+
+@d arc_tol   16  /* quit when change in arc length estimate reaches this */
+
+@c scaled mp_do_arc_test (MP mp,scaled dx0, scaled dy0, scaled dx1, 
+                          scaled dy1, scaled dx2, scaled dy2, scaled a_goal) {
+  scaled v0,v1,v2; /* length of each $({\it dx},{\it dy})$ pair */
+  scaled v02; /* twice the norm of the quadratic at $t={1\over2}$ */
+  v0 = mp_pyth_add(mp, dx0,dy0);
+  v1 = mp_pyth_add(mp, dx1,dy1);
+  v2 = mp_pyth_add(mp, dx2,dy2);
+  if ( (v0>=fraction_four) || (v1>=fraction_four) || (v2>=fraction_four) ) { 
+    mp->arith_error = true;
+    if ( a_goal==el_gordo )  return el_gordo;
+    else return (-two);
+  } else { 
+    v02 = mp_pyth_add(mp, dx1+half(dx0+dx2), dy1+half(dy0+dy2));
+    return (mp_arc_test(mp, dx0,dy0, dx1,dy1, dx2,dy2,
+                                 v0, v02, v2, a_goal, arc_tol));
+  }
+}
+
+@ Now it is easy to find the arc length of an entire path.
+
+@c scaled mp_get_arc_length (MP mp,pointer h) {
+  pointer p,q; /* for traversing the path */
+  scaled a,a_tot; /* current and total arc lengths */
+  a_tot = 0;
+  p = h;
+  while ( right_type(p)!=mp_endpoint ){ 
+    q = link(p);
+    a = mp_do_arc_test(mp, right_x(p)-x_coord(p), right_y(p)-y_coord(p),
+      left_x(q)-right_x(p), left_y(q)-right_y(p),
+      x_coord(q)-left_x(q), y_coord(q)-left_y(q), el_gordo);
+    a_tot = mp_slow_add(mp, a, a_tot);
+    if ( q==h ) break;  else p=q;
+  }
+  check_arith;
+  return a_tot;
+}
+
+@ The inverse operation of finding the time on a path~|h| when the arc length
+reaches some value |arc0| can also be accomplished via |do_arc_test|.  Some care
+is required to handle very large times or negative times on cyclic paths.  For
+non-cyclic paths, |arc0| values that are negative or too large cause
+|get_arc_time| to return 0 or the length of path~|h|.
+
+If |arc0| is greater than the arc length of a cyclic path~|h|, the result is a
+time value greater than the length of the path.  Since it could be much greater,
+we must be prepared to compute the arc length of path~|h| and divide this into
+|arc0| to find how many multiples of the length of path~|h| to add.
+
+@c scaled mp_get_arc_time (MP mp,pointer h, scaled  arc0) {
+  pointer p,q; /* for traversing the path */
+  scaled t_tot; /* accumulator for the result */
+  scaled t; /* the result of |do_arc_test| */
+  scaled arc; /* portion of |arc0| not used up so far */
+  integer n; /* number of extra times to go around the cycle */
+  if ( arc0<0 ) {
+    @<Deal with a negative |arc0| value and |return|@>;
+  }
+  if ( arc0==el_gordo ) decr(arc0);
+  t_tot = 0;
+  arc = arc0;
+  p = h;
+  while ( (right_type(p)!=mp_endpoint) && (arc>0) ) {
+    q = link(p);
+    t = mp_do_arc_test(mp, right_x(p)-x_coord(p), right_y(p)-y_coord(p),
+      left_x(q)-right_x(p), left_y(q)-right_y(p),
+      x_coord(q)-left_x(q), y_coord(q)-left_y(q), arc);
+    @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>;
+    if ( q==h ) {
+      @<Update |t_tot| and |arc| to avoid going around the cyclic
+        path too many times but set |arith_error:=true| and |goto done| on
+        overflow@>;
+    }
+    p = q;
+  }
+  check_arith;
+  return t_tot;
+}
+
+@ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>=
+if ( t<0 ) { t_tot = t_tot + t + two;  arc = 0;  }
+else { t_tot = t_tot + unity;  arc = arc - t;  }
+
+@ @<Deal with a negative |arc0| value and |return|@>=
+{ 
+  if ( left_type(h)==mp_endpoint ) {
+    t_tot=0;
+  } else { 
+    p = mp_htap_ypoc(mp, h);
+    t_tot = -mp_get_arc_time(mp, p, -arc0);
+    mp_toss_knot_list(mp, p);
+  }
+  check_arith;
+  return t_tot;
+}
+
+@ @<Update |t_tot| and |arc| to avoid going around the cyclic...@>=
+if ( arc>0 ) { 
+  n = arc / (arc0 - arc);
+  arc = arc - n*(arc0 - arc);
+  if ( t_tot > (el_gordo / (n+1)) ) { 
+	return el_gordo;
+  }
+  t_tot = (n + 1)*t_tot;
+}
+
+@* \[20] Data structures for pens.
+A Pen in \MP\ can be either elliptical or polygonal.  Elliptical pens result
+in \ps\ \&{stroke} commands, while anything drawn with a polygonal pen is
+@:stroke}{\&{stroke} command@>
+converted into an area fill as described in the next part of this program.
+The mathematics behind this process is based on simple aspects of the theory
+of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge Stolfi
+[``A kinematic framework for computational geometry,'' Proc.\ IEEE Symp.\
+Foundations of Computer Science {\bf 24} (1983), 100--111].
+
+Polygonal pens are created from paths via \MP's \&{makepen} primitive.
+@:makepen_}{\&{makepen} primitive@>
+This path representation is almost sufficient for our purposes except that
+a pen path should always be a convex polygon with the vertices in
+counter-clockwise order.
+Since we will need to scan pen polygons both forward and backward, a pen
+should be represented as a doubly linked ring of knot nodes.  There is
+room for the extra back pointer because we do not need the
+|left_type| or |right_type| fields.  In fact, we don't need the |left_x|,
+|left_y|, |right_x|, or |right_y| fields either but we leave these alone
+so that certain procedures can operate on both pens and paths.  In particular,
+pens can be copied using |copy_path| and recycled using |toss_knot_list|.
+
+@d knil info
+  /* this replaces the |left_type| and |right_type| fields in a pen knot */
+
+@ The |make_pen| procedure turns a path into a pen by initializing
+the |knil| pointers and making sure the knots form a convex polygon.
+Thus each cubic in the given path becomes a straight line and the control
+points are ignored.  If the path is not cyclic, the ends are connected by a
+straight line.
+
+@d copy_pen(A) mp_make_pen(mp, mp_copy_path(mp, (A)),false)
+
+@c @<Declare a function called |convex_hull|@>
+pointer mp_make_pen (MP mp,pointer h, boolean need_hull) {
+  pointer p,q; /* two consecutive knots */
+  q=h;
+  do {  
+    p=q; q=link(q);
+    knil(q)=p;
+  } while (q!=h);
+  if ( need_hull ){ 
+    h=mp_convex_hull(mp, h);
+    @<Make sure |h| isn't confused with an elliptical pen@>;
+  }
+  return h;
+}
+
+@ The only information required about an elliptical pen is the overall
+transformation that has been applied to the original \&{pencircle}.
+@:pencircle_}{\&{pencircle} primitive@>
+Since it suffices to keep track of how the three points $(0,0)$, $(1,0)$,
+and $(0,1)$ are transformed, an elliptical pen can be stored in a single
+knot node and transformed as if it were a path.
+
+@d pen_is_elliptical(A) ((A)==link((A)))
+
+@c pointer mp_get_pen_circle (MP mp,scaled diam) {
+  pointer h; /* the knot node to return */
+  h=mp_get_node(mp, knot_node_size);
+  link(h)=h; knil(h)=h;
+  originator(h)=mp_program_code;
+  x_coord(h)=0; y_coord(h)=0;
+  left_x(h)=diam; left_y(h)=0;
+  right_x(h)=0; right_y(h)=diam;
+  return h;
+}
+
+@ If the polygon being returned by |make_pen| has only one vertex, it will
+be interpreted as an elliptical pen.  This is no problem since a degenerate
+polygon can equally well be thought of as a degenerate ellipse.  We need only
+initialize the |left_x|, |left_y|, |right_x|, and |right_y| fields.
+
+@<Make sure |h| isn't confused with an elliptical pen@>=
+if ( pen_is_elliptical( h) ){ 
+  left_x(h)=x_coord(h); left_y(h)=y_coord(h);
+  right_x(h)=x_coord(h); right_y(h)=y_coord(h);
+}
+
+@ We have to cheat a little here but most operations on pens only use
+the first three words in each knot node.
+@^data structure assumptions@>
+
+@<Initialize a pen at |test_pen| so that it fits in nine words@>=
+x_coord(test_pen)=-half_unit;
+y_coord(test_pen)=0;
+x_coord(test_pen+3)=half_unit;
+y_coord(test_pen+3)=0;
+x_coord(test_pen+6)=0;
+y_coord(test_pen+6)=unity;
+link(test_pen)=test_pen+3;
+link(test_pen+3)=test_pen+6;
+link(test_pen+6)=test_pen;
+knil(test_pen)=test_pen+6;
+knil(test_pen+3)=test_pen;
+knil(test_pen+6)=test_pen+3
+
+@ Printing a polygonal pen is very much like printing a path
+
+@<Declare subroutines for printing expressions@>=
+void mp_pr_pen (MP mp,pointer h) {
+  pointer p,q; /* for list traversal */
+  if ( pen_is_elliptical(h) ) {
+    @<Print the elliptical pen |h|@>;
+  } else { 
+    p=h;
+    do {  
+      mp_print_two(mp, x_coord(p),y_coord(p));
+      mp_print_nl(mp, " .. ");
+      @<Advance |p| making sure the links are OK and |return| if there is
+        a problem@>;
+     } while (p!=h);
+     mp_print(mp, "cycle");
+  }
+}
+
+@ @<Advance |p| making sure the links are OK and |return| if there is...@>=
+q=link(p);
+if ( (q==null) || (knil(q)!=p) ) { 
+  mp_print_nl(mp, "???"); return; /* this won't happen */
+@.???@>
+}
+p=q
+
+@ @<Print the elliptical pen |h|@>=
+{ 
+mp_print(mp, "pencircle transformed (");
+mp_print_scaled(mp, x_coord(h));
+mp_print_char(mp, ',');
+mp_print_scaled(mp, y_coord(h));
+mp_print_char(mp, ',');
+mp_print_scaled(mp, left_x(h)-x_coord(h));
+mp_print_char(mp, ',');
+mp_print_scaled(mp, right_x(h)-x_coord(h));
+mp_print_char(mp, ',');
+mp_print_scaled(mp, left_y(h)-y_coord(h));
+mp_print_char(mp, ',');
+mp_print_scaled(mp, right_y(h)-y_coord(h));
+mp_print_char(mp, ')');
+}
+
+@ Here us another version of |pr_pen| that prints the pen as a diagnostic
+message.
+
+@<Declare subroutines for printing expressions@>=
+void mp_print_pen (MP mp,pointer h, const char *s, boolean nuline) { 
+  mp_print_diagnostic(mp, "Pen",s,nuline); mp_print_ln(mp);
+@.Pen at line...@>
+  mp_pr_pen(mp, h);
+  mp_end_diagnostic(mp, true);
+}
+
+@ Making a polygonal pen into a path involves restoring the |left_type| and
+|right_type| fields and setting the control points so as to make a polygonal
+path.
+
+@c 
+void mp_make_path (MP mp,pointer h) {
+  pointer p; /* for traversing the knot list */
+  small_number k; /* a loop counter */
+  @<Other local variables in |make_path|@>;
+  if ( pen_is_elliptical(h) ) {
+    @<Make the elliptical pen |h| into a path@>;
+  } else { 
+    p=h;
+    do {  
+      left_type(p)=mp_explicit;
+      right_type(p)=mp_explicit;
+      @<copy the coordinates of knot |p| into its control points@>;
+       p=link(p);
+    } while (p!=h);
+  }
+}
+
+@ @<copy the coordinates of knot |p| into its control points@>=
+left_x(p)=x_coord(p);
+left_y(p)=y_coord(p);
+right_x(p)=x_coord(p);
+right_y(p)=y_coord(p)
+
+@ We need an eight knot path to get a good approximation to an ellipse.
+
+@<Make the elliptical pen |h| into a path@>=
+{ 
+  @<Extract the transformation parameters from the elliptical pen~|h|@>;
+  p=h;
+  for (k=0;k<=7;k++ ) { 
+    @<Initialize |p| as the |k|th knot of a circle of unit diameter,
+      transforming it appropriately@>;
+    if ( k==7 ) link(p)=h;  else link(p)=mp_get_node(mp, knot_node_size);
+    p=link(p);
+  }
+}
+
+@ @<Extract the transformation parameters from the elliptical pen~|h|@>=
+center_x=x_coord(h);
+center_y=y_coord(h);
+width_x=left_x(h)-center_x;
+width_y=left_y(h)-center_y;
+height_x=right_x(h)-center_x;
+height_y=right_y(h)-center_y
+
+@ @<Other local variables in |make_path|@>=
+scaled center_x,center_y; /* translation parameters for an elliptical pen */
+scaled width_x,width_y; /* the effect of a unit change in $x$ */
+scaled height_x,height_y; /* the effect of a unit change in $y$ */
+scaled dx,dy; /* the vector from knot |p| to its right control point */
+integer kk;
+  /* |k| advanced $270^\circ$ around the ring (cf. $\sin\theta=\cos(\theta+270)$) */
+
+@ The only tricky thing here are the tables |half_cos| and |d_cos| used to
+find the point $k/8$ of the way around the circle and the direction vector
+to use there.
+
+@<Initialize |p| as the |k|th knot of a circle of unit diameter,...@>=
+kk=(k+6)% 8;
+x_coord(p)=center_x+mp_take_fraction(mp, mp->half_cos[k],width_x)
+           +mp_take_fraction(mp, mp->half_cos[kk],height_x);
+y_coord(p)=center_y+mp_take_fraction(mp, mp->half_cos[k],width_y)
+           +mp_take_fraction(mp, mp->half_cos[kk],height_y);
+dx=-mp_take_fraction(mp, mp->d_cos[kk],width_x)
+   +mp_take_fraction(mp, mp->d_cos[k],height_x);
+dy=-mp_take_fraction(mp, mp->d_cos[kk],width_y)
+   +mp_take_fraction(mp, mp->d_cos[k],height_y);
+right_x(p)=x_coord(p)+dx;
+right_y(p)=y_coord(p)+dy;
+left_x(p)=x_coord(p)-dx;
+left_y(p)=y_coord(p)-dy;
+left_type(p)=mp_explicit;
+right_type(p)=mp_explicit;
+originator(p)=mp_program_code
+
+@ @<Glob...@>=
+fraction half_cos[8]; /* ${1\over2}\cos(45k)$ */
+fraction d_cos[8]; /* a magic constant times $\cos(45k)$ */
+
+@ The magic constant for |d_cos| is the distance between $({1\over2},0)$ and
+$({1\over4}\sqrt2,{1\over4}\sqrt2)$ times the result of the |velocity|
+function for $\theta=\phi=22.5^\circ$.  This comes out to be
+$$ d = {\sqrt{2-\sqrt2}\over 3+3\cos22.5^\circ}
+  \approx 0.132608244919772.
+$$
+
+@<Set init...@>=
+mp->half_cos[0]=fraction_half;
+mp->half_cos[1]=94906266; /* $2^{26}\sqrt2\approx94906265.62$ */
+mp->half_cos[2]=0;
+mp->d_cos[0]=35596755; /* $2^{28}d\approx35596754.69$ */
+mp->d_cos[1]=25170707; /* $2^{27}\sqrt2\,d\approx25170706.63$ */
+mp->d_cos[2]=0;
+for (k=3;k<= 4;k++ ) { 
+  mp->half_cos[k]=-mp->half_cos[4-k];
+  mp->d_cos[k]=-mp->d_cos[4-k];
+}
+for (k=5;k<= 7;k++ ) { 
+  mp->half_cos[k]=mp->half_cos[8-k];
+  mp->d_cos[k]=mp->d_cos[8-k];
+}
+
+@ The |convex_hull| function forces a pen polygon to be convex when it is
+returned by |make_pen| and after any subsequent transformation where rounding
+error might allow the convexity to be lost.
+The convex hull algorithm used here is described by F.~P. Preparata and
+M.~I. Shamos [{\sl Computational Geometry}, Springer-Verlag, 1985].
+
+@<Declare a function called |convex_hull|@>=
+@<Declare a procedure called |move_knot|@>
+pointer mp_convex_hull (MP mp,pointer h) { /* Make a polygonal pen convex */
+  pointer l,r; /* the leftmost and rightmost knots */
+  pointer p,q; /* knots being scanned */
+  pointer s; /* the starting point for an upcoming scan */
+  scaled dx,dy; /* a temporary pointer */
+  if ( pen_is_elliptical(h) ) {
+     return h;
+  } else { 
+    @<Set |l| to the leftmost knot in polygon~|h|@>;
+    @<Set |r| to the rightmost knot in polygon~|h|@>;
+    if ( l!=r ) { 
+      s=link(r);
+      @<Find any knots on the path from |l| to |r| above the |l|-|r| line and
+        move them past~|r|@>;
+      @<Find any knots on the path from |s| to |l| below the |l|-|r| line and
+        move them past~|l|@>;
+      @<Sort the path from |l| to |r| by increasing $x$@>;
+      @<Sort the path from |r| to |l| by decreasing $x$@>;
+    }
+    if ( l!=link(l) ) {
+      @<Do a Gramm scan and remove vertices where there is no left turn@>;
+    }
+    return l;
+  }
+}
+
+@ All comparisons are done primarily on $x$ and secondarily on $y$.
+
+@<Set |l| to the leftmost knot in polygon~|h|@>=
+l=h;
+p=link(h);
+while ( p!=h ) { 
+  if ( x_coord(p)<=x_coord(l) )
+    if ( (x_coord(p)<x_coord(l)) || (y_coord(p)<y_coord(l)) )
+      l=p;
+  p=link(p);
+}
+
+@ @<Set |r| to the rightmost knot in polygon~|h|@>=
+r=h;
+p=link(h);
+while ( p!=h ) { 
+  if ( x_coord(p)>=x_coord(r) )
+    if ( (x_coord(p)>x_coord(r)) || (y_coord(p)>y_coord(r)) )
+      r=p;
+  p=link(p);
+}
+
+@ @<Find any knots on the path from |l| to |r| above the |l|-|r| line...@>=
+dx=x_coord(r)-x_coord(l);
+dy=y_coord(r)-y_coord(l);
+p=link(l);
+while ( p!=r ) { 
+  q=link(p);
+  if ( mp_ab_vs_cd(mp, dx,y_coord(p)-y_coord(l),dy,x_coord(p)-x_coord(l))>0 )
+    mp_move_knot(mp, p, r);
+  p=q;
+}
+
+@ The |move_knot| procedure removes |p| from a doubly linked list and inserts
+it after |q|.
+
+@ @<Declare a procedure called |move_knot|@>=
+void mp_move_knot (MP mp,pointer p, pointer q) { 
+  link(knil(p))=link(p);
+  knil(link(p))=knil(p);
+  knil(p)=q;
+  link(p)=link(q);
+  link(q)=p;
+  knil(link(p))=p;
+}
+
+@ @<Find any knots on the path from |s| to |l| below the |l|-|r| line...@>=
+p=s;
+while ( p!=l ) { 
+  q=link(p);
+  if ( mp_ab_vs_cd(mp, dx,y_coord(p)-y_coord(l),dy,x_coord(p)-x_coord(l))<0 )
+    mp_move_knot(mp, p,l);
+  p=q;
+}
+
+@ The list is likely to be in order already so we just do linear insertions.
+Secondary comparisons on $y$ ensure that the sort is consistent with the
+choice of |l| and |r|.
+
+@<Sort the path from |l| to |r| by increasing $x$@>=
+p=link(l);
+while ( p!=r ) { 
+  q=knil(p);
+  while ( x_coord(q)>x_coord(p) ) q=knil(q);
+  while ( x_coord(q)==x_coord(p) ) {
+    if ( y_coord(q)>y_coord(p) ) q=knil(q); else break;
+  }
+  if ( q==knil(p) ) p=link(p);
+  else { p=link(p); mp_move_knot(mp, knil(p),q); };
+}
+
+@ @<Sort the path from |r| to |l| by decreasing $x$@>=
+p=link(r);
+while ( p!=l ){ 
+  q=knil(p);
+  while ( x_coord(q)<x_coord(p) ) q=knil(q);
+  while ( x_coord(q)==x_coord(p) ) {
+    if ( y_coord(q)<y_coord(p) ) q=knil(q); else break;
+  }
+  if ( q==knil(p) ) p=link(p);
+  else { p=link(p); mp_move_knot(mp, knil(p),q); };
+}
+
+@ The condition involving |ab_vs_cd| tests if there is not a left turn
+at knot |q|.  There usually will be a left turn so we streamline the case
+where the |then| clause is not executed.
+
+@<Do a Gramm scan and remove vertices where there...@>=
+{ 
+p=l; q=link(l);
+while (1) { 
+  dx=x_coord(q)-x_coord(p);
+  dy=y_coord(q)-y_coord(p);
+  p=q; q=link(q);
+  if ( p==l ) break;
+  if ( p!=r )
+    if ( mp_ab_vs_cd(mp, dx,y_coord(q)-y_coord(p),dy,x_coord(q)-x_coord(p))<=0 ) {
+      @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>;
+    }
+  }
+}
+
+@ @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>=
+{ 
+s=knil(p);
+mp_free_node(mp, p,knot_node_size);
+link(s)=q; knil(q)=s;
+if ( s==l ) p=s;
+else { p=knil(s); q=s; };
+}
+
+@ The |find_offset| procedure sets global variables |(cur_x,cur_y)| to the
+offset associated with the given direction |(x,y)|.  If two different offsets
+apply, it chooses one of them.
+
+@c 
+void mp_find_offset (MP mp,scaled x, scaled y, pointer h) {
+  pointer p,q; /* consecutive knots */
+  scaled wx,wy,hx,hy;
+  /* the transformation matrix for an elliptical pen */
+  fraction xx,yy; /* untransformed offset for an elliptical pen */
+  fraction d; /* a temporary register */
+  if ( pen_is_elliptical(h) ) {
+    @<Find the offset for |(x,y)| on the elliptical pen~|h|@>
+  } else { 
+    q=h;
+    do {  
+      p=q; q=link(q);
+    } while (!(mp_ab_vs_cd(mp, x_coord(q)-x_coord(p),y, y_coord(q)-y_coord(p),x)>=0));
+    do {  
+      p=q; q=link(q);
+    } while (!(mp_ab_vs_cd(mp, x_coord(q)-x_coord(p),y, y_coord(q)-y_coord(p),x)<=0));
+    mp->cur_x=x_coord(p);
+    mp->cur_y=y_coord(p);
+  }
+}
+
+@ @<Glob...@>=
+scaled cur_x;
+scaled cur_y; /* all-purpose return value registers */
+
+@ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>=
+if ( (x==0) && (y==0) ) {
+  mp->cur_x=x_coord(h); mp->cur_y=y_coord(h);  
+} else { 
+  @<Find the non-constant part of the transformation for |h|@>;
+  while ( (abs(x)<fraction_half) && (abs(y)<fraction_half) ){ 
+    x+=x; y+=y;  
+  };
+  @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the
+    untransformed version of |(x,y)|@>;
+  mp->cur_x=x_coord(h)+mp_take_fraction(mp, xx,wx)+mp_take_fraction(mp, yy,hx);
+  mp->cur_y=y_coord(h)+mp_take_fraction(mp, xx,wy)+mp_take_fraction(mp, yy,hy);
+}
+
+@ @<Find the non-constant part of the transformation for |h|@>=
+wx=left_x(h)-x_coord(h);
+wy=left_y(h)-y_coord(h);
+hx=right_x(h)-x_coord(h);
+hy=right_y(h)-y_coord(h)
+
+@ @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the...@>=
+yy=-(mp_take_fraction(mp, x,hy)+mp_take_fraction(mp, y,-hx));
+xx=mp_take_fraction(mp, x,-wy)+mp_take_fraction(mp, y,wx);
+d=mp_pyth_add(mp, xx,yy);
+if ( d>0 ) { 
+  xx=half(mp_make_fraction(mp, xx,d));
+  yy=half(mp_make_fraction(mp, yy,d));
+}
+
+@ Finding the bounding box of a pen is easy except if the pen is elliptical.
+But we can handle that case by just calling |find_offset| twice.  The answer
+is stored in the global variables |minx|, |maxx|, |miny|, and |maxy|.
+
+@c 
+void mp_pen_bbox (MP mp,pointer h) {
+  pointer p; /* for scanning the knot list */
+  if ( pen_is_elliptical(h) ) {
+    @<Find the bounding box of an elliptical pen@>;
+  } else { 
+    minx=x_coord(h); maxx=minx;
+    miny=y_coord(h); maxy=miny;
+    p=link(h);
+    while ( p!=h ) {
+      if ( x_coord(p)<minx ) minx=x_coord(p);
+      if ( y_coord(p)<miny ) miny=y_coord(p);
+      if ( x_coord(p)>maxx ) maxx=x_coord(p);
+      if ( y_coord(p)>maxy ) maxy=y_coord(p);
+      p=link(p);
+    }
+  }
+}
+
+@ @<Find the bounding box of an elliptical pen@>=
+{ 
+mp_find_offset(mp, 0,fraction_one,h);
+maxx=mp->cur_x;
+minx=2*x_coord(h)-mp->cur_x;
+mp_find_offset(mp, -fraction_one,0,h);
+maxy=mp->cur_y;
+miny=2*y_coord(h)-mp->cur_y;
+}
+
+@* \[21] Edge structures.
+Now we come to \MP's internal scheme for representing pictures.
+The representation is very different from \MF's edge structures
+because \MP\ pictures contain \ps\ graphics objects instead of pixel
+images.  However, the basic idea is somewhat similar in that shapes
+are represented via their boundaries.
+
+The main purpose of edge structures is to keep track of graphical objects
+until it is time to translate them into \ps.  Since \MP\ does not need to
+know anything about an edge structure other than how to translate it into
+\ps\ and how to find its bounding box, edge structures can be just linked
+lists of graphical objects.  \MP\ has no easy way to determine whether
+two such objects overlap, but it suffices to draw the first one first and
+let the second one overwrite it if necessary.
+
+@<Types...@>=
+enum mp_graphical_object_code {
+  @<Graphical object codes@>
+  mp_final_graphic
+};
+
+@ Let's consider the types of graphical objects one at a time.
+First of all, a filled contour is represented by a eight-word node.  The first
+word contains |type| and |link| fields, and the next six words contain a
+pointer to a cyclic path and the value to use for \ps' \&{currentrgbcolor}
+parameter.  If a pen is used for filling |pen_p|, |ljoin_val| and |miterlim_val|
+give the relevant information.
+
+@d path_p(A) link((A)+1)
+  /* a pointer to the path that needs filling */
+@d pen_p(A) info((A)+1)
+  /* a pointer to the pen to fill or stroke with */
+@d color_model(A) type((A)+2) /*  the color model  */
+@d obj_red_loc(A) ((A)+3)  /* the first of three locations for the color */
+@d obj_cyan_loc obj_red_loc  /* the first of four locations for the color */
+@d obj_grey_loc obj_red_loc  /* the location for the color */
+@d red_val(A) mp->mem[(A)+3].sc
+  /* the red component of the color in the range $0\ldots1$ */
+@d cyan_val red_val
+@d grey_val red_val
+@d green_val(A) mp->mem[(A)+4].sc
+  /* the green component of the color in the range $0\ldots1$ */
+@d magenta_val green_val
+@d blue_val(A) mp->mem[(A)+5].sc
+  /* the blue component of the color in the range $0\ldots1$ */
+@d yellow_val blue_val
+@d black_val(A) mp->mem[(A)+6].sc
+  /* the blue component of the color in the range $0\ldots1$ */
+@d ljoin_val(A) name_type((A))  /* the value of \&{linejoin} */
+@:mp_linejoin_}{\&{linejoin} primitive@>
+@d miterlim_val(A) mp->mem[(A)+7].sc  /* the value of \&{miterlimit} */
+@:mp_miterlimit_}{\&{miterlimit} primitive@>
+@d obj_color_part(A) mp->mem[(A)+3-red_part].sc
+  /* interpret an object pointer that has been offset by |red_part..blue_part| */
+@d pre_script(A) mp->mem[(A)+8].hh.lh
+@d post_script(A) mp->mem[(A)+8].hh.rh
+@d fill_node_size 9
+
+@ @<Graphical object codes@>=
+mp_fill_code=1,
+
+@ @c 
+pointer mp_new_fill_node (MP mp,pointer p) {
+  /* make a fill node for cyclic path |p| and color black */
+  pointer t; /* the new node */
+  t=mp_get_node(mp, fill_node_size);
+  type(t)=mp_fill_code;
+  path_p(t)=p;
+  pen_p(t)=null; /* |null| means don't use a pen */
+  red_val(t)=0;
+  green_val(t)=0;
+  blue_val(t)=0;
+  black_val(t)=0;
+  color_model(t)=mp_uninitialized_model;
+  pre_script(t)=null;
+  post_script(t)=null;
+  @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>;
+  return t;
+}
+
+@ @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>=
+if ( mp->internal[mp_linejoin]>unity ) ljoin_val(t)=2;
+else if ( mp->internal[mp_linejoin]>0 ) ljoin_val(t)=1;
+else ljoin_val(t)=0;
+if ( mp->internal[mp_miterlimit]<unity )
+  miterlim_val(t)=unity;
+else
+  miterlim_val(t)=mp->internal[mp_miterlimit]
+
+@ A stroked path is represented by an eight-word node that is like a filled
+contour node except that it contains the current \&{linecap} value, a scale
+factor for the dash pattern, and a pointer that is non-null if the stroke
+is to be dashed.  The purpose of the scale factor is to allow a picture to
+be transformed without touching the picture that |dash_p| points to.
+
+@d dash_p(A) link((A)+9)
+  /* a pointer to the edge structure that gives the dash pattern */
+@d lcap_val(A) type((A)+9)
+  /* the value of \&{linecap} */
+@:mp_linecap_}{\&{linecap} primitive@>
+@d dash_scale(A) mp->mem[(A)+10].sc /* dash lengths are scaled by this factor */
+@d stroked_node_size 11
+
+@ @<Graphical object codes@>=
+mp_stroked_code=2,
+
+@ @c 
+pointer mp_new_stroked_node (MP mp,pointer p) {
+  /* make a stroked node for path |p| with |pen_p(p)| temporarily |null| */
+  pointer t; /* the new node */
+  t=mp_get_node(mp, stroked_node_size);
+  type(t)=mp_stroked_code;
+  path_p(t)=p; pen_p(t)=null;
+  dash_p(t)=null;
+  dash_scale(t)=unity;
+  red_val(t)=0;
+  green_val(t)=0;
+  blue_val(t)=0;
+  black_val(t)=0;
+  color_model(t)=mp_uninitialized_model;
+  pre_script(t)=null;
+  post_script(t)=null;
+  @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>;
+  if ( mp->internal[mp_linecap]>unity ) lcap_val(t)=2;
+  else if ( mp->internal[mp_linecap]>0 ) lcap_val(t)=1;
+  else lcap_val(t)=0;
+  return t;
+}
+
+@ When a dashed line is computed in a transformed coordinate system, the dash
+lengths get scaled like the pen shape and we need to compensate for this.  Since
+there is no unique scale factor for an arbitrary transformation, we use the
+the square root of the determinant.  The properties of the determinant make it
+easier to maintain the |dash_scale|.  The computation is fairly straight-forward
+except for the initialization of the scale factor |s|.  The factor of 64 is
+needed because |square_rt| scales its result by $2^8$ while we need $2^{14}$
+to counteract the effect of |take_fraction|.
+
+@<Declare subroutines needed by |print_edges|@>=
+scaled mp_sqrt_det (MP mp,scaled a, scaled b, scaled c, scaled d) {
+  scaled maxabs; /* $max(|a|,|b|,|c|,|d|)$ */
+  integer s; /* amount by which the result of |square_rt| needs to be scaled */
+  @<Initialize |maxabs|@>;
+  s=64;
+  while ( (maxabs<fraction_one) && (s>1) ){ 
+    a+=a; b+=b; c+=c; d+=d;
+    maxabs+=maxabs; s=halfp(s);
+  }
+  return s*mp_square_rt(mp, abs(mp_take_fraction(mp, a,d)-mp_take_fraction(mp, b,c)));
+}
+@#
+scaled mp_get_pen_scale (MP mp,pointer p) { 
+  return mp_sqrt_det(mp, 
+    left_x(p)-x_coord(p), right_x(p)-x_coord(p),
+    left_y(p)-y_coord(p), right_y(p)-y_coord(p));
+}
+
+@ @<Internal library ...@>=
+scaled mp_sqrt_det (MP mp,scaled a, scaled b, scaled c, scaled d) ;
+
+
+@ @<Initialize |maxabs|@>=
+maxabs=abs(a);
+if ( abs(b)>maxabs ) maxabs=abs(b);
+if ( abs(c)>maxabs ) maxabs=abs(c);
+if ( abs(d)>maxabs ) maxabs=abs(d)
+
+@ When a picture contains text, this is represented by a fourteen-word node
+where the color information and |type| and |link| fields are augmented by
+additional fields that describe the text and  how it is transformed.
+The |path_p| and |pen_p| pointers are replaced by a number that identifies
+the font and a string number that gives the text to be displayed.
+The |width|, |height|, and |depth| fields
+give the dimensions of the text at its design size, and the remaining six
+words give a transformation to be applied to the text.  The |new_text_node|
+function initializes everything to default values so that the text comes out
+black with its reference point at the origin.
+
+@d text_p(A) link((A)+1)  /* a string pointer for the text to display */
+@d font_n(A) info((A)+1)  /* the font number */
+@d width_val(A) mp->mem[(A)+7].sc  /* unscaled width of the text */
+@d height_val(A) mp->mem[(A)+9].sc  /* unscaled height of the text */
+@d depth_val(A) mp->mem[(A)+10].sc  /* unscaled depth of the text */
+@d text_tx_loc(A) ((A)+11)
+  /* the first of six locations for transformation parameters */
+@d tx_val(A) mp->mem[(A)+11].sc  /* $x$ shift amount */
+@d ty_val(A) mp->mem[(A)+12].sc  /* $y$ shift amount */
+@d txx_val(A) mp->mem[(A)+13].sc  /* |txx| transformation parameter */
+@d txy_val(A) mp->mem[(A)+14].sc  /* |txy| transformation parameter */
+@d tyx_val(A) mp->mem[(A)+15].sc  /* |tyx| transformation parameter */
+@d tyy_val(A) mp->mem[(A)+16].sc  /* |tyy| transformation parameter */
+@d text_trans_part(A) mp->mem[(A)+11-x_part].sc
+    /* interpret a text node pointer that has been offset by |x_part..yy_part| */
+@d text_node_size 17
+
+@ @<Graphical object codes@>=
+mp_text_code=3,
+
+@ @c @<Declare text measuring subroutines@>
+pointer mp_new_text_node (MP mp,char *f,str_number s) {
+  /* make a text node for font |f| and text string |s| */
+  pointer t; /* the new node */
+  t=mp_get_node(mp, text_node_size);
+  type(t)=mp_text_code;
+  text_p(t)=s;
+  font_n(t)=mp_find_font(mp, f); /* this identifies the font */
+  red_val(t)=0;
+  green_val(t)=0;
+  blue_val(t)=0;
+  black_val(t)=0;
+  color_model(t)=mp_uninitialized_model;
+  pre_script(t)=null;
+  post_script(t)=null;
+  tx_val(t)=0; ty_val(t)=0;
+  txx_val(t)=unity; txy_val(t)=0;
+  tyx_val(t)=0; tyy_val(t)=unity;
+  mp_set_text_box(mp, t); /* this finds the bounding box */
+  return t;
+}
+
+@ The last two types of graphical objects that can occur in an edge structure
+are clipping paths and \&{setbounds} paths.  These are slightly more difficult
+@:set_bounds_}{\&{setbounds} primitive@>
+to implement because we must keep track of exactly what is being clipped or
+bounded when pictures get merged together.  For this reason, each clipping or
+\&{setbounds} operation is represented by a pair of nodes:  first comes a
+two-word node whose |path_p| gives the relevant path, then there is the list
+of objects to clip or bound followed by a two-word node whose second word is
+unused.
+
+Using at least two words for each graphical object node allows them all to be
+allocated and deallocated similarly with a global array |gr_object_size| to
+give the size in words for each object type.
+
+@d start_clip_size 2
+@d start_bounds_size 2
+@d stop_clip_size 2 /* the second word is not used here */
+@d stop_bounds_size 2 /* the second word is not used here */
+@#
+@d stop_type(A) ((A)+2)
+  /* matching |type| for |start_clip_code| or |start_bounds_code| */
+@d has_color(A) (type((A))<mp_start_clip_code)
+  /* does a graphical object have color fields? */
+@d has_pen(A) (type((A))<mp_text_code)
+  /* does a graphical object have a |pen_p| field? */
+@d is_start_or_stop(A) (type((A))>=mp_start_clip_code)
+@d is_stop(A) (type((A))>=mp_stop_clip_code)
+
+@ @<Graphical object codes@>=
+mp_start_clip_code=4, /* |type| of a node that starts clipping */
+mp_start_bounds_code=5, /* |type| of a node that gives a \&{setbounds} path */
+mp_stop_clip_code=6, /* |type| of a node that stops clipping */
+mp_stop_bounds_code=7, /* |type| of a node that stops \&{setbounds} */
+
+@ @c 
+pointer mp_new_bounds_node (MP mp,pointer p, small_number  c) {
+  /* make a node of type |c| where |p| is the clipping or \&{setbounds} path */
+  pointer t; /* the new node */
+  t=mp_get_node(mp, mp->gr_object_size[c]);
+  type(t)=c;
+  path_p(t)=p;
+  return t;
+}
+
+@ We need an array to keep track of the sizes of graphical objects.
+
+@<Glob...@>=
+small_number gr_object_size[mp_stop_bounds_code+1];
+
+@ @<Set init...@>=
+mp->gr_object_size[mp_fill_code]=fill_node_size;
+mp->gr_object_size[mp_stroked_code]=stroked_node_size;
+mp->gr_object_size[mp_text_code]=text_node_size;
+mp->gr_object_size[mp_start_clip_code]=start_clip_size;
+mp->gr_object_size[mp_stop_clip_code]=stop_clip_size;
+mp->gr_object_size[mp_start_bounds_code]=start_bounds_size;
+mp->gr_object_size[mp_stop_bounds_code]=stop_bounds_size;
+
+@ All the essential information in an edge structure is encoded as a linked list
+of graphical objects as we have just seen, but it is helpful to add some
+redundant information.  A single edge structure might be used as a dash pattern
+many times, and it would be nice to avoid scanning the same structure
+repeatedly.  Thus, an edge structure known to be a suitable dash pattern
+has a header that gives a list of dashes in a sorted order designed for rapid
+translation into \ps.
+
+Each dash is represented by a three-word node containing the initial and final
+$x$~coordinates as well as the usual |link| field.  The |link| fields points to
+the dash node with the next higher $x$-coordinates and the final link points
+to a special location called |null_dash|.  (There should be no overlap between
+dashes).  Since the $y$~coordinate of the dash pattern is needed to determine
+the period of repetition, this needs to be stored in the edge header along
+with a pointer to the list of dash nodes.
+
+@d start_x(A) mp->mem[(A)+1].sc  /* the starting $x$~coordinate in a dash node */
+@d stop_x(A) mp->mem[(A)+2].sc  /* the ending $x$~coordinate in a dash node */
+@d dash_node_size 3
+@d dash_list link
+  /* in an edge header this points to the first dash node */
+@d dash_y(A) mp->mem[(A)+1].sc  /* $y$ value for the dash list in an edge header */
+
+@ It is also convenient for an edge header to contain the bounding
+box information needed by the \&{llcorner} and \&{urcorner} operators
+so that this does not have to be recomputed unnecessarily.  This is done by
+adding fields for the $x$~and $y$ extremes as well as a pointer that indicates
+how far the bounding box computation has gotten.  Thus if the user asks for
+the bounding box and then adds some more text to the picture before asking
+for more bounding box information, the second computation need only look at
+the additional text.
+
+When the bounding box has not been computed, the |bblast| pointer points
+to a dummy link at the head of the graphical object list while the |minx_val|
+and |miny_val| fields contain |el_gordo| and the |maxx_val| and |maxy_val|
+fields contain |-el_gordo|.
+
+Since the bounding box of pictures containing objects of type
+|mp_start_bounds_code| depends on the value of \&{truecorners}, the bounding box
+@:mp_true_corners_}{\&{truecorners} primitive@>
+data might not be valid for all values of this parameter.  Hence, the |bbtype|
+field is needed to keep track of this.
+
+@d minx_val(A) mp->mem[(A)+2].sc
+@d miny_val(A) mp->mem[(A)+3].sc
+@d maxx_val(A) mp->mem[(A)+4].sc
+@d maxy_val(A) mp->mem[(A)+5].sc
+@d bblast(A) link((A)+6)  /* last item considered in bounding box computation */
+@d bbtype(A) info((A)+6)  /* tells how bounding box data depends on \&{truecorners} */
+@d dummy_loc(A) ((A)+7)  /* where the object list begins in an edge header */
+@d no_bounds 0
+  /* |bbtype| value when bounding box data is valid for all \&{truecorners} values */
+@d bounds_set 1
+  /* |bbtype| value when bounding box data is for \&{truecorners}${}\le 0$ */
+@d bounds_unset 2
+  /* |bbtype| value when bounding box data is for \&{truecorners}${}>0$ */
+
+@c 
+void mp_init_bbox (MP mp,pointer h) {
+  /* Initialize the bounding box information in edge structure |h| */
+  bblast(h)=dummy_loc(h);
+  bbtype(h)=no_bounds;
+  minx_val(h)=el_gordo;
+  miny_val(h)=el_gordo;
+  maxx_val(h)=-el_gordo;
+  maxy_val(h)=-el_gordo;
+}
+
+@ The only other entries in an edge header are a reference count in the first
+word and a pointer to the tail of the object list in the last word.
+
+@d obj_tail(A) info((A)+7)  /* points to the last entry in the object list */
+@d edge_header_size 8
+
+@c 
+void mp_init_edges (MP mp,pointer h) {
+  /* initialize an edge header to null values */
+  dash_list(h)=null_dash;
+  obj_tail(h)=dummy_loc(h);
+  link(dummy_loc(h))=null;
+  ref_count(h)=null;
+  mp_init_bbox(mp, h);
+}
+
+@ Here is how edge structures are deleted.  The process can be recursive because
+of the need to dereference edge structures that are used as dash patterns.
+@^recursion@>
+
+@d add_edge_ref(A) incr(ref_count(A))
+@d delete_edge_ref(A) { 
+   if ( ref_count((A))==null ) 
+     mp_toss_edges(mp, A);
+   else 
+     decr(ref_count(A)); 
+   }
+
+@<Declare the recycling subroutines@>=
+void mp_flush_dash_list (MP mp,pointer h);
+pointer mp_toss_gr_object (MP mp,pointer p) ;
+void mp_toss_edges (MP mp,pointer h) ;
+
+@ @c void mp_toss_edges (MP mp,pointer h) {
+  pointer p,q;  /* pointers that scan the list being recycled */
+  pointer r; /* an edge structure that object |p| refers to */
+  mp_flush_dash_list(mp, h);
+  q=link(dummy_loc(h));
+  while ( (q!=null) ) { 
+    p=q; q=link(q);
+    r=mp_toss_gr_object(mp, p);
+    if ( r!=null ) delete_edge_ref(r);
+  }
+  mp_free_node(mp, h,edge_header_size);
+}
+void mp_flush_dash_list (MP mp,pointer h) {
+  pointer p,q;  /* pointers that scan the list being recycled */
+  q=dash_list(h);
+  while ( q!=null_dash ) { 
+    p=q; q=link(q);
+    mp_free_node(mp, p,dash_node_size);
+  }
+  dash_list(h)=null_dash;
+}
+pointer mp_toss_gr_object (MP mp,pointer p) {
+  /* returns an edge structure that needs to be dereferenced */
+  pointer e; /* the edge structure to return */
+  e=null;
+  @<Prepare to recycle graphical object |p|@>;
+  mp_free_node(mp, p,mp->gr_object_size[type(p)]);
+  return e;
+}
+
+@ @<Prepare to recycle graphical object |p|@>=
+switch (type(p)) {
+case mp_fill_code: 
+  mp_toss_knot_list(mp, path_p(p));
+  if ( pen_p(p)!=null ) mp_toss_knot_list(mp, pen_p(p));
+  if ( pre_script(p)!=null ) delete_str_ref(pre_script(p));
+  if ( post_script(p)!=null ) delete_str_ref(post_script(p));
+  break;
+case mp_stroked_code: 
+  mp_toss_knot_list(mp, path_p(p));
+  if ( pen_p(p)!=null ) mp_toss_knot_list(mp, pen_p(p));
+  if ( pre_script(p)!=null ) delete_str_ref(pre_script(p));
+  if ( post_script(p)!=null ) delete_str_ref(post_script(p));
+  e=dash_p(p);
+  break;
+case mp_text_code: 
+  delete_str_ref(text_p(p));
+  if ( pre_script(p)!=null ) delete_str_ref(pre_script(p));
+  if ( post_script(p)!=null ) delete_str_ref(post_script(p));
+  break;
+case mp_start_clip_code:
+case mp_start_bounds_code: 
+  mp_toss_knot_list(mp, path_p(p));
+  break;
+case mp_stop_clip_code:
+case mp_stop_bounds_code: 
+  break;
+} /* there are no other cases */
+
+@ If we use |add_edge_ref| to ``copy'' edge structures, the real copying needs
+to be done before making a significant change to an edge structure.  Much of
+the work is done in a separate routine |copy_objects| that copies a list of
+graphical objects into a new edge header.
+
+@c @<Declare a function called |copy_objects|@>
+pointer mp_private_edges (MP mp,pointer h) {
+  /* make a private copy of the edge structure headed by |h| */
+  pointer hh;  /* the edge header for the new copy */
+  pointer p,pp;  /* pointers for copying the dash list */
+  if ( ref_count(h)==null ) {
+    return h;
+  } else { 
+    decr(ref_count(h));
+    hh=mp_copy_objects(mp, link(dummy_loc(h)),null);
+    @<Copy the dash list from |h| to |hh|@>;
+    @<Copy the bounding box information from |h| to |hh| and make |bblast(hh)|
+      point into the new object list@>;
+    return hh;
+  }
+}
+
+@ Here we use the fact that |dash_list(hh)=link(hh)|.
+@^data structure assumptions@>
+
+@<Copy the dash list from |h| to |hh|@>=
+pp=hh; p=dash_list(h);
+while ( (p!=null_dash) ) { 
+  link(pp)=mp_get_node(mp, dash_node_size);
+  pp=link(pp);
+  start_x(pp)=start_x(p);
+  stop_x(pp)=stop_x(p);
+  p=link(p);
+}
+link(pp)=null_dash;
+dash_y(hh)=dash_y(h)
+
+
+@ |h| is an edge structure
+
+@c
+mp_dash_object *mp_export_dashes (MP mp, pointer h) {
+  mp_dash_object *d;
+  pointer p;
+  scaled *dashes = NULL;
+  int num_dashes = 1;
+  if (h==null ||  dash_list(h)==null_dash) 
+	return NULL;
+  p = dash_list(h);
+  d = mp_xmalloc(mp,1,sizeof(mp_dash_object));
+  start_x(null_dash)=start_x(p)+dash_y(h);
+  while (p != null_dash) { 
+	dashes = mp_xrealloc(mp, dashes, num_dashes+2, sizeof(scaled));
+	dashes[(num_dashes-1)] = (stop_x(p)-start_x(p));
+	dashes[(num_dashes)]   = (start_x(link(p))-stop_x(p));
+	dashes[(num_dashes+1)] = -1; /* terminus */
+	num_dashes+=2;
+    p=link(p);
+  }
+  d->array_field  = dashes;
+  d->offset_field = mp_dash_offset(mp, h);
+  d->scale_field  = dash_scale(h);
+  return d;
+}
+
+
+
+@ @<Copy the bounding box information from |h| to |hh|...@>=
+minx_val(hh)=minx_val(h);
+miny_val(hh)=miny_val(h);
+maxx_val(hh)=maxx_val(h);
+maxy_val(hh)=maxy_val(h);
+bbtype(hh)=bbtype(h);
+p=dummy_loc(h); pp=dummy_loc(hh);
+while ((p!=bblast(h)) ) { 
+  if ( p==null ) mp_confusion(mp, "bblast");
+@:this can't happen bblast}{\quad bblast@>
+  p=link(p); pp=link(pp);
+}
+bblast(hh)=pp
+
+@ Here is the promised routine for copying graphical objects into a new edge
+structure.  It starts copying at object~|p| and stops just before object~|q|.
+If |q| is null, it copies the entire sublist headed at |p|.  The resulting edge
+structure requires further initialization by |init_bbox|.
+
+@<Declare a function called |copy_objects|@>=
+pointer mp_copy_objects (MP mp, pointer p, pointer q) {
+  pointer hh;  /* the new edge header */
+  pointer pp;  /* the last newly copied object */
+  small_number k;  /* temporary register */
+  hh=mp_get_node(mp, edge_header_size);
+  dash_list(hh)=null_dash;
+  ref_count(hh)=null;
+  pp=dummy_loc(hh);
+  while ( (p!=q) ) {
+    @<Make |link(pp)| point to a copy of object |p|, and update |p| and |pp|@>;
+  }
+  obj_tail(hh)=pp;
+  link(pp)=null;
+  return hh;
+}
+
+@ @<Make |link(pp)| point to a copy of object |p|, and update |p| and |pp|@>=
+{ k=mp->gr_object_size[type(p)];
+  link(pp)=mp_get_node(mp, k);
+  pp=link(pp);
+  while ( (k>0) ) { decr(k); mp->mem[pp+k]=mp->mem[p+k];  };
+  @<Fix anything in graphical object |pp| that should differ from the
+    corresponding field in |p|@>;
+  p=link(p);
+}
+
+@ @<Fix anything in graphical object |pp| that should differ from the...@>=
+if ( pre_script(p)!=null )  add_str_ref(pre_script(p));
+if ( post_script(p)!=null ) add_str_ref(post_script(p));
+switch (type(p)) {
+case mp_start_clip_code:
+case mp_start_bounds_code: 
+  path_p(pp)=mp_copy_path(mp, path_p(p));
+  break;
+case mp_fill_code: 
+  path_p(pp)=mp_copy_path(mp, path_p(p));
+  if ( pen_p(p)!=null ) pen_p(pp)=copy_pen(pen_p(p));
+  break;
+case mp_stroked_code: 
+  path_p(pp)=mp_copy_path(mp, path_p(p));
+  pen_p(pp)=copy_pen(pen_p(p));
+  if ( dash_p(p)!=null ) add_edge_ref(dash_p(pp));
+  break;
+case mp_text_code: 
+  add_str_ref(text_p(pp));
+  break;
+case mp_stop_clip_code:
+case mp_stop_bounds_code: 
+  break;
+}  /* there are no other cases */
+
+@ Here is one way to find an acceptable value for the second argument to
+|copy_objects|.  Given a non-null graphical object list, |skip_1component|
+skips past one picture component, where a ``picture component'' is a single
+graphical object, or a start bounds or start clip object and everything up
+through the matching stop bounds or stop clip object.  The macro version avoids
+procedure call overhead and error handling: |skip_component(p)(e)| advances |p|
+unless |p| points to a stop bounds or stop clip node, in which case it executes
+|e| instead.
+
+@d skip_component(A)
+    if ( ! is_start_or_stop((A)) ) (A)=link((A));
+    else if ( ! is_stop((A)) ) (A)=mp_skip_1component(mp, (A));
+    else 
+
+@c 
+pointer mp_skip_1component (MP mp,pointer p) {
+  integer lev; /* current nesting level */
+  lev=0;
+  do {  
+   if ( is_start_or_stop(p) ) {
+     if ( is_stop(p) ) decr(lev);  else incr(lev);
+   }
+   p=link(p);
+  } while (lev!=0);
+  return p;
+}
+
+@ Here is a diagnostic routine for printing an edge structure in symbolic form.
+
+@<Declare subroutines for printing expressions@>=
+@<Declare subroutines needed by |print_edges|@>
+void mp_print_edges (MP mp,pointer h, const char *s, boolean nuline) {
+  pointer p;  /* a graphical object to be printed */
+  pointer hh,pp;  /* temporary pointers */
+  scaled scf;  /* a scale factor for the dash pattern */
+  boolean ok_to_dash;  /* |false| for polygonal pen strokes */
+  mp_print_diagnostic(mp, "Edge structure",s,nuline);
+  p=dummy_loc(h);
+  while ( link(p)!=null ) { 
+    p=link(p);
+    mp_print_ln(mp);
+    switch (type(p)) {
+      @<Cases for printing graphical object node |p|@>;
+    default: 
+	  mp_print(mp, "[unknown object type!]");
+	  break;
+    }
+  }
+  mp_print_nl(mp, "End edges");
+  if ( p!=obj_tail(h) ) mp_print(mp, "?");
+@.End edges?@>
+  mp_end_diagnostic(mp, true);
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_fill_code: 
+  mp_print(mp, "Filled contour ");
+  mp_print_obj_color(mp, p);
+  mp_print_char(mp, ':'); mp_print_ln(mp);
+  mp_pr_path(mp, path_p(p)); mp_print_ln(mp);
+  if ( (pen_p(p)!=null) ) {
+    @<Print join type for graphical object |p|@>;
+    mp_print(mp, " with pen"); mp_print_ln(mp);
+    mp_pr_pen(mp, pen_p(p));
+  }
+  break;
+
+@ @<Print join type for graphical object |p|@>=
+switch (ljoin_val(p)) {
+case 0:
+  mp_print(mp, "mitered joins limited ");
+  mp_print_scaled(mp, miterlim_val(p));
+  break;
+case 1:
+  mp_print(mp, "round joins");
+  break;
+case 2:
+  mp_print(mp, "beveled joins");
+  break;
+default: 
+  mp_print(mp, "?? joins");
+@.??@>
+  break;
+}
+
+@ For stroked nodes, we need to print |lcap_val(p)| as well.
+
+@<Print join and cap types for stroked node |p|@>=
+switch (lcap_val(p)) {
+case 0:mp_print(mp, "butt"); break;
+case 1:mp_print(mp, "round"); break;
+case 2:mp_print(mp, "square"); break;
+default: mp_print(mp, "??"); break;
+@.??@>
+}
+mp_print(mp, " ends, ");
+@<Print join type for graphical object |p|@>
+
+@ Here is a routine that prints the color of a graphical object if it isn't
+black (the default color).
+
+@<Declare subroutines needed by |print_edges|@>=
+@<Declare a procedure called |print_compact_node|@>
+void mp_print_obj_color (MP mp,pointer p) { 
+  if ( color_model(p)==mp_grey_model ) {
+    if ( grey_val(p)>0 ) { 
+      mp_print(mp, "greyed ");
+      mp_print_compact_node(mp, obj_grey_loc(p),1);
+    };
+  } else if ( color_model(p)==mp_cmyk_model ) {
+    if ( (cyan_val(p)>0) || (magenta_val(p)>0) || 
+         (yellow_val(p)>0) || (black_val(p)>0) ) { 
+      mp_print(mp, "processcolored ");
+      mp_print_compact_node(mp, obj_cyan_loc(p),4);
+    };
+  } else if ( color_model(p)==mp_rgb_model ) {
+    if ( (red_val(p)>0) || (green_val(p)>0) || (blue_val(p)>0) ) { 
+      mp_print(mp, "colored "); 
+      mp_print_compact_node(mp, obj_red_loc(p),3);
+    };
+  }
+}
+
+@ We also need a procedure for printing consecutive scaled values as if they
+were a known big node.
+
+@<Declare a procedure called |print_compact_node|@>=
+void mp_print_compact_node (MP mp,pointer p, small_number k) {
+  pointer q;  /* last location to print */
+  q=p+k-1;
+  mp_print_char(mp, '(');
+  while ( p<=q ){ 
+    mp_print_scaled(mp, mp->mem[p].sc);
+    if ( p<q ) mp_print_char(mp, ',');
+    incr(p);
+  }
+  mp_print_char(mp, ')');
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_stroked_code: 
+  mp_print(mp, "Filled pen stroke ");
+  mp_print_obj_color(mp, p);
+  mp_print_char(mp, ':'); mp_print_ln(mp);
+  mp_pr_path(mp, path_p(p));
+  if ( dash_p(p)!=null ) { 
+    mp_print_nl(mp, "dashed (");
+    @<Finish printing the dash pattern that |p| refers to@>;
+  }
+  mp_print_ln(mp);
+  @<Print join and cap types for stroked node |p|@>;
+  mp_print(mp, " with pen"); mp_print_ln(mp);
+  if ( pen_p(p)==null ) mp_print(mp, "???"); /* shouldn't happen */
+@.???@>
+  else mp_pr_pen(mp, pen_p(p));
+  break;
+
+@ Normally, the  |dash_list| field in an edge header is set to |null_dash|
+when it is not known to define a suitable dash pattern.  This is disallowed
+here because the |dash_p| field should never point to such an edge header.
+Note that memory is allocated for |start_x(null_dash)| and we are free to
+give it any convenient value.
+
+@<Finish printing the dash pattern that |p| refers to@>=
+ok_to_dash=pen_is_elliptical(pen_p(p));
+if ( ! ok_to_dash ) scf=unity; else scf=dash_scale(p);
+hh=dash_p(p);
+pp=dash_list(hh);
+if ( (pp==null_dash) || (dash_y(hh)<0) ) {
+  mp_print(mp, " ??");
+} else { start_x(null_dash)=start_x(pp)+dash_y(hh);
+  while ( pp!=null_dash ) { 
+    mp_print(mp, "on ");
+    mp_print_scaled(mp, mp_take_scaled(mp, stop_x(pp)-start_x(pp),scf));
+    mp_print(mp, " off ");
+    mp_print_scaled(mp, mp_take_scaled(mp, start_x(link(pp))-stop_x(pp),scf));
+    pp = link(pp);
+    if ( pp!=null_dash ) mp_print_char(mp, ' ');
+  }
+  mp_print(mp, ") shifted ");
+  mp_print_scaled(mp, -mp_take_scaled(mp, mp_dash_offset(mp, hh),scf));
+  if ( ! ok_to_dash || (dash_y(hh)==0) ) mp_print(mp, " (this will be ignored)");
+}
+
+@ @<Declare subroutines needed by |print_edges|@>=
+scaled mp_dash_offset (MP mp,pointer h) {
+  scaled x;  /* the answer */
+  if (dash_list(h)==null_dash || dash_y(h)<0) mp_confusion(mp, "dash0");
+@:this can't happen dash0}{\quad dash0@>
+  if ( dash_y(h)==0 ) {
+    x=0; 
+  } else { 
+    x=-(start_x(dash_list(h)) % dash_y(h));
+    if ( x<0 ) x=x+dash_y(h);
+  }
+  return x;
+}
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_text_code: 
+  mp_print_char(mp, '"'); mp_print_str(mp,text_p(p));
+  mp_print(mp, "\" infont \""); mp_print(mp, mp->font_name[font_n(p)]);
+  mp_print_char(mp, '"'); mp_print_ln(mp);
+  mp_print_obj_color(mp, p);
+  mp_print(mp, "transformed ");
+  mp_print_compact_node(mp, text_tx_loc(p),6);
+  break;
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_start_clip_code: 
+  mp_print(mp, "clipping path:");
+  mp_print_ln(mp);
+  mp_pr_path(mp, path_p(p));
+  break;
+case mp_stop_clip_code: 
+  mp_print(mp, "stop clipping");
+  break;
+
+@ @<Cases for printing graphical object node |p|@>=
+case mp_start_bounds_code: 
+  mp_print(mp, "setbounds path:");
+  mp_print_ln(mp);
+  mp_pr_path(mp, path_p(p));
+  break;
+case mp_stop_bounds_code: 
+  mp_print(mp, "end of setbounds");
+  break;
+
+@ To initialize the |dash_list| field in an edge header~|h|, we need a
+subroutine that scans an edge structure and tries to interpret it as a dash
+pattern.  This can only be done when there are no filled regions or clipping
+paths and all the pen strokes have the same color.  The first step is to let
+$y_0$ be the initial $y$~coordinate of the first pen stroke.  Then we implicitly
+project all the pen stroke paths onto the line $y=y_0$ and require that there
+be no retracing.  If the resulting paths cover a range of $x$~coordinates of
+length $\Delta x$, we set |dash_y(h)| to the length of the dash pattern by
+finding the maximum of $\Delta x$ and the absolute value of~$y_0$.
+
+@c @<Declare a procedure called |x_retrace_error|@>
+pointer mp_make_dashes (MP mp,pointer h) { /* returns |h| or |null| */
+  pointer p;  /* this scans the stroked nodes in the object list */
+  pointer p0;  /* if not |null| this points to the first stroked node */
+  pointer pp,qq,rr;  /* pointers into |path_p(p)| */
+  pointer d,dd;  /* pointers used to create the dash list */
+  scaled y0;
+  @<Other local variables in |make_dashes|@>;
+  y0=0;  /* the initial $y$ coordinate */
+  if ( dash_list(h)!=null_dash ) 
+	return h;
+  p0=null;
+  p=link(dummy_loc(h));
+  while ( p!=null ) { 
+    if ( type(p)!=mp_stroked_code ) {
+      @<Compain that the edge structure contains a node of the wrong type
+        and |goto not_found|@>;
+    }
+    pp=path_p(p);
+    if ( p0==null ){ p0=p; y0=y_coord(pp);  };
+    @<Make |d| point to a new dash node created from stroke |p| and path |pp|
+      or |goto not_found| if there is an error@>;
+    @<Insert |d| into the dash list and |goto not_found| if there is an error@>;
+    p=link(p);
+  }
+  if ( dash_list(h)==null_dash ) 
+    goto NOT_FOUND; /* No error message */
+  @<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>;
+  @<Set |dash_y(h)| and merge the first and last dashes if necessary@>;
+  return h;
+NOT_FOUND: 
+  @<Flush the dash list, recycle |h| and return |null|@>;
+}
+
+@ @<Compain that the edge structure contains a node of the wrong type...@>=
+{ 
+print_err("Picture is too complicated to use as a dash pattern");
+help3("When you say `dashed p', picture p should not contain any")
+  ("text, filled regions, or clipping paths.  This time it did")
+  ("so I'll just make it a solid line instead.");
+mp_put_get_error(mp);
+goto NOT_FOUND;
+}
+
+@ A similar error occurs when monotonicity fails.
+
+@<Declare a procedure called |x_retrace_error|@>=
+void mp_x_retrace_error (MP mp) { 
+print_err("Picture is too complicated to use as a dash pattern");
+help3("When you say `dashed p', every path in p should be monotone")
+  ("in x and there must be no overlapping.  This failed")
+  ("so I'll just make it a solid line instead.");
+mp_put_get_error(mp);
+}
+
+@ We stash |p| in |info(d)| if |dash_p(p)<>0| so that subsequent processing can
+handle the case where the pen stroke |p| is itself dashed.
+
+@<Make |d| point to a new dash node created from stroke |p| and path...@>=
+@<Make sure |p| and |p0| are the same color and |goto not_found| if there is
+  an error@>;
+rr=pp;
+if ( link(pp)!=pp ) {
+  do {  
+    qq=rr; rr=link(rr);
+    @<Check for retracing between knots |qq| and |rr| and |goto not_found|
+      if there is a problem@>;
+  } while (right_type(rr)!=mp_endpoint);
+}
+d=mp_get_node(mp, dash_node_size);
+if ( dash_p(p)==0 ) info(d)=0;  else info(d)=p;
+if ( x_coord(pp)<x_coord(rr) ) { 
+  start_x(d)=x_coord(pp);
+  stop_x(d)=x_coord(rr);
+} else { 
+  start_x(d)=x_coord(rr);
+  stop_x(d)=x_coord(pp);
+}
+
+@ We also need to check for the case where the segment from |qq| to |rr| is
+monotone in $x$ but is reversed relative to the path from |pp| to |qq|.
+
+@<Check for retracing between knots |qq| and |rr| and |goto not_found|...@>=
+x0=x_coord(qq);
+x1=right_x(qq);
+x2=left_x(rr);
+x3=x_coord(rr);
+if ( (x0>x1) || (x1>x2) || (x2>x3) ) {
+  if ( (x0<x1) || (x1<x2) || (x2<x3) ) {
+    if ( mp_ab_vs_cd(mp, x2-x1,x2-x1,x1-x0,x3-x2)>0 ) {
+      mp_x_retrace_error(mp); goto NOT_FOUND;
+    }
+  }
+}
+if ( (x_coord(pp)>x0) || (x0>x3) ) {
+  if ( (x_coord(pp)<x0) || (x0<x3) ) {
+    mp_x_retrace_error(mp); goto NOT_FOUND;
+  }
+}
+
+@ @<Other local variables in |make_dashes|@>=
+  scaled x0,x1,x2,x3;  /* $x$ coordinates of the segment from |qq| to |rr| */
+
+@ @<Make sure |p| and |p0| are the same color and |goto not_found|...@>=
+if ( (red_val(p)!=red_val(p0)) || (black_val(p)!=black_val(p0)) ||
+  (green_val(p)!=green_val(p0)) || (blue_val(p)!=blue_val(p0)) ) {
+  print_err("Picture is too complicated to use as a dash pattern");
+  help3("When you say `dashed p', everything in picture p should")
+    ("be the same color.  I can\'t handle your color changes")
+    ("so I'll just make it a solid line instead.");
+  mp_put_get_error(mp);
+  goto NOT_FOUND;
+}
+
+@ @<Insert |d| into the dash list and |goto not_found| if there is an error@>=
+start_x(null_dash)=stop_x(d);
+dd=h; /* this makes |link(dd)=dash_list(h)| */
+while ( start_x(link(dd))<stop_x(d) )
+  dd=link(dd);
+if ( dd!=h ) {
+  if ( (stop_x(dd)>start_x(d)) )
+    { mp_x_retrace_error(mp); goto NOT_FOUND;  };
+}
+link(d)=link(dd);
+link(dd)=d
+
+@ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>=
+d=dash_list(h);
+while ( (link(d)!=null_dash) )
+  d=link(d);
+dd=dash_list(h);
+dash_y(h)=stop_x(d)-start_x(dd);
+if ( abs(y0)>dash_y(h) ) {
+  dash_y(h)=abs(y0);
+} else if ( d!=dd ) { 
+  dash_list(h)=link(dd);
+  stop_x(d)=stop_x(dd)+dash_y(h);
+  mp_free_node(mp, dd,dash_node_size);
+}
+
+@ We get here when the argument is a null picture or when there is an error.
+Recovering from an error involves making |dash_list(h)| empty to indicate
+that |h| is not known to be a valid dash pattern.  We also dereference |h|
+since it is not being used for the return value.
+
+@<Flush the dash list, recycle |h| and return |null|@>=
+mp_flush_dash_list(mp, h);
+delete_edge_ref(h);
+return null
+
+@ Having carefully saved the dashed stroked nodes in the
+corresponding dash nodes, we must be prepared to break up these dashes into
+smaller dashes.
+
+@<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>=
+d=h;  /* now |link(d)=dash_list(h)| */
+while ( link(d)!=null_dash ) {
+  ds=info(link(d));
+  if ( ds==null ) { 
+    d=link(d);
+  } else {
+    hh=dash_p(ds);
+    hsf=dash_scale(ds);
+    if ( (hh==null) ) mp_confusion(mp, "dash1");
+@:this can't happen dash0}{\quad dash1@>
+    if ( dash_y(hh)==0 ) {
+      d=link(d);
+    } else { 
+      if ( dash_list(hh)==null ) mp_confusion(mp, "dash1");
+@:this can't happen dash0}{\quad dash1@>
+      @<Replace |link(d)| by a dashed version as determined by edge header
+          |hh| and scale factor |ds|@>;
+    }
+  }
+}
+
+@ @<Other local variables in |make_dashes|@>=
+pointer dln;  /* |link(d)| */
+pointer hh;  /* an edge header that tells how to break up |dln| */
+scaled hsf;  /* the dash pattern from |hh| gets scaled by this */
+pointer ds;  /* the stroked node from which |hh| and |hsf| are derived */
+scaled xoff;  /* added to $x$ values in |dash_list(hh)| to match |dln| */
+
+@ @<Replace |link(d)| by a dashed version as determined by edge header...@>=
+dln=link(d);
+dd=dash_list(hh);
+xoff=start_x(dln)-mp_take_scaled(mp, hsf,start_x(dd))-
+        mp_take_scaled(mp, hsf,mp_dash_offset(mp, hh));
+start_x(null_dash)=mp_take_scaled(mp, hsf,start_x(dd))
+                   +mp_take_scaled(mp, hsf,dash_y(hh));
+stop_x(null_dash)=start_x(null_dash);
+@<Advance |dd| until finding the first dash that overlaps |dln| when
+  offset by |xoff|@>;
+while ( start_x(dln)<=stop_x(dln) ) {
+  @<If |dd| has `fallen off the end', back up to the beginning and fix |xoff|@>;
+  @<Insert a dash between |d| and |dln| for the overlap with the offset version
+    of |dd|@>;
+  dd=link(dd);
+  start_x(dln)=xoff+mp_take_scaled(mp, hsf,start_x(dd));
+}
+link(d)=link(dln);
+mp_free_node(mp, dln,dash_node_size)
+
+@ The name of this module is a bit of a lie because we just find the
+first |dd| where |take_scaled (hsf, stop_x(dd))| is large enough to make an
+overlap possible.  It could be that the unoffset version of dash |dln| falls
+in the gap between |dd| and its predecessor.
+
+@<Advance |dd| until finding the first dash that overlaps |dln| when...@>=
+while ( xoff+mp_take_scaled(mp, hsf,stop_x(dd))<start_x(dln) ) {
+  dd=link(dd);
+}
+
+@ @<If |dd| has `fallen off the end', back up to the beginning and fix...@>=
+if ( dd==null_dash ) { 
+  dd=dash_list(hh);
+  xoff=xoff+mp_take_scaled(mp, hsf,dash_y(hh));
+}
+
+@ At this point we already know that
+|start_x(dln)<=xoff+take_scaled(hsf,stop_x(dd))|.
+
+@<Insert a dash between |d| and |dln| for the overlap with the offset...@>=
+if ( (xoff+mp_take_scaled(mp, hsf,start_x(dd)))<=stop_x(dln) ) {
+  link(d)=mp_get_node(mp, dash_node_size);
+  d=link(d);
+  link(d)=dln;
+  if ( start_x(dln)>(xoff+mp_take_scaled(mp, hsf,start_x(dd))))
+    start_x(d)=start_x(dln);
+  else 
+    start_x(d)=xoff+mp_take_scaled(mp, hsf,start_x(dd));
+  if ( stop_x(dln)<(xoff+mp_take_scaled(mp, hsf,stop_x(dd)))) 
+    stop_x(d)=stop_x(dln);
+  else 
+    stop_x(d)=xoff+mp_take_scaled(mp, hsf,stop_x(dd));
+}
+
+@ The next major task is to update the bounding box information in an edge
+header~|h|. This is done via a procedure |adjust_bbox| that enlarges an edge
+header's bounding box to accommodate the box computed by |path_bbox| or
+|pen_bbox|. (This is stored in global variables |minx|, |miny|, |maxx|, and
+|maxy|.)
+
+@c void mp_adjust_bbox (MP mp,pointer h) { 
+  if ( minx<minx_val(h) ) minx_val(h)=minx;
+  if ( miny<miny_val(h) ) miny_val(h)=miny;
+  if ( maxx>maxx_val(h) ) maxx_val(h)=maxx;
+  if ( maxy>maxy_val(h) ) maxy_val(h)=maxy;
+}
+
+@ Here is a special routine for updating the bounding box information in
+edge header~|h| to account for the squared-off ends of a non-cyclic path~|p|
+that is to be stroked with the pen~|pp|.
+
+@c void mp_box_ends (MP mp, pointer p, pointer pp, pointer h) {
+  pointer q;  /* a knot node adjacent to knot |p| */
+  fraction dx,dy;  /* a unit vector in the direction out of the path at~|p| */
+  scaled d;  /* a factor for adjusting the length of |(dx,dy)| */
+  scaled z;  /* a coordinate being tested against the bounding box */
+  scaled xx,yy;  /* the extreme pen vertex in the |(dx,dy)| direction */
+  integer i; /* a loop counter */
+  if ( right_type(p)!=mp_endpoint ) { 
+    q=link(p);
+    while (1) { 
+      @<Make |(dx,dy)| the final direction for the path segment from
+        |q| to~|p|; set~|d|@>;
+      d=mp_pyth_add(mp, dx,dy);
+      if ( d>0 ) { 
+         @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>;
+         for (i=1;i<= 2;i++) { 
+           @<Use |(dx,dy)| to generate a vertex of the square end cap and
+             update the bounding box to accommodate it@>;
+           dx=-dx; dy=-dy; 
+        }
+      }
+      if ( right_type(p)==mp_endpoint ) {
+         return;
+      } else {
+        @<Advance |p| to the end of the path and make |q| the previous knot@>;
+      } 
+    }
+  }
+}
+
+@ @<Make |(dx,dy)| the final direction for the path segment from...@>=
+if ( q==link(p) ) { 
+  dx=x_coord(p)-right_x(p);
+  dy=y_coord(p)-right_y(p);
+  if ( (dx==0)&&(dy==0) ) {
+    dx=x_coord(p)-left_x(q);
+    dy=y_coord(p)-left_y(q);
+  }
+} else { 
+  dx=x_coord(p)-left_x(p);
+  dy=y_coord(p)-left_y(p);
+  if ( (dx==0)&&(dy==0) ) {
+    dx=x_coord(p)-right_x(q);
+    dy=y_coord(p)-right_y(q);
+  }
+}
+dx=x_coord(p)-x_coord(q);
+dy=y_coord(p)-y_coord(q)
+
+@ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>=
+dx=mp_make_fraction(mp, dx,d);
+dy=mp_make_fraction(mp, dy,d);
+mp_find_offset(mp, -dy,dx,pp);
+xx=mp->cur_x; yy=mp->cur_y
+
+@ @<Use |(dx,dy)| to generate a vertex of the square end cap and...@>=
+mp_find_offset(mp, dx,dy,pp);
+d=mp_take_fraction(mp, xx-mp->cur_x,dx)+mp_take_fraction(mp, yy-mp->cur_y,dy);
+if ( ((d<0)&&(i==1)) || ((d>0)&&(i==2))) 
+  mp_confusion(mp, "box_ends");
+@:this can't happen box ends}{\quad\\{box\_ends}@>
+z=x_coord(p)+mp->cur_x+mp_take_fraction(mp, d,dx);
+if ( z<minx_val(h) ) minx_val(h)=z;
+if ( z>maxx_val(h) ) maxx_val(h)=z;
+z=y_coord(p)+mp->cur_y+mp_take_fraction(mp, d,dy);
+if ( z<miny_val(h) ) miny_val(h)=z;
+if ( z>maxy_val(h) ) maxy_val(h)=z
+
+@ @<Advance |p| to the end of the path and make |q| the previous knot@>=
+do {  
+  q=p;
+  p=link(p);
+} while (right_type(p)!=mp_endpoint)
+
+@ The major difficulty in finding the bounding box of an edge structure is the
+effect of clipping paths.  We treat them conservatively by only clipping to the
+clipping path's bounding box, but this still
+requires recursive calls to |set_bbox| in order to find the bounding box of
+@^recursion@>
+the objects to be clipped.  Such calls are distinguished by the fact that the
+boolean parameter |top_level| is false.
+
+@c void mp_set_bbox (MP mp,pointer h, boolean top_level) {
+  pointer p;  /* a graphical object being considered */
+  scaled sminx,sminy,smaxx,smaxy;
+  /* for saving the bounding box during recursive calls */
+  scaled x0,x1,y0,y1;  /* temporary registers */
+  integer lev;  /* nesting level for |mp_start_bounds_code| nodes */
+  @<Wipe out any existing bounding box information if |bbtype(h)| is
+  incompatible with |internal[mp_true_corners]|@>;
+  while ( link(bblast(h))!=null ) { 
+    p=link(bblast(h));
+    bblast(h)=p;
+    switch (type(p)) {
+    case mp_stop_clip_code: 
+      if ( top_level ) mp_confusion(mp, "bbox");  else return;
+@:this can't happen bbox}{\quad bbox@>
+      break;
+    @<Other cases for updating the bounding box based on the type of object |p|@>;
+    } /* all cases are enumerated above */
+  }
+  if ( ! top_level ) mp_confusion(mp, "bbox");
+}
+
+@ @<Internal library declarations@>=
+void mp_set_bbox (MP mp,pointer h, boolean top_level);
+
+@ @<Wipe out any existing bounding box information if |bbtype(h)| is...@>=
+switch (bbtype(h)) {
+case no_bounds: 
+  break;
+case bounds_set: 
+  if ( mp->internal[mp_true_corners]>0 ) mp_init_bbox(mp, h);
+  break;
+case bounds_unset: 
+  if ( mp->internal[mp_true_corners]<=0 ) mp_init_bbox(mp, h);
+  break;
+} /* there are no other cases */
+
+@ @<Other cases for updating the bounding box...@>=
+case mp_fill_code: 
+  mp_path_bbox(mp, path_p(p));
+  if ( pen_p(p)!=null ) { 
+    x0=minx; y0=miny;
+    x1=maxx; y1=maxy;
+    mp_pen_bbox(mp, pen_p(p));
+    minx=minx+x0;
+    miny=miny+y0;
+    maxx=maxx+x1;
+    maxy=maxy+y1;
+  }
+  mp_adjust_bbox(mp, h);
+  break;
+
+@ @<Other cases for updating the bounding box...@>=
+case mp_start_bounds_code: 
+  if ( mp->internal[mp_true_corners]>0 ) {
+    bbtype(h)=bounds_unset;
+  } else { 
+    bbtype(h)=bounds_set;
+    mp_path_bbox(mp, path_p(p));
+    mp_adjust_bbox(mp, h);
+    @<Scan to the matching |mp_stop_bounds_code| node and update |p| and
+      |bblast(h)|@>;
+  }
+  break;
+case mp_stop_bounds_code: 
+  if ( mp->internal[mp_true_corners]<=0 ) mp_confusion(mp, "bbox2");
+@:this can't happen bbox2}{\quad bbox2@>
+  break;
+
+@ @<Scan to the matching |mp_stop_bounds_code| node and update |p| and...@>=
+lev=1;
+while ( lev!=0 ) { 
+  if ( link(p)==null ) mp_confusion(mp, "bbox2");
+@:this can't happen bbox2}{\quad bbox2@>
+  p=link(p);
+  if ( type(p)==mp_start_bounds_code ) incr(lev);
+  else if ( type(p)==mp_stop_bounds_code ) decr(lev);
+}
+bblast(h)=p
+
+@ It saves a lot of grief here to be slightly conservative and not account for
+omitted parts of dashed lines.  We also don't worry about the material omitted
+when using butt end caps.  The basic computation is for round end caps and
+|box_ends| augments it for square end caps.
+
+@<Other cases for updating the bounding box...@>=
+case mp_stroked_code: 
+  mp_path_bbox(mp, path_p(p));
+  x0=minx; y0=miny;
+  x1=maxx; y1=maxy;
+  mp_pen_bbox(mp, pen_p(p));
+  minx=minx+x0;
+  miny=miny+y0;
+  maxx=maxx+x1;
+  maxy=maxy+y1;
+  mp_adjust_bbox(mp, h);
+  if ( (left_type(path_p(p))==mp_endpoint)&&(lcap_val(p)==2) )
+    mp_box_ends(mp, path_p(p), pen_p(p), h);
+  break;
+
+@ The height width and depth information stored in a text node determines a
+rectangle that needs to be transformed according to the transformation
+parameters stored in the text node.
+
+@<Other cases for updating the bounding box...@>=
+case mp_text_code: 
+  x1=mp_take_scaled(mp, txx_val(p),width_val(p));
+  y0=mp_take_scaled(mp, txy_val(p),-depth_val(p));
+  y1=mp_take_scaled(mp, txy_val(p),height_val(p));
+  minx=tx_val(p);
+  maxx=minx;
+  if ( y0<y1 ) { minx=minx+y0; maxx=maxx+y1;  }
+  else         { minx=minx+y1; maxx=maxx+y0;  }
+  if ( x1<0 ) minx=minx+x1;  else maxx=maxx+x1;
+  x1=mp_take_scaled(mp, tyx_val(p),width_val(p));
+  y0=mp_take_scaled(mp, tyy_val(p),-depth_val(p));
+  y1=mp_take_scaled(mp, tyy_val(p),height_val(p));
+  miny=ty_val(p);
+  maxy=miny;
+  if ( y0<y1 ) { miny=miny+y0; maxy=maxy+y1;  }
+  else         { miny=miny+y1; maxy=maxy+y0;  }
+  if ( x1<0 ) miny=miny+x1;  else maxy=maxy+x1;
+  mp_adjust_bbox(mp, h);
+  break;
+
+@ This case involves a recursive call that advances |bblast(h)| to the node of
+type |mp_stop_clip_code| that matches |p|.
+
+@<Other cases for updating the bounding box...@>=
+case mp_start_clip_code: 
+  mp_path_bbox(mp, path_p(p));
+  x0=minx; y0=miny;
+  x1=maxx; y1=maxy;
+  sminx=minx_val(h); sminy=miny_val(h);
+  smaxx=maxx_val(h); smaxy=maxy_val(h);
+  @<Reinitialize the bounding box in header |h| and call |set_bbox| recursively
+    starting at |link(p)|@>;
+  @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|,
+    |y0|, |y1|@>;
+  minx=sminx; miny=sminy;
+  maxx=smaxx; maxy=smaxy;
+  mp_adjust_bbox(mp, h);
+  break;
+
+@ @<Reinitialize the bounding box in header |h| and call |set_bbox|...@>=
+minx_val(h)=el_gordo;
+miny_val(h)=el_gordo;
+maxx_val(h)=-el_gordo;
+maxy_val(h)=-el_gordo;
+mp_set_bbox(mp, h,false)
+
+@ @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|,...@>=
+if ( minx_val(h)<x0 ) minx_val(h)=x0;
+if ( miny_val(h)<y0 ) miny_val(h)=y0;
+if ( maxx_val(h)>x1 ) maxx_val(h)=x1;
+if ( maxy_val(h)>y1 ) maxy_val(h)=y1
+
+@* \[22] Finding an envelope.
+When \MP\ has a path and a polygonal pen, it needs to express the desired
+shape in terms of things \ps\ can understand.  The present task is to compute
+a new path that describes the region to be filled.  It is convenient to
+define this as a two step process where the first step is determining what
+offset to use for each segment of the path.
+
+@ Given a pointer |c| to a cyclic path,
+and a pointer~|h| to the first knot of a pen polygon,
+the |offset_prep| routine changes the path into cubics that are
+associated with particular pen offsets. Thus if the cubic between |p|
+and~|q| is associated with the |k|th offset and the cubic between |q| and~|r|
+has offset |l| then |info(q)=zero_off+l-k|. (The constant |zero_off| is added
+to because |l-k| could be negative.)
+
+After overwriting the type information with offset differences, we no longer
+have a true path so we refer to the knot list returned by |offset_prep| as an
+``envelope spec.''
+@^envelope spec@>
+Since an envelope spec only determines relative changes in pen offsets,
+|offset_prep| sets a global variable |spec_offset| to the relative change from
+|h| to the first offset.
+
+@d zero_off 16384 /* added to offset changes to make them positive */
+
+@<Glob...@>=
+integer spec_offset; /* number of pen edges between |h| and the initial offset */
+
+@ @c @<Declare subroutines needed by |offset_prep|@>
+pointer mp_offset_prep (MP mp,pointer c, pointer h) {
+  halfword n; /* the number of vertices in the pen polygon */
+  pointer p,q,q0,r,w, ww; /* for list manipulation */
+  integer k_needed; /* amount to be added to |info(p)| when it is computed */
+  pointer w0; /* a pointer to pen offset to use just before |p| */
+  scaled dxin,dyin; /* the direction into knot |p| */
+  integer turn_amt; /* change in pen offsets for the current cubic */
+  @<Other local variables for |offset_prep|@>;
+  dx0=0; dy0=0;
+  @<Initialize the pen size~|n|@>;
+  @<Initialize the incoming direction and pen offset at |c|@>;
+  p=c; k_needed=0;
+  do {  
+    q=link(p);
+    @<Split the cubic between |p| and |q|, if necessary, into cubics
+      associated with single offsets, after which |q| should
+      point to the end of the final such cubic@>;
+  NOT_FOUND:
+    @<Advance |p| to node |q|, removing any ``dead'' cubics that
+      might have been introduced by the splitting process@>;
+  } while (q!=c);
+  @<Fix the offset change in |info(c)| and set |c| to the return value of
+    |offset_prep|@>;
+  return c;
+}
+
+@ We shall want to keep track of where certain knots on the cyclic path
+wind up in the envelope spec.  It doesn't suffice just to keep pointers to
+knot nodes because some nodes are deleted while removing dead cubics.  Thus
+|offset_prep| updates the following pointers
+
+@<Glob...@>=
+pointer spec_p1;
+pointer spec_p2; /* pointers to distinguished knots */
+
+@ @<Set init...@>=
+mp->spec_p1=null; mp->spec_p2=null;
+
+@ @<Initialize the pen size~|n|@>=
+n=0; p=h;
+do {  
+  incr(n);
+  p=link(p);
+} while (p!=h)
+
+@ Since the true incoming direction isn't known yet, we just pick a direction
+consistent with the pen offset~|h|.  If this is wrong, it can be corrected
+later.
+
+@<Initialize the incoming direction and pen offset at |c|@>=
+dxin=x_coord(link(h))-x_coord(knil(h));
+dyin=y_coord(link(h))-y_coord(knil(h));
+if ( (dxin==0)&&(dyin==0) ) {
+  dxin=y_coord(knil(h))-y_coord(h);
+  dyin=x_coord(h)-x_coord(knil(h));
+}
+w0=h
+
+@ We must be careful not to remove the only cubic in a cycle.
+
+But we must also be careful for another reason. If the user-supplied
+path starts with a set of degenerate cubics, the target node |q| can
+be collapsed to the initial node |p| which might be the same as the
+initial node |c| of the curve. This would cause the |offset_prep| routine
+to bail out too early, causing distress later on. (See for example
+the testcase reported by Bogus\l{}aw Jackowski in tracker id 267, case 52c
+on Sarovar.)
+
+@<Advance |p| to node |q|, removing any ``dead'' cubics...@>=
+q0=q;
+do { 
+  r=link(p);
+  if ( x_coord(p)==right_x(p) && y_coord(p)==right_y(p) &&
+       x_coord(p)==left_x(r)  && y_coord(p)==left_y(r) &&
+       x_coord(p)==x_coord(r) && y_coord(p)==y_coord(r) &&
+       r!=p ) {
+      @<Remove the cubic following |p| and update the data structures
+        to merge |r| into |p|@>;
+  }
+  p=r;
+} while (p!=q);
+/* Check if we removed too much */
+if(q!=q0)
+  q = link(q)
+
+@ @<Remove the cubic following |p| and update the data structures...@>=
+{ k_needed=info(p)-zero_off;
+  if ( r==q ) { 
+    q=p;
+  } else { 
+    info(p)=k_needed+info(r);
+    k_needed=0;
+  };
+  if ( r==c ) { info(p)=info(c); c=p; };
+  if ( r==mp->spec_p1 ) mp->spec_p1=p;
+  if ( r==mp->spec_p2 ) mp->spec_p2=p;
+  r=p; mp_remove_cubic(mp, p);
+}
+
+@ Not setting the |info| field of the newly created knot allows the splitting
+routine to work for paths.
+
+@<Declare subroutines needed by |offset_prep|@>=
+void mp_split_cubic (MP mp,pointer p, fraction t) { /* splits the cubic after |p| */
+  scaled v; /* an intermediate value */
+  pointer q,r; /* for list manipulation */
+  q=link(p); r=mp_get_node(mp, knot_node_size); link(p)=r; link(r)=q;
+  originator(r)=mp_program_code;
+  left_type(r)=mp_explicit; right_type(r)=mp_explicit;
+  v=t_of_the_way(right_x(p),left_x(q));
+  right_x(p)=t_of_the_way(x_coord(p),right_x(p));
+  left_x(q)=t_of_the_way(left_x(q),x_coord(q));
+  left_x(r)=t_of_the_way(right_x(p),v);
+  right_x(r)=t_of_the_way(v,left_x(q));
+  x_coord(r)=t_of_the_way(left_x(r),right_x(r));
+  v=t_of_the_way(right_y(p),left_y(q));
+  right_y(p)=t_of_the_way(y_coord(p),right_y(p));
+  left_y(q)=t_of_the_way(left_y(q),y_coord(q));
+  left_y(r)=t_of_the_way(right_y(p),v);
+  right_y(r)=t_of_the_way(v,left_y(q));
+  y_coord(r)=t_of_the_way(left_y(r),right_y(r));
+}
+
+@ This does not set |info(p)| or |right_type(p)|.
+
+@<Declare subroutines needed by |offset_prep|@>=
+void mp_remove_cubic (MP mp,pointer p) { /* removes the dead cubic following~|p| */
+  pointer q; /* the node that disappears */
+  q=link(p); link(p)=link(q);
+  right_x(p)=right_x(q); right_y(p)=right_y(q);
+  mp_free_node(mp, q,knot_node_size);
+}
+
+@ Let $d\prec d'$ mean that the counter-clockwise angle from $d$ to~$d'$ is
+strictly between zero and $180^\circ$.  Then we can define $d\preceq d'$ to
+mean that the angle could be zero or $180^\circ$. If $w_k=(u_k,v_k)$ is the
+$k$th pen offset, the $k$th pen edge direction is defined by the formula
+$$d_k=(u\k-u_k,\,v\k-v_k).$$
+When listed by increasing $k$, these directions occur in counter-clockwise
+order so that $d_k\preceq d\k$ for all~$k$.
+The goal of |offset_prep| is to find an offset index~|k| to associate with
+each cubic, such that the direction $d(t)$ of the cubic satisfies
+$$d_{k-1}\preceq d(t)\preceq d_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$
+We may have to split a cubic into many pieces before each
+piece corresponds to a unique offset.
+
+@<Split the cubic between |p| and |q|, if necessary, into cubics...@>=
+info(p)=zero_off+k_needed;
+k_needed=0;
+@<Prepare for derivative computations;
+  |goto not_found| if the current cubic is dead@>;
+@<Find the initial direction |(dx,dy)|@>;
+@<Update |info(p)| and find the offset $w_k$ such that
+  $d_{k-1}\preceq(\\{dx},\\{dy})\prec d_k$; also advance |w0| for
+  the direction change at |p|@>;
+@<Find the final direction |(dxin,dyin)|@>;
+@<Decide on the net change in pen offsets and set |turn_amt|@>;
+@<Complete the offset splitting process@>;
+w0=mp_pen_walk(mp, w0,turn_amt)
+
+@ @<Declare subroutines needed by |offset_prep|@>=
+pointer mp_pen_walk (MP mp,pointer w, integer k) {
+  /* walk |k| steps around a pen from |w| */
+  while ( k>0 ) { w=link(w); decr(k);  };
+  while ( k<0 ) { w=knil(w); incr(k);  };
+  return w;
+}
+
+@ The direction of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
+calculated from the quadratic polynomials
+${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
+${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
+Since we may be calculating directions from several cubics
+split from the current one, it is desirable to do these calculations
+without losing too much precision. ``Scaled up'' values of the
+derivatives, which will be less tainted by accumulated errors than
+derivatives found from the cubics themselves, are maintained in
+local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$,
+$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2|
+represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
+
+@<Other local variables for |offset_prep|@>=
+integer x0,x1,x2,y0,y1,y2; /* representatives of derivatives */
+integer t0,t1,t2; /* coefficients of polynomial for slope testing */
+integer du,dv,dx,dy; /* for directions of the pen and the curve */
+integer dx0,dy0; /* initial direction for the first cubic in the curve */
+integer max_coef; /* used while scaling */
+integer x0a,x1a,x2a,y0a,y1a,y2a; /* intermediate values */
+fraction t; /* where the derivative passes through zero */
+fraction s; /* a temporary value */
+
+@ @<Prepare for derivative computations...@>=
+x0=right_x(p)-x_coord(p);
+x2=x_coord(q)-left_x(q);
+x1=left_x(q)-right_x(p);
+y0=right_y(p)-y_coord(p); y2=y_coord(q)-left_y(q);
+y1=left_y(q)-right_y(p);
+max_coef=abs(x0);
+if ( abs(x1)>max_coef ) max_coef=abs(x1);
+if ( abs(x2)>max_coef ) max_coef=abs(x2);
+if ( abs(y0)>max_coef ) max_coef=abs(y0);
+if ( abs(y1)>max_coef ) max_coef=abs(y1);
+if ( abs(y2)>max_coef ) max_coef=abs(y2);
+if ( max_coef==0 ) goto NOT_FOUND;
+while ( max_coef<fraction_half ) {
+  double(max_coef);
+  double(x0); double(x1); double(x2);
+  double(y0); double(y1); double(y2);
+}
+
+@ Let us first solve a special case of the problem: Suppose we
+know an index~$k$ such that either (i)~$d(t)\succeq d_{k-1}$ for all~$t$
+and $d(0)\prec d_k$, or (ii)~$d(t)\preceq d_k$ for all~$t$ and
+$d(0)\succ d_{k-1}$.
+Then, in a sense, we're halfway done, since one of the two relations
+in $(*)$ is satisfied, and the other couldn't be satisfied for
+any other value of~|k|.
+
+Actually, the conditions can be relaxed somewhat since a relation such as
+$d(t)\succeq d_{k-1}$ restricts $d(t)$ to a half plane when all that really
+matters is whether $d(t)$ crosses the ray in the $d_{k-1}$ direction from
+the origin.  The condition for case~(i) becomes $d_{k-1}\preceq d(0)\prec d_k$
+and $d(t)$ never crosses the $d_{k-1}$ ray in the clockwise direction.
+Case~(ii) is similar except $d(t)$ cannot cross the $d_k$ ray in the
+counterclockwise direction.
+
+The |fin_offset_prep| subroutine solves the stated subproblem.
+It has a parameter called |rise| that is |1| in
+case~(i), |-1| in case~(ii). Parameters |x0| through |y2| represent
+the derivative of the cubic following |p|.
+The |w| parameter should point to offset~$w_k$ and |info(p)| should already
+be set properly.  The |turn_amt| parameter gives the absolute value of the
+overall net change in pen offsets.
+
+@<Declare subroutines needed by |offset_prep|@>=
+void mp_fin_offset_prep (MP mp,pointer p, pointer w, integer 
+  x0,integer x1, integer x2, integer y0, integer y1, integer y2, 
+  integer rise, integer turn_amt)  {
+  pointer ww; /* for list manipulation */
+  scaled du,dv; /* for slope calculation */
+  integer t0,t1,t2; /* test coefficients */
+  fraction t; /* place where the derivative passes a critical slope */
+  fraction s; /* slope or reciprocal slope */
+  integer v; /* intermediate value for updating |x0..y2| */
+  pointer q; /* original |link(p)| */
+  q=link(p);
+  while (1)  { 
+    if ( rise>0 ) ww=link(w); /* a pointer to $w\k$ */
+    else  ww=knil(w); /* a pointer to $w_{k-1}$ */
+    @<Compute test coefficients |(t0,t1,t2)|
+      for $d(t)$ versus $d_k$ or $d_{k-1}$@>;
+    t=mp_crossing_point(mp, t0,t1,t2);
+    if ( t>=fraction_one ) {
+      if ( turn_amt>0 ) t=fraction_one;  else return;
+    }
+    @<Split the cubic at $t$,
+      and split off another cubic if the derivative crosses back@>;
+    w=ww;
+  }
+}
+
+@ We want $B(\\{t0},\\{t1},\\{t2};t)$ to be the dot product of $d(t)$ with a
+$-90^\circ$ rotation of the vector from |w| to |ww|.  This makes the resulting
+function cross from positive to negative when $d_{k-1}\preceq d(t)\preceq d_k$
+begins to fail.
+
+@<Compute test coefficients |(t0,t1,t2)| for $d(t)$ versus...@>=
+du=x_coord(ww)-x_coord(w); dv=y_coord(ww)-y_coord(w);
+if ( abs(du)>=abs(dv) ) {
+  s=mp_make_fraction(mp, dv,du);
+  t0=mp_take_fraction(mp, x0,s)-y0;
+  t1=mp_take_fraction(mp, x1,s)-y1;
+  t2=mp_take_fraction(mp, x2,s)-y2;
+  if ( du<0 ) { negate(t0); negate(t1); negate(t2);  }
+} else { 
+  s=mp_make_fraction(mp, du,dv);
+  t0=x0-mp_take_fraction(mp, y0,s);
+  t1=x1-mp_take_fraction(mp, y1,s);
+  t2=x2-mp_take_fraction(mp, y2,s);
+  if ( dv<0 ) { negate(t0); negate(t1); negate(t2);  }
+}
+if ( t0<0 ) t0=0 /* should be positive without rounding error */
+
+@ The curve has crossed $d_k$ or $d_{k-1}$; its initial segment satisfies
+$(*)$, and it might cross again and return towards $s_{k-1}$ or $s_k$,
+respectively, yielding another solution of $(*)$.
+
+@<Split the cubic at $t$, and split off another...@>=
+{ 
+mp_split_cubic(mp, p,t); p=link(p); info(p)=zero_off+rise;
+decr(turn_amt);
+v=t_of_the_way(x0,x1); x1=t_of_the_way(x1,x2);
+x0=t_of_the_way(v,x1);
+v=t_of_the_way(y0,y1); y1=t_of_the_way(y1,y2);
+y0=t_of_the_way(v,y1);
+if ( turn_amt<0 ) {
+  t1=t_of_the_way(t1,t2);
+  if ( t1>0 ) t1=0; /* without rounding error, |t1| would be |<=0| */
+  t=mp_crossing_point(mp, 0,-t1,-t2);
+  if ( t>fraction_one ) t=fraction_one;
+  incr(turn_amt);
+  if ( (t==fraction_one)&&(link(p)!=q) ) {
+    info(link(p))=info(link(p))-rise;
+  } else { 
+    mp_split_cubic(mp, p,t); info(link(p))=zero_off-rise;
+    v=t_of_the_way(x1,x2); x1=t_of_the_way(x0,x1);
+    x2=t_of_the_way(x1,v);
+    v=t_of_the_way(y1,y2); y1=t_of_the_way(y0,y1);
+    y2=t_of_the_way(y1,v);
+  }
+}
+}
+
+@ Now we must consider the general problem of |offset_prep|, when
+nothing is known about a given cubic. We start by finding its
+direction in the vicinity of |t=0|.
+
+If $z'(t)=0$, the given cubic is numerically unstable but |offset_prep|
+has not yet introduced any more numerical errors.  Thus we can compute
+the true initial direction for the given cubic, even if it is almost
+degenerate.
+
+@<Find the initial direction |(dx,dy)|@>=
+dx=x0; dy=y0;
+if ( dx==0 && dy==0 ) { 
+  dx=x1; dy=y1;
+  if ( dx==0 && dy==0 ) { 
+    dx=x2; dy=y2;
+  }
+}
+if ( p==c ) { dx0=dx; dy0=dy;  }
+
+@ @<Find the final direction |(dxin,dyin)|@>=
+dxin=x2; dyin=y2;
+if ( dxin==0 && dyin==0 ) {
+  dxin=x1; dyin=y1;
+  if ( dxin==0 && dyin==0 ) {
+    dxin=x0; dyin=y0;
+  }
+}
+
+@ The next step is to bracket the initial direction between consecutive
+edges of the pen polygon.  We must be careful to turn clockwise only if
+this makes the turn less than $180^\circ$. (A $180^\circ$ turn must be
+counter-clockwise in order to make \&{doublepath} envelopes come out
+@:double_path_}{\&{doublepath} primitive@>
+right.) This code depends on |w0| being the offset for |(dxin,dyin)|.
+
+@<Update |info(p)| and find the offset $w_k$ such that...@>=
+turn_amt=mp_get_turn_amt(mp,w0,dx,dy,(mp_ab_vs_cd(mp, dy,dxin,dx,dyin)>=0));
+w=mp_pen_walk(mp, w0, turn_amt);
+w0=w;
+info(p)=info(p)+turn_amt
+
+@ Decide how many pen offsets to go away from |w| in order to find the offset
+for |(dx,dy)|, going counterclockwise if |ccw| is |true|.  This assumes that
+|w| is the offset for some direction $(x',y')$ from which the angle to |(dx,dy)|
+in the sense determined by |ccw| is less than or equal to $180^\circ$.
+
+If the pen polygon has only two edges, they could both be parallel
+to |(dx,dy)|.  In this case, we must be careful to stop after crossing the first
+such edge in order to avoid an infinite loop.
+
+@<Declare subroutines needed by |offset_prep|@>=
+integer mp_get_turn_amt (MP mp,pointer w, scaled  dx,
+                         scaled dy, boolean  ccw) {
+  pointer ww; /* a neighbor of knot~|w| */
+  integer s; /* turn amount so far */
+  integer t; /* |ab_vs_cd| result */
+  s=0;
+  if ( ccw ) { 
+    ww=link(w);
+    do {  
+      t=mp_ab_vs_cd(mp, dy,(x_coord(ww)-x_coord(w)),
+                        dx,(y_coord(ww)-y_coord(w)));
+      if ( t<0 ) break;
+      incr(s);
+      w=ww; ww=link(ww);
+    } while (t>0);
+  } else { 
+    ww=knil(w);
+    while ( mp_ab_vs_cd(mp, dy,(x_coord(w)-x_coord(ww)),
+                            dx,(y_coord(w)-y_coord(ww))) < 0) { 
+      decr(s);
+      w=ww; ww=knil(ww);
+    }
+  }
+  return s;
+}
+
+@ When we're all done, the final offset is |w0| and the final curve direction
+is |(dxin,dyin)|.  With this knowledge of the incoming direction at |c|, we
+can correct |info(c)| which was erroneously based on an incoming offset
+of~|h|.
+
+@d fix_by(A) info(c)=info(c)+(A)
+
+@<Fix the offset change in |info(c)| and set |c| to the return value of...@>=
+mp->spec_offset=info(c)-zero_off;
+if ( link(c)==c ) {
+  info(c)=zero_off+n;
+} else { 
+  fix_by(k_needed);
+  while ( w0!=h ) { fix_by(1); w0=link(w0);  };
+  while ( info(c)<=zero_off-n ) fix_by(n);
+  while ( info(c)>zero_off ) fix_by(-n);
+  if ( (info(c)!=zero_off)&&(mp_ab_vs_cd(mp, dy0,dxin,dx0,dyin)>=0) ) fix_by(n);
+}
+
+@ Finally we want to reduce the general problem to situations that
+|fin_offset_prep| can handle. We split the cubic into at most three parts
+with respect to $d_{k-1}$, and apply |fin_offset_prep| to each part.
+
+@<Complete the offset splitting process@>=
+ww=knil(w);
+@<Compute test coeff...@>;
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set
+  |t:=fraction_one+1|@>;
+if ( t>fraction_one ) {
+  mp_fin_offset_prep(mp, p,w,x0,x1,x2,y0,y1,y2,1,turn_amt);
+} else {
+  mp_split_cubic(mp, p,t); r=link(p);
+  x1a=t_of_the_way(x0,x1); x1=t_of_the_way(x1,x2);
+  x2a=t_of_the_way(x1a,x1);
+  y1a=t_of_the_way(y0,y1); y1=t_of_the_way(y1,y2);
+  y2a=t_of_the_way(y1a,y1);
+  mp_fin_offset_prep(mp, p,w,x0,x1a,x2a,y0,y1a,y2a,1,0); x0=x2a; y0=y2a;
+  info(r)=zero_off-1;
+  if ( turn_amt>=0 ) {
+    t1=t_of_the_way(t1,t2);
+    if ( t1>0 ) t1=0;
+    t=mp_crossing_point(mp, 0,-t1,-t2);
+    if ( t>fraction_one ) t=fraction_one;
+    @<Split off another rising cubic for |fin_offset_prep|@>;
+    mp_fin_offset_prep(mp, r,ww,x0,x1,x2,y0,y1,y2,-1,0);
+  } else {
+    mp_fin_offset_prep(mp, r,ww,x0,x1,x2,y0,y1,y2,-1,(-1-turn_amt));
+  }
+}
+
+@ @<Split off another rising cubic for |fin_offset_prep|@>=
+mp_split_cubic(mp, r,t); info(link(r))=zero_off+1;
+x1a=t_of_the_way(x1,x2); x1=t_of_the_way(x0,x1);
+x0a=t_of_the_way(x1,x1a);
+y1a=t_of_the_way(y1,y2); y1=t_of_the_way(y0,y1);
+y0a=t_of_the_way(y1,y1a);
+mp_fin_offset_prep(mp, link(r),w,x0a,x1a,x2,y0a,y1a,y2,1,turn_amt);
+x2=x0a; y2=y0a
+
+@ At this point, the direction of the incoming pen edge is |(-du,-dv)|.
+When the component of $d(t)$ perpendicular to |(-du,-dv)| crosses zero, we
+need to decide whether the directions are parallel or antiparallel.  We
+can test this by finding the dot product of $d(t)$ and |(-du,-dv)|, but this
+should be avoided when the value of |turn_amt| already determines the
+answer.  If |t2<0|, there is one crossing and it is antiparallel only if
+|turn_amt>=0|.  If |turn_amt<0|, there should always be at least one
+crossing and the first crossing cannot be antiparallel.
+
+@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set...@>=
+t=mp_crossing_point(mp, t0,t1,t2);
+if ( turn_amt>=0 ) {
+  if ( t2<0 ) {
+    t=fraction_one+1;
+  } else { 
+    u0=t_of_the_way(x0,x1);
+    u1=t_of_the_way(x1,x2);
+    ss=mp_take_fraction(mp, -du,t_of_the_way(u0,u1));
+    v0=t_of_the_way(y0,y1);
+    v1=t_of_the_way(y1,y2);
+    ss=ss+mp_take_fraction(mp, -dv,t_of_the_way(v0,v1));
+    if ( ss<0 ) t=fraction_one+1;
+  }
+} else if ( t>fraction_one ) {
+  t=fraction_one;
+}
+
+@ @<Other local variables for |offset_prep|@>=
+integer u0,u1,v0,v1; /* intermediate values for $d(t)$ calculation */
+integer ss = 0; /* the part of the dot product computed so far */
+int d_sign; /* sign of overall change in direction for this cubic */
+
+@ If the cubic almost has a cusp, it is a numerically ill-conditioned
+problem to decide which way it loops around but that's OK as long we're
+consistent.  To make \&{doublepath} envelopes work properly, reversing
+the path should always change the sign of |turn_amt|.
+
+@<Decide on the net change in pen offsets and set |turn_amt|@>=
+d_sign=mp_ab_vs_cd(mp, dx,dyin, dxin,dy);
+if ( d_sign==0 ) {
+  @<Check rotation direction based on node position@>
+}
+if ( d_sign==0 ) {
+  if ( dx==0 ) {
+    if ( dy>0 ) d_sign=1;  else d_sign=-1;
+  } else {
+    if ( dx>0 ) d_sign=1;  else d_sign=-1; 
+  }
+}
+@<Make |ss| negative if and only if the total change in direction is
+  more than $180^\circ$@>;
+turn_amt=mp_get_turn_amt(mp, w, dxin, dyin, (d_sign>0));
+if ( ss<0 ) turn_amt=turn_amt-d_sign*n
+
+@ We check rotation direction by looking at the vector connecting the current
+node with the next. If its angle with incoming and outgoing tangents has the
+same sign, we pick this as |d_sign|, since it means we have a flex, not a cusp.
+Otherwise we proceed to the cusp code.
+
+@<Check rotation direction based on node position@>=
+u0=x_coord(q)-x_coord(p);
+u1=y_coord(q)-y_coord(p);
+d_sign = half(mp_ab_vs_cd(mp, dx, u1, u0, dy)+
+  mp_ab_vs_cd(mp, u0, dyin, dxin, u1));
+
+@ In order to be invariant under path reversal, the result of this computation
+should not change when |x0|, |y0|, $\ldots$ are all negated and |(x0,y0)| is
+then swapped with |(x2,y2)|.  We make use of the identities
+|take_fraction(-a,-b)=take_fraction(a,b)| and
+|t_of_the_way(-a,-b)=-(t_of_the_way(a,b))|.
+
+@<Make |ss| negative if and only if the total change in direction is...@>=
+t0=half(mp_take_fraction(mp, x0,y2))-half(mp_take_fraction(mp, x2,y0));
+t1=half(mp_take_fraction(mp, x1,(y0+y2)))-half(mp_take_fraction(mp, y1,(x0+x2)));
+if ( t0==0 ) t0=d_sign; /* path reversal always negates |d_sign| */
+if ( t0>0 ) {
+  t=mp_crossing_point(mp, t0,t1,-t0);
+  u0=t_of_the_way(x0,x1);
+  u1=t_of_the_way(x1,x2);
+  v0=t_of_the_way(y0,y1);
+  v1=t_of_the_way(y1,y2);
+} else { 
+  t=mp_crossing_point(mp, -t0,t1,t0);
+  u0=t_of_the_way(x2,x1);
+  u1=t_of_the_way(x1,x0);
+  v0=t_of_the_way(y2,y1);
+  v1=t_of_the_way(y1,y0);
+}
+ss=mp_take_fraction(mp, (x0+x2),t_of_the_way(u0,u1))+
+   mp_take_fraction(mp, (y0+y2),t_of_the_way(v0,v1))
+
+@ Here's a routine that prints an envelope spec in symbolic form.  It assumes
+that the |cur_pen| has not been walked around to the first offset.
+
+@c 
+void mp_print_spec (MP mp,pointer cur_spec, pointer cur_pen, const char *s) {
+  pointer p,q; /* list traversal */
+  pointer w; /* the current pen offset */
+  mp_print_diagnostic(mp, "Envelope spec",s,true);
+  p=cur_spec; w=mp_pen_walk(mp, cur_pen,mp->spec_offset);
+  mp_print_ln(mp);
+  mp_print_two(mp, x_coord(cur_spec),y_coord(cur_spec));
+  mp_print(mp, " % beginning with offset ");
+  mp_print_two(mp, x_coord(w),y_coord(w));
+  do { 
+    while (1) {  
+      q=link(p);
+      @<Print the cubic between |p| and |q|@>;
+      p=q;
+	  if ((p==cur_spec) || (info(p)!=zero_off)) 
+    	break;
+    }
+    if ( info(p)!=zero_off ) {
+      @<Update |w| as indicated by |info(p)| and print an explanation@>;
+    }
+  } while (p!=cur_spec);
+  mp_print_nl(mp, " & cycle");
+  mp_end_diagnostic(mp, true);
+}
+
+@ @<Update |w| as indicated by |info(p)| and print an explanation@>=
+{ 
+  w=mp_pen_walk(mp, w, (info(p)-zero_off));
+  mp_print(mp, " % ");
+  if ( info(p)>zero_off ) mp_print(mp, "counter");
+  mp_print(mp, "clockwise to offset ");
+  mp_print_two(mp, x_coord(w),y_coord(w));
+}
+
+@ @<Print the cubic between |p| and |q|@>=
+{ 
+  mp_print_nl(mp, "   ..controls ");
+  mp_print_two(mp, right_x(p),right_y(p));
+  mp_print(mp, " and ");
+  mp_print_two(mp, left_x(q),left_y(q));
+  mp_print_nl(mp, " ..");
+  mp_print_two(mp, x_coord(q),y_coord(q));
+}
+
+@ Once we have an envelope spec, the remaining task to construct the actual
+envelope by offsetting each cubic as determined by the |info| fields in
+the knots.  First we use |offset_prep| to convert the |c| into an envelope
+spec. Then we add the offsets so that |c| becomes a cyclic path that represents
+the envelope.
+
+The |ljoin| and |miterlim| parameters control the treatment of points where the
+pen offset changes, and |lcap| controls the endpoints of a \&{doublepath}.
+The endpoints are easily located because |c| is given in undoubled form
+and then doubled in this procedure.  We use |spec_p1| and |spec_p2| to keep
+track of the endpoints and treat them like very sharp corners.
+Butt end caps are treated like beveled joins; round end caps are treated like
+round joins; and square end caps are achieved by setting |join_type:=3|.
+
+None of these parameters apply to inside joins where the convolution tracing
+has retrograde lines.  In such cases we use a simple connect-the-endpoints
+approach that is achieved by setting |join_type:=2|.
+
+@c @<Declare a function called |insert_knot|@>
+pointer mp_make_envelope (MP mp,pointer c, pointer h, small_number ljoin,
+  small_number lcap, scaled miterlim) {
+  pointer p,q,r,q0; /* for manipulating the path */
+  int join_type=0; /* codes |0..3| for mitered, round, beveled, or square */
+  pointer w,w0; /* the pen knot for the current offset */
+  scaled qx,qy; /* unshifted coordinates of |q| */
+  halfword k,k0; /* controls pen edge insertion */
+  @<Other local variables for |make_envelope|@>;
+  dxin=0; dyin=0; dxout=0; dyout=0;
+  mp->spec_p1=null; mp->spec_p2=null;
+  @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>;
+  @<Use |offset_prep| to compute the envelope spec then walk |h| around to
+    the initial offset@>;
+  w=h;
+  p=c;
+  do {  
+    q=link(p); q0=q;
+    qx=x_coord(q); qy=y_coord(q);
+    k=info(q);
+    k0=k; w0=w;
+    if ( k!=zero_off ) {
+      @<Set |join_type| to indicate how to handle offset changes at~|q|@>;
+    }
+    @<Add offset |w| to the cubic from |p| to |q|@>;
+    while ( k!=zero_off ) { 
+      @<Step |w| and move |k| one step closer to |zero_off|@>;
+      if ( (join_type==1)||(k==zero_off) )
+         q=mp_insert_knot(mp, q,qx+x_coord(w),qy+y_coord(w));
+    };
+    if ( q!=link(p) ) {
+      @<Set |p=link(p)| and add knots between |p| and |q| as
+        required by |join_type|@>;
+    }
+    p=q;
+  } while (q0!=c);
+  return c;
+}
+
+@ @<Use |offset_prep| to compute the envelope spec then walk |h| around to...@>=
+c=mp_offset_prep(mp, c,h);
+if ( mp->internal[mp_tracing_specs]>0 ) 
+  mp_print_spec(mp, c,h,"");
+h=mp_pen_walk(mp, h,mp->spec_offset)
+
+@ Mitered and squared-off joins depend on path directions that are difficult to
+compute for degenerate cubics.  The envelope spec computed by |offset_prep| can
+have degenerate cubics only if the entire cycle collapses to a single
+degenerate cubic.  Setting |join_type:=2| in this case makes the computed
+envelope degenerate as well.
+
+@<Set |join_type| to indicate how to handle offset changes at~|q|@>=
+if ( k<zero_off ) {
+  join_type=2;
+} else {
+  if ( (q!=mp->spec_p1)&&(q!=mp->spec_p2) ) join_type=ljoin;
+  else if ( lcap==2 ) join_type=3;
+  else join_type=2-lcap;
+  if ( (join_type==0)||(join_type==3) ) {
+    @<Set the incoming and outgoing directions at |q|; in case of
+      degeneracy set |join_type:=2|@>;
+    if ( join_type==0 ) {
+      @<If |miterlim| is less than the secant of half the angle at |q|
+        then set |join_type:=2|@>;
+    }
+  }
+}
+
+@ @<If |miterlim| is less than the secant of half the angle at |q|...@>=
+{ 
+  tmp=mp_take_fraction(mp, miterlim,fraction_half+
+      half(mp_take_fraction(mp, dxin,dxout)+mp_take_fraction(mp, dyin,dyout)));
+  if ( tmp<unity )
+    if ( mp_take_scaled(mp, miterlim,tmp)<unity ) join_type=2;
+}
+
+@ @<Other local variables for |make_envelope|@>=
+fraction dxin,dyin,dxout,dyout; /* directions at |q| when square or mitered */
+scaled tmp; /* a temporary value */
+
+@ The coordinates of |p| have already been shifted unless |p| is the first
+knot in which case they get shifted at the very end.
+
+@<Add offset |w| to the cubic from |p| to |q|@>=
+right_x(p)=right_x(p)+x_coord(w);
+right_y(p)=right_y(p)+y_coord(w);
+left_x(q)=left_x(q)+x_coord(w);
+left_y(q)=left_y(q)+y_coord(w);
+x_coord(q)=x_coord(q)+x_coord(w);
+y_coord(q)=y_coord(q)+y_coord(w);
+left_type(q)=mp_explicit;
+right_type(q)=mp_explicit
+
+@ @<Step |w| and move |k| one step closer to |zero_off|@>=
+if ( k>zero_off ){ w=link(w); decr(k);  }
+else { w=knil(w); incr(k);  }
+
+@ The cubic from |q| to the new knot at |(x,y)| becomes a line segment and
+the |right_x| and |right_y| fields of |r| are set from |q|.  This is done in
+case the cubic containing these control points is ``yet to be examined.''
+
+@<Declare a function called |insert_knot|@>=
+pointer mp_insert_knot (MP mp,pointer q, scaled x, scaled y) {
+  /* returns the inserted knot */
+  pointer r; /* the new knot */
+  r=mp_get_node(mp, knot_node_size);
+  link(r)=link(q); link(q)=r;
+  right_x(r)=right_x(q);
+  right_y(r)=right_y(q);
+  x_coord(r)=x;
+  y_coord(r)=y;
+  right_x(q)=x_coord(q);
+  right_y(q)=y_coord(q);
+  left_x(r)=x_coord(r);
+  left_y(r)=y_coord(r);
+  left_type(r)=mp_explicit;
+  right_type(r)=mp_explicit;
+  originator(r)=mp_program_code;
+  return r;
+}
+
+@ After setting |p:=link(p)|, either |join_type=1| or |q=link(p)|.
+
+@<Set |p=link(p)| and add knots between |p| and |q| as...@>=
+{ 
+  p=link(p);
+  if ( (join_type==0)||(join_type==3) ) {
+    if ( join_type==0 ) {
+      @<Insert a new knot |r| between |p| and |q| as required for a mitered join@>
+    } else {
+      @<Make |r| the last of two knots inserted between |p| and |q| to form a
+        squared join@>;
+    }
+    if ( r!=null ) { 
+      right_x(r)=x_coord(r);
+      right_y(r)=y_coord(r);
+    }
+  }
+}
+
+@ For very small angles, adding a knot is unnecessary and would cause numerical
+problems, so we just set |r:=null| in that case.
+
+@<Insert a new knot |r| between |p| and |q| as required for a mitered join@>=
+{ 
+  det=mp_take_fraction(mp, dyout,dxin)-mp_take_fraction(mp, dxout,dyin);
+  if ( abs(det)<26844 ) { 
+     r=null; /* sine $<10^{-4}$ */
+  } else { 
+    tmp=mp_take_fraction(mp, x_coord(q)-x_coord(p),dyout)-
+        mp_take_fraction(mp, y_coord(q)-y_coord(p),dxout);
+    tmp=mp_make_fraction(mp, tmp,det);
+    r=mp_insert_knot(mp, p,x_coord(p)+mp_take_fraction(mp, tmp,dxin),
+      y_coord(p)+mp_take_fraction(mp, tmp,dyin));
+  }
+}
+
+@ @<Other local variables for |make_envelope|@>=
+fraction det; /* a determinant used for mitered join calculations */
+
+@ @<Make |r| the last of two knots inserted between |p| and |q| to form a...@>=
+{ 
+  ht_x=y_coord(w)-y_coord(w0);
+  ht_y=x_coord(w0)-x_coord(w);
+  while ( (abs(ht_x)<fraction_half)&&(abs(ht_y)<fraction_half) ) { 
+    ht_x+=ht_x; ht_y+=ht_y;
+  }
+  @<Scan the pen polygon between |w0| and |w| and make |max_ht| the range dot
+    product with |(ht_x,ht_y)|@>;
+  tmp=mp_make_fraction(mp, max_ht,mp_take_fraction(mp, dxin,ht_x)+
+                                  mp_take_fraction(mp, dyin,ht_y));
+  r=mp_insert_knot(mp, p,x_coord(p)+mp_take_fraction(mp, tmp,dxin),
+                         y_coord(p)+mp_take_fraction(mp, tmp,dyin));
+  tmp=mp_make_fraction(mp, max_ht,mp_take_fraction(mp, dxout,ht_x)+
+                                  mp_take_fraction(mp, dyout,ht_y));
+  r=mp_insert_knot(mp, r,x_coord(q)+mp_take_fraction(mp, tmp,dxout),
+                         y_coord(q)+mp_take_fraction(mp, tmp,dyout));
+}
+
+@ @<Other local variables for |make_envelope|@>=
+fraction ht_x,ht_y; /* perpendicular to the segment from |p| to |q| */
+scaled max_ht; /* maximum height of the pen polygon above the |w0|-|w| line */
+halfword kk; /* keeps track of the pen vertices being scanned */
+pointer ww; /* the pen vertex being tested */
+
+@ The dot product of the vector from |w0| to |ww| with |(ht_x,ht_y)| ranges
+from zero to |max_ht|.
+
+@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range...@>=
+max_ht=0;
+kk=zero_off;
+ww=w;
+while (1)  { 
+  @<Step |ww| and move |kk| one step closer to |k0|@>;
+  if ( kk==k0 ) break;
+  tmp=mp_take_fraction(mp, (x_coord(ww)-x_coord(w0)),ht_x)+
+      mp_take_fraction(mp, (y_coord(ww)-y_coord(w0)),ht_y);
+  if ( tmp>max_ht ) max_ht=tmp;
+}
+
+
+@ @<Step |ww| and move |kk| one step closer to |k0|@>=
+if ( kk>k0 ) { ww=link(ww); decr(kk);  }
+else { ww=knil(ww); incr(kk);  }
+
+@ @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>=
+if ( left_type(c)==mp_endpoint ) { 
+  mp->spec_p1=mp_htap_ypoc(mp, c);
+  mp->spec_p2=mp->path_tail;
+  originator(mp->spec_p1)=mp_program_code;
+  link(mp->spec_p2)=link(mp->spec_p1);
+  link(mp->spec_p1)=c;
+  mp_remove_cubic(mp, mp->spec_p1);
+  c=mp->spec_p1;
+  if ( c!=link(c) ) {
+    originator(mp->spec_p2)=mp_program_code;
+    mp_remove_cubic(mp, mp->spec_p2);
+  } else {
+    @<Make |c| look like a cycle of length one@>;
+  }
+}
+
+@ @<Make |c| look like a cycle of length one@>=
+{ 
+  left_type(c)=mp_explicit; right_type(c)=mp_explicit;
+  left_x(c)=x_coord(c); left_y(c)=y_coord(c);
+  right_x(c)=x_coord(c); right_y(c)=y_coord(c);
+}
+
+@ In degenerate situations we might have to look at the knot preceding~|q|.
+That knot is |p| but if |p<>c|, its coordinates have already been offset by |w|.
+
+@<Set the incoming and outgoing directions at |q|; in case of...@>=
+dxin=x_coord(q)-left_x(q);
+dyin=y_coord(q)-left_y(q);
+if ( (dxin==0)&&(dyin==0) ) {
+  dxin=x_coord(q)-right_x(p);
+  dyin=y_coord(q)-right_y(p);
+  if ( (dxin==0)&&(dyin==0) ) {
+    dxin=x_coord(q)-x_coord(p);
+    dyin=y_coord(q)-y_coord(p);
+    if ( p!=c ) { /* the coordinates of |p| have been offset by |w| */
+      dxin=dxin+x_coord(w);
+      dyin=dyin+y_coord(w);
+    }
+  }
+}
+tmp=mp_pyth_add(mp, dxin,dyin);
+if ( tmp==0 ) {
+  join_type=2;
+} else { 
+  dxin=mp_make_fraction(mp, dxin,tmp);
+  dyin=mp_make_fraction(mp, dyin,tmp);
+  @<Set the outgoing direction at |q|@>;
+}
+
+@ If |q=c| then the coordinates of |r| and the control points between |q|
+and~|r| have already been offset by |h|.
+
+@<Set the outgoing direction at |q|@>=
+dxout=right_x(q)-x_coord(q);
+dyout=right_y(q)-y_coord(q);
+if ( (dxout==0)&&(dyout==0) ) {
+  r=link(q);
+  dxout=left_x(r)-x_coord(q);
+  dyout=left_y(r)-y_coord(q);
+  if ( (dxout==0)&&(dyout==0) ) {
+    dxout=x_coord(r)-x_coord(q);
+    dyout=y_coord(r)-y_coord(q);
+  }
+}
+if ( q==c ) {
+  dxout=dxout-x_coord(h);
+  dyout=dyout-y_coord(h);
+}
+tmp=mp_pyth_add(mp, dxout,dyout);
+if ( tmp==0 ) mp_confusion(mp, "degenerate spec");
+@:this can't happen degerate spec}{\quad degenerate spec@>
+dxout=mp_make_fraction(mp, dxout,tmp);
+dyout=mp_make_fraction(mp, dyout,tmp)
+
+@* \[23] Direction and intersection times.
+A path of length $n$ is defined parametrically by functions $x(t)$ and
+$y(t)$, for |0<=t<=n|; we can regard $t$ as the ``time'' at which the path
+reaches the point $\bigl(x(t),y(t)\bigr)$.  In this section of the program
+we shall consider operations that determine special times associated with
+given paths: the first time that a path travels in a given direction, and
+a pair of times at which two paths cross each other.
+
+@ Let's start with the easier task. The function |find_direction_time| is
+given a direction |(x,y)| and a path starting at~|h|. If the path never
+travels in direction |(x,y)|, the direction time will be~|-1|; otherwise
+it will be nonnegative.
+
+Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given
+direction is undefined, the direction time will be~0. If $\bigl(x'(t),
+y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be
+assumed to match any given direction at time~|t|.
+
+The routine solves this problem in nondegenerate cases by rotating the path
+and the given direction so that |(x,y)=(1,0)|; i.e., the main task will be
+to find when a given path first travels ``due east.''
+
+@c 
+scaled mp_find_direction_time (MP mp,scaled x, scaled y, pointer h) {
+  scaled max; /* $\max\bigl(\vert x\vert,\vert y\vert\bigr)$ */
+  pointer p,q; /* for list traversal */
+  scaled n; /* the direction time at knot |p| */
+  scaled tt; /* the direction time within a cubic */
+  @<Other local variables for |find_direction_time|@>;
+  @<Normalize the given direction for better accuracy;
+    but |return| with zero result if it's zero@>;
+  n=0; p=h; phi=0;
+  while (1) { 
+    if ( right_type(p)==mp_endpoint ) break;
+    q=link(p);
+    @<Rotate the cubic between |p| and |q|; then
+      |goto found| if the rotated cubic travels due east at some time |tt|;
+      but |break| if an entire cyclic path has been traversed@>;
+    p=q; n=n+unity;
+  }
+  return (-unity);
+FOUND: 
+  return (n+tt);
+}
+
+@ @<Normalize the given direction for better accuracy...@>=
+if ( abs(x)<abs(y) ) { 
+  x=mp_make_fraction(mp, x,abs(y));
+  if ( y>0 ) y=fraction_one; else y=-fraction_one;
+} else if ( x==0 ) { 
+  return 0;
+} else  { 
+  y=mp_make_fraction(mp, y,abs(x));
+  if ( x>0 ) x=fraction_one; else x=-fraction_one;
+}
+
+@ Since we're interested in the tangent directions, we work with the
+derivative $${1\over3}B'(x_0,x_1,x_2,x_3;t)=
+B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
+$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scaled up
+in order to achieve better accuracy.
+
+The given path may turn abruptly at a knot, and it might pass the critical
+tangent direction at such a time. Therefore we remember the direction |phi|
+in which the previous rotated cubic was traveling. (The value of |phi| will be
+undefined on the first cubic, i.e., when |n=0|.)
+
+@<Rotate the cubic between |p| and |q|; then...@>=
+tt=0;
+@<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control
+  points of the rotated derivatives@>;
+if ( y1==0 ) if ( x1>=0 ) goto FOUND;
+if ( n>0 ) { 
+  @<Exit to |found| if an eastward direction occurs at knot |p|@>;
+  if ( p==h ) break;
+  };
+if ( (x3!=0)||(y3!=0) ) phi=mp_n_arg(mp, x3,y3);
+@<Exit to |found| if the curve whose derivatives are specified by
+  |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt|@>
+
+@ @<Other local variables for |find_direction_time|@>=
+scaled x1,x2,x3,y1,y2,y3;  /* multiples of rotated derivatives */
+angle theta,phi; /* angles of exit and entry at a knot */
+fraction t; /* temp storage */
+
+@ @<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples...@>=
+x1=right_x(p)-x_coord(p); x2=left_x(q)-right_x(p);
+x3=x_coord(q)-left_x(q);
+y1=right_y(p)-y_coord(p); y2=left_y(q)-right_y(p);
+y3=y_coord(q)-left_y(q);
+max=abs(x1);
+if ( abs(x2)>max ) max=abs(x2);
+if ( abs(x3)>max ) max=abs(x3);
+if ( abs(y1)>max ) max=abs(y1);
+if ( abs(y2)>max ) max=abs(y2);
+if ( abs(y3)>max ) max=abs(y3);
+if ( max==0 ) goto FOUND;
+while ( max<fraction_half ){ 
+  max+=max; x1+=x1; x2+=x2; x3+=x3;
+  y1+=y1; y2+=y2; y3+=y3;
+}
+t=x1; x1=mp_take_fraction(mp, x1,x)+mp_take_fraction(mp, y1,y);
+y1=mp_take_fraction(mp, y1,x)-mp_take_fraction(mp, t,y);
+t=x2; x2=mp_take_fraction(mp, x2,x)+mp_take_fraction(mp, y2,y);
+y2=mp_take_fraction(mp, y2,x)-mp_take_fraction(mp, t,y);
+t=x3; x3=mp_take_fraction(mp, x3,x)+mp_take_fraction(mp, y3,y);
+y3=mp_take_fraction(mp, y3,x)-mp_take_fraction(mp, t,y)
+
+@ @<Exit to |found| if an eastward direction occurs at knot |p|@>=
+theta=mp_n_arg(mp, x1,y1);
+if ( theta>=0 ) if ( phi<=0 ) if ( phi>=theta-one_eighty_deg ) goto FOUND;
+if ( theta<=0 ) if ( phi>=0 ) if ( phi<=theta+one_eighty_deg ) goto FOUND
+
+@ In this step we want to use the |crossing_point| routine to find the
+roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$.
+Several complications arise: If the quadratic equation has a double root,
+the curve never crosses zero, and |crossing_point| will find nothing;
+this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic
+equation has simple roots, or only one root, we may have to negate it
+so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
+And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
+identically zero.
+
+@ @<Exit to |found| if the curve whose derivatives are specified by...@>=
+if ( x1<0 ) if ( x2<0 ) if ( x3<0 ) goto DONE;
+if ( mp_ab_vs_cd(mp, y1,y3,y2,y2)==0 ) {
+  @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+    either |goto found| or |goto done|@>;
+}
+if ( y1<=0 ) {
+  if ( y1<0 ) { y1=-y1; y2=-y2; y3=-y3; }
+  else if ( y2>0 ){ y2=-y2; y3=-y3; };
+}
+@<Check the places where $B(y_1,y_2,y_3;t)=0$ to see if
+  $B(x_1,x_2,x_3;t)\ge0$@>;
+DONE:
+
+@ The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most
+two roots, because we know that it isn't identically zero.
+
+It must be admitted that the |crossing_point| routine is not perfectly accurate;
+rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to
+miss the roots when $y_1y_3<y_2^2$. The rotation process is itself
+subject to rounding errors. Yet this code optimistically tries to
+do the right thing.
+
+@d we_found_it { tt=(t+04000) / 010000; goto FOUND; }
+
+@<Check the places where $B(y_1,y_2,y_3;t)=0$...@>=
+t=mp_crossing_point(mp, y1,y2,y3);
+if ( t>fraction_one ) goto DONE;
+y2=t_of_the_way(y2,y3);
+x1=t_of_the_way(x1,x2);
+x2=t_of_the_way(x2,x3);
+x1=t_of_the_way(x1,x2);
+if ( x1>=0 ) we_found_it;
+if ( y2>0 ) y2=0;
+tt=t; t=mp_crossing_point(mp, 0,-y2,-y3);
+if ( t>fraction_one ) goto DONE;
+x1=t_of_the_way(x1,x2);
+x2=t_of_the_way(x2,x3);
+if ( t_of_the_way(x1,x2)>=0 ) { 
+  t=t_of_the_way(tt,fraction_one); we_found_it;
+}
+
+@ @<Handle the test for eastward directions when $y_1y_3=y_2^2$;
+    either |goto found| or |goto done|@>=
+{ 
+  if ( mp_ab_vs_cd(mp, y1,y2,0,0)<0 ) {
+    t=mp_make_fraction(mp, y1,y1-y2);
+    x1=t_of_the_way(x1,x2);
+    x2=t_of_the_way(x2,x3);
+    if ( t_of_the_way(x1,x2)>=0 ) we_found_it;
+  } else if ( y3==0 ) {
+    if ( y1==0 ) {
+      @<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|@>;
+    } else if ( x3>=0 ) {
+      tt=unity; goto FOUND;
+    }
+  }
+  goto DONE;
+}
+
+@ At this point we know that the derivative of |y(t)| is identically zero,
+and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of
+traveling east.
+
+@<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|...@>=
+{ 
+  t=mp_crossing_point(mp, -x1,-x2,-x3);
+  if ( t<=fraction_one ) we_found_it;
+  if ( mp_ab_vs_cd(mp, x1,x3,x2,x2)<=0 ) { 
+    t=mp_make_fraction(mp, x1,x1-x2); we_found_it;
+  }
+}
+
+@ The intersection of two cubics can be found by an interesting variant
+of the general bisection scheme described in the introduction to
+|crossing_point|.\
+Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$,
+we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$,
+if an intersection exists. First we find the smallest rectangle that
+encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps
+the smallest rectangle that encloses
+$\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect.
+But if the rectangles do overlap, we bisect the intervals, getting
+new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first
+tries for an intersection between $w'$ and~$z'$, then (if unsuccessful)
+between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$,
+finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful
+levels of bisection we will have determined the intersection times $t_1$
+and~$t_2$ to $l$~bits of accuracy.
+
+\def\submin{_{\rm min}} \def\submax{_{\rm max}}
+As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$
+and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$
+themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$,
+to determine when the enclosing rectangles overlap. Here's why:
+The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$,
+and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$,
+if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin=
+\min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
+overlap if and only if $u\submin\L x\submax$ and
+$x\submin\L u\submax$. Letting
+$$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
+  U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$
+we have $2^lu\submin=2^lu_0+U\submin$, etc.; the condition for overlap
+reduces to
+$$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$
+Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly,
+the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The
+coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases,
+because of the overlap condition; i.e., we know that $X\submin$,
+$X\submax$, and their relatives are bounded, hence $X\submax-
+U\submin$ and $X\submin-U\submax$ are bounded.
+
+@ Incidentally, if the given cubics intersect more than once, the process
+just sketched will not necessarily find the lexicographically smallest pair
+$(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled
+order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and
+$t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize
+$a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
+$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$.
+Shuffled order agrees with lexicographic order if all pairs of solutions
+$(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff
+$t_2<t_2'$; but in general, lexicographic order can be quite different,
+and the bisection algorithm would be substantially less efficient if it were
+constrained by lexicographic order.
+
+For example, suppose that an overlap has been found for $l=3$ and
+$(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by
+either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4.
+Then there is probably an intersection in one of the subintervals
+$(.1011,.011x)$; but lexicographic order would require us to explore
+$(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't
+want to store all of the subdivision data for the second path, so the
+subdivisions would have to be regenerated many times. Such inefficiencies
+would be associated with every `1' in the binary representation of~$t_1$.
+
+@ The subdivision process introduces rounding errors, hence we need to
+make a more liberal test for overlap. It is not hard to show that the
+computed values of $U_i$ differ from the truth by at most~$l$, on
+level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error.
+If $\beta$ is an upper bound on the absolute error in the computed
+components of $\Delta=(|delx|,|dely|)$ on level~$l$, we will replace
+the test `$X\submin-U\submax\L|delx|$' by the more liberal test
+`$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$.
+
+More accuracy is obtained if we try the algorithm first with |tol=0|;
+the more liberal tolerance is used only if an exact approach fails.
+It is convenient to do this double-take by letting `3' in the preceding
+paragraph be a parameter, which is first 0, then 3.
+
+@<Glob...@>=
+unsigned int tol_step; /* either 0 or 3, usually */
+
+@ We shall use an explicit stack to implement the recursive bisection
+method described above. The |bisect_stack| array will contain numerous 5-word
+packets like $(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets
+comprising the 5-word packets for $U$, $V$, $X$, and~$Y$.
+
+The following macros define the allocation of stack positions to
+the quantities needed for bisection-intersection.
+
+@d stack_1(A) mp->bisect_stack[(A)] /* $U_1$, $V_1$, $X_1$, or $Y_1$ */
+@d stack_2(A) mp->bisect_stack[(A)+1] /* $U_2$, $V_2$, $X_2$, or $Y_2$ */
+@d stack_3(A) mp->bisect_stack[(A)+2] /* $U_3$, $V_3$, $X_3$, or $Y_3$ */
+@d stack_min(A) mp->bisect_stack[(A)+3]
+  /* $U\submin$, $V\submin$, $X\submin$, or $Y\submin$ */
+@d stack_max(A) mp->bisect_stack[(A)+4]
+  /* $U\submax$, $V\submax$, $X\submax$, or $Y\submax$ */
+@d int_packets 20 /* number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$ */
+@#
+@d u_packet(A) ((A)-5)
+@d v_packet(A) ((A)-10)
+@d x_packet(A) ((A)-15)
+@d y_packet(A) ((A)-20)
+@d l_packets (mp->bisect_ptr-int_packets)
+@d r_packets mp->bisect_ptr
+@d ul_packet u_packet(l_packets) /* base of $U'_k$ variables */
+@d vl_packet v_packet(l_packets) /* base of $V'_k$ variables */
+@d xl_packet x_packet(l_packets) /* base of $X'_k$ variables */
+@d yl_packet y_packet(l_packets) /* base of $Y'_k$ variables */
+@d ur_packet u_packet(r_packets) /* base of $U''_k$ variables */
+@d vr_packet v_packet(r_packets) /* base of $V''_k$ variables */
+@d xr_packet x_packet(r_packets) /* base of $X''_k$ variables */
+@d yr_packet y_packet(r_packets) /* base of $Y''_k$ variables */
+@#
+@d u1l stack_1(ul_packet) /* $U'_1$ */
+@d u2l stack_2(ul_packet) /* $U'_2$ */
+@d u3l stack_3(ul_packet) /* $U'_3$ */
+@d v1l stack_1(vl_packet) /* $V'_1$ */
+@d v2l stack_2(vl_packet) /* $V'_2$ */
+@d v3l stack_3(vl_packet) /* $V'_3$ */
+@d x1l stack_1(xl_packet) /* $X'_1$ */
+@d x2l stack_2(xl_packet) /* $X'_2$ */
+@d x3l stack_3(xl_packet) /* $X'_3$ */
+@d y1l stack_1(yl_packet) /* $Y'_1$ */
+@d y2l stack_2(yl_packet) /* $Y'_2$ */
+@d y3l stack_3(yl_packet) /* $Y'_3$ */
+@d u1r stack_1(ur_packet) /* $U''_1$ */
+@d u2r stack_2(ur_packet) /* $U''_2$ */
+@d u3r stack_3(ur_packet) /* $U''_3$ */
+@d v1r stack_1(vr_packet) /* $V''_1$ */
+@d v2r stack_2(vr_packet) /* $V''_2$ */
+@d v3r stack_3(vr_packet) /* $V''_3$ */
+@d x1r stack_1(xr_packet) /* $X''_1$ */
+@d x2r stack_2(xr_packet) /* $X''_2$ */
+@d x3r stack_3(xr_packet) /* $X''_3$ */
+@d y1r stack_1(yr_packet) /* $Y''_1$ */
+@d y2r stack_2(yr_packet) /* $Y''_2$ */
+@d y3r stack_3(yr_packet) /* $Y''_3$ */
+@#
+@d stack_dx mp->bisect_stack[mp->bisect_ptr] /* stacked value of |delx| */
+@d stack_dy mp->bisect_stack[mp->bisect_ptr+1] /* stacked value of |dely| */
+@d stack_tol mp->bisect_stack[mp->bisect_ptr+2] /* stacked value of |tol| */
+@d stack_uv mp->bisect_stack[mp->bisect_ptr+3] /* stacked value of |uv| */
+@d stack_xy mp->bisect_stack[mp->bisect_ptr+4] /* stacked value of |xy| */
+@d int_increment (int_packets+int_packets+5) /* number of stack words per level */
+
+@<Glob...@>=
+integer *bisect_stack;
+unsigned int bisect_ptr;
+
+@ @<Allocate or initialize ...@>=
+mp->bisect_stack = xmalloc((bistack_size+1),sizeof(integer));
+
+@ @<Dealloc variables@>=
+xfree(mp->bisect_stack);
+
+@ @<Check the ``constant''...@>=
+if ( int_packets+17*int_increment>bistack_size ) mp->bad=19;
+
+@ Computation of the min and max is a tedious but fairly fast sequence of
+instructions; exactly four comparisons are made in each branch.
+
+@d set_min_max(A) 
+  if ( stack_1((A))<0 ) {
+    if ( stack_3((A))>=0 ) {
+      if ( stack_2((A))<0 ) stack_min((A))=stack_1((A))+stack_2((A));
+      else stack_min((A))=stack_1((A));
+      stack_max((A))=stack_1((A))+stack_2((A))+stack_3((A));
+      if ( stack_max((A))<0 ) stack_max((A))=0;
+    } else { 
+      stack_min((A))=stack_1((A))+stack_2((A))+stack_3((A));
+      if ( stack_min((A))>stack_1((A)) ) stack_min((A))=stack_1((A));
+      stack_max((A))=stack_1((A))+stack_2((A));
+      if ( stack_max((A))<0 ) stack_max((A))=0;
+    }
+  } else if ( stack_3((A))<=0 ) {
+    if ( stack_2((A))>0 ) stack_max((A))=stack_1((A))+stack_2((A));
+    else stack_max((A))=stack_1((A));
+    stack_min((A))=stack_1((A))+stack_2((A))+stack_3((A));
+    if ( stack_min((A))>0 ) stack_min((A))=0;
+  } else  { 
+    stack_max((A))=stack_1((A))+stack_2((A))+stack_3((A));
+    if ( stack_max((A))<stack_1((A)) ) stack_max((A))=stack_1((A));
+    stack_min((A))=stack_1((A))+stack_2((A));
+    if ( stack_min((A))>0 ) stack_min((A))=0;
+  }
+
+@ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in
+the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection|
+routine uses global variables |cur_t| and |cur_tt| for this purpose;
+after successful completion, |cur_t| and |cur_tt| will contain |unity|
+plus the |scaled| values of $t_1$ and~$t_2$.
+
+The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection|
+finds no intersection. The routine gives up and gives an approximate answer
+if it has backtracked
+more than 5000 times (otherwise there are cases where several minutes
+of fruitless computation would be possible).
+
+@d max_patience 5000
+
+@<Glob...@>=
+integer cur_t;integer cur_tt; /* controls and results of |cubic_intersection| */
+integer time_to_go; /* this many backtracks before giving up */
+integer max_t; /* maximum of $2^{l+1}$ so far achieved */
+
+@ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
+$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,link(p))|
+and |(pp,link(pp))|, respectively.
+
+@c void mp_cubic_intersection (MP mp,pointer p, pointer pp) {
+  pointer q,qq; /* |link(p)|, |link(pp)| */
+  mp->time_to_go=max_patience; mp->max_t=2;
+  @<Initialize for intersections at level zero@>;
+CONTINUE:
+  while (1) { 
+    if ( mp->delx-mp->tol<=stack_max(x_packet(mp->xy))-stack_min(u_packet(mp->uv)))
+    if ( mp->delx+mp->tol>=stack_min(x_packet(mp->xy))-stack_max(u_packet(mp->uv)))
+    if ( mp->dely-mp->tol<=stack_max(y_packet(mp->xy))-stack_min(v_packet(mp->uv)))
+    if ( mp->dely+mp->tol>=stack_min(y_packet(mp->xy))-stack_max(v_packet(mp->uv))) 
+    { 
+      if ( mp->cur_t>=mp->max_t ){ 
+        if ( mp->max_t==two ) { /* we've done 17 bisections */ 
+           mp->cur_t=halfp(mp->cur_t+1); 
+	       mp->cur_tt=halfp(mp->cur_tt+1); 
+           return;
+        }
+        mp->max_t+=mp->max_t; mp->appr_t=mp->cur_t; mp->appr_tt=mp->cur_tt;
+      }
+      @<Subdivide for a new level of intersection@>;
+      goto CONTINUE;
+    }
+    if ( mp->time_to_go>0 ) {
+      decr(mp->time_to_go);
+    } else { 
+      while ( mp->appr_t<unity ) { 
+        mp->appr_t+=mp->appr_t; mp->appr_tt+=mp->appr_tt;
+      }
+      mp->cur_t=mp->appr_t; mp->cur_tt=mp->appr_tt; return;
+    }
+    @<Advance to the next pair |(cur_t,cur_tt)|@>;
+  }
+}
+
+@ The following variables are global, although they are used only by
+|cubic_intersection|, because it is necessary on some machines to
+split |cubic_intersection| up into two procedures.
+
+@<Glob...@>=
+integer delx;integer dely; /* the components of $\Delta=2^l(w_0-z_0)$ */
+integer tol; /* bound on the uncertainty in the overlap test */
+unsigned int uv;
+unsigned int xy; /* pointers to the current packets of interest */
+integer three_l; /* |tol_step| times the bisection level */
+integer appr_t;integer appr_tt; /* best approximations known to the answers */
+
+@ We shall assume that the coordinates are sufficiently non-extreme that
+integer overflow will not occur.
+@^overflow in arithmetic@>
+
+@<Initialize for intersections at level zero@>=
+q=link(p); qq=link(pp); mp->bisect_ptr=int_packets;
+u1r=right_x(p)-x_coord(p); u2r=left_x(q)-right_x(p);
+u3r=x_coord(q)-left_x(q); set_min_max(ur_packet);
+v1r=right_y(p)-y_coord(p); v2r=left_y(q)-right_y(p);
+v3r=y_coord(q)-left_y(q); set_min_max(vr_packet);
+x1r=right_x(pp)-x_coord(pp); x2r=left_x(qq)-right_x(pp);
+x3r=x_coord(qq)-left_x(qq); set_min_max(xr_packet);
+y1r=right_y(pp)-y_coord(pp); y2r=left_y(qq)-right_y(pp);
+y3r=y_coord(qq)-left_y(qq); set_min_max(yr_packet);
+mp->delx=x_coord(p)-x_coord(pp); mp->dely=y_coord(p)-y_coord(pp);
+mp->tol=0; mp->uv=r_packets; mp->xy=r_packets; 
+mp->three_l=0; mp->cur_t=1; mp->cur_tt=1
+
+@ @<Subdivide for a new level of intersection@>=
+stack_dx=mp->delx; stack_dy=mp->dely; stack_tol=mp->tol; 
+stack_uv=mp->uv; stack_xy=mp->xy;
+mp->bisect_ptr=mp->bisect_ptr+int_increment;
+mp->cur_t+=mp->cur_t; mp->cur_tt+=mp->cur_tt;
+u1l=stack_1(u_packet(mp->uv)); u3r=stack_3(u_packet(mp->uv));
+u2l=half(u1l+stack_2(u_packet(mp->uv)));
+u2r=half(u3r+stack_2(u_packet(mp->uv)));
+u3l=half(u2l+u2r); u1r=u3l;
+set_min_max(ul_packet); set_min_max(ur_packet);
+v1l=stack_1(v_packet(mp->uv)); v3r=stack_3(v_packet(mp->uv));
+v2l=half(v1l+stack_2(v_packet(mp->uv)));
+v2r=half(v3r+stack_2(v_packet(mp->uv)));
+v3l=half(v2l+v2r); v1r=v3l;
+set_min_max(vl_packet); set_min_max(vr_packet);
+x1l=stack_1(x_packet(mp->xy)); x3r=stack_3(x_packet(mp->xy));
+x2l=half(x1l+stack_2(x_packet(mp->xy)));
+x2r=half(x3r+stack_2(x_packet(mp->xy)));
+x3l=half(x2l+x2r); x1r=x3l;
+set_min_max(xl_packet); set_min_max(xr_packet);
+y1l=stack_1(y_packet(mp->xy)); y3r=stack_3(y_packet(mp->xy));
+y2l=half(y1l+stack_2(y_packet(mp->xy)));
+y2r=half(y3r+stack_2(y_packet(mp->xy)));
+y3l=half(y2l+y2r); y1r=y3l;
+set_min_max(yl_packet); set_min_max(yr_packet);
+mp->uv=l_packets; mp->xy=l_packets;
+mp->delx+=mp->delx; mp->dely+=mp->dely;
+mp->tol=mp->tol-mp->three_l+mp->tol_step; 
+mp->tol+=mp->tol; mp->three_l=mp->three_l+mp->tol_step
+
+@ @<Advance to the next pair |(cur_t,cur_tt)|@>=
+NOT_FOUND: 
+if ( odd(mp->cur_tt) ) {
+  if ( odd(mp->cur_t) ) {
+     @<Descend to the previous level and |goto not_found|@>;
+  } else { 
+    incr(mp->cur_t);
+    mp->delx=mp->delx+stack_1(u_packet(mp->uv))+stack_2(u_packet(mp->uv))
+      +stack_3(u_packet(mp->uv));
+    mp->dely=mp->dely+stack_1(v_packet(mp->uv))+stack_2(v_packet(mp->uv))
+      +stack_3(v_packet(mp->uv));
+    mp->uv=mp->uv+int_packets; /* switch from |l_packets| to |r_packets| */
+    decr(mp->cur_tt); mp->xy=mp->xy-int_packets; 
+         /* switch from |r_packets| to |l_packets| */
+    mp->delx=mp->delx+stack_1(x_packet(mp->xy))+stack_2(x_packet(mp->xy))
+      +stack_3(x_packet(mp->xy));
+    mp->dely=mp->dely+stack_1(y_packet(mp->xy))+stack_2(y_packet(mp->xy))
+      +stack_3(y_packet(mp->xy));
+  }
+} else { 
+  incr(mp->cur_tt); mp->tol=mp->tol+mp->three_l;
+  mp->delx=mp->delx-stack_1(x_packet(mp->xy))-stack_2(x_packet(mp->xy))
+    -stack_3(x_packet(mp->xy));
+  mp->dely=mp->dely-stack_1(y_packet(mp->xy))-stack_2(y_packet(mp->xy))
+    -stack_3(y_packet(mp->xy));
+  mp->xy=mp->xy+int_packets; /* switch from |l_packets| to |r_packets| */
+}
+
+@ @<Descend to the previous level...@>=
+{ 
+  mp->cur_t=halfp(mp->cur_t); mp->cur_tt=halfp(mp->cur_tt);
+  if ( mp->cur_t==0 ) return;
+  mp->bisect_ptr=mp->bisect_ptr-int_increment; 
+  mp->three_l=mp->three_l-mp->tol_step;
+  mp->delx=stack_dx; mp->dely=stack_dy; mp->tol=stack_tol; 
+  mp->uv=stack_uv; mp->xy=stack_xy;
+  goto NOT_FOUND;
+}
+
+@ The |path_intersection| procedure is much simpler.
+It invokes |cubic_intersection| in lexicographic order until finding a
+pair of cubics that intersect. The final intersection times are placed in
+|cur_t| and~|cur_tt|.
+
+@c void mp_path_intersection (MP mp,pointer h, pointer hh) {
+  pointer p,pp; /* link registers that traverse the given paths */
+  integer n,nn; /* integer parts of intersection times, minus |unity| */
+  @<Change one-point paths into dead cycles@>;
+  mp->tol_step=0;
+  do {  
+    n=-unity; p=h;
+    do {  
+      if ( right_type(p)!=mp_endpoint ) { 
+        nn=-unity; pp=hh;
+        do {  
+          if ( right_type(pp)!=mp_endpoint )  { 
+            mp_cubic_intersection(mp, p,pp);
+            if ( mp->cur_t>0 ) { 
+              mp->cur_t=mp->cur_t+n; mp->cur_tt=mp->cur_tt+nn; 
+              return;
+            }
+          }
+          nn=nn+unity; pp=link(pp);
+        } while (pp!=hh);
+      }
+      n=n+unity; p=link(p);
+    } while (p!=h);
+    mp->tol_step=mp->tol_step+3;
+  } while (mp->tol_step<=3);
+  mp->cur_t=-unity; mp->cur_tt=-unity;
+}
+
+@ @<Change one-point paths...@>=
+if ( right_type(h)==mp_endpoint ) {
+  right_x(h)=x_coord(h); left_x(h)=x_coord(h);
+  right_y(h)=y_coord(h); left_y(h)=y_coord(h); right_type(h)=mp_explicit;
+}
+if ( right_type(hh)==mp_endpoint ) {
+  right_x(hh)=x_coord(hh); left_x(hh)=x_coord(hh);
+  right_y(hh)=y_coord(hh); left_y(hh)=y_coord(hh); right_type(hh)=mp_explicit;
+}
+
+@* \[24] Dynamic linear equations.
+\MP\ users define variables implicitly by stating equations that should be
+satisfied; the computer is supposed to be smart enough to solve those equations.
+And indeed, the computer tries valiantly to do so, by distinguishing five
+different types of numeric values:
+
+\smallskip\hang
+|type(p)=mp_known| is the nice case, when |value(p)| is the |scaled| value
+of the variable whose address is~|p|.
+
+\smallskip\hang
+|type(p)=mp_dependent| means that |value(p)| is not present, but |dep_list(p)|
+points to a {\sl dependency list\/} that expresses the value of variable~|p|
+as a |scaled| number plus a sum of independent variables with |fraction|
+coefficients.
+
+\smallskip\hang
+|type(p)=mp_independent| means that |value(p)=64s+m|, where |s>0| is a ``serial
+number'' reflecting the time this variable was first used in an equation;
+also |0<=m<64|, and each dependent variable
+that refers to this one is actually referring to the future value of
+this variable times~$2^m$. (Usually |m=0|, but higher degrees of
+scaling are sometimes needed to keep the coefficients in dependency lists
+from getting too large. The value of~|m| will always be even.)
+
+\smallskip\hang
+|type(p)=mp_numeric_type| means that variable |p| hasn't appeared in an
+equation before, but it has been explicitly declared to be numeric.
+
+\smallskip\hang
+|type(p)=undefined| means that variable |p| hasn't appeared before.
+
+\smallskip\noindent
+We have actually discussed these five types in the reverse order of their
+history during a computation: Once |known|, a variable never again
+becomes |dependent|; once |dependent|, it almost never again becomes
+|mp_independent|; once |mp_independent|, it never again becomes |mp_numeric_type|;
+and once |mp_numeric_type|, it never again becomes |undefined| (except
+of course when the user specifically decides to scrap the old value
+and start again). A backward step may, however, take place: Sometimes
+a |dependent| variable becomes |mp_independent| again, when one of the
+independent variables it depends on is reverting to |undefined|.
+
+
+The next patch detects overflow of independent-variable serial
+numbers. Diagnosed and patched by Thorsten Dahlheimer.
+
+@d s_scale 64 /* the serial numbers are multiplied by this factor */
+@d new_indep(A)  /* create a new independent variable */
+  { if ( mp->serial_no>el_gordo-s_scale )
+    mp_fatal_error(mp, "variable instance identifiers exhausted");
+  type((A))=mp_independent; mp->serial_no=mp->serial_no+s_scale;
+  value((A))=mp->serial_no;
+  }
+
+@<Glob...@>=
+integer serial_no; /* the most recent serial number, times |s_scale| */
+
+@ @<Make variable |q+s| newly independent@>=new_indep(q+s)
+
+@ But how are dependency lists represented? It's simple: The linear combination
+$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If
+|q=dep_list(p)| points to this list, and if |k>0|, then |value(q)=
+@t$\alpha_1$@>| (which is a |fraction|); |info(q)| points to the location
+of $\alpha_1$; and |link(p)| points to the dependency list
+$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|,
+then |value(q)=@t$\beta$@>| (which is |scaled|) and |info(q)=null|.
+The independent variables $v_1$, \dots,~$v_k$ have been sorted so that
+they appear in decreasing order of their |value| fields (i.e., of
+their serial numbers). \ (It is convenient to use decreasing order,
+since |value(null)=0|. If the independent variables were not sorted by
+serial number but by some other criterion, such as their location in |mem|,
+the equation-solving mechanism would be too system-dependent, because
+the ordering can affect the computed results.)
+
+The |link| field in the node that contains the constant term $\beta$ is
+called the {\sl final link\/} of the dependency list. \MP\ maintains
+a doubly-linked master list of all dependency lists, in terms of a permanently
+allocated node
+in |mem| called |dep_head|. If there are no dependencies, we have
+|link(dep_head)=dep_head| and |prev_dep(dep_head)=dep_head|;
+otherwise |link(dep_head)| points to the first dependent variable, say~|p|,
+and |prev_dep(p)=dep_head|. We have |type(p)=mp_dependent|, and |dep_list(p)|
+points to its dependency list. If the final link of that dependency list
+occurs in location~|q|, then |link(q)| points to the next dependent
+variable (say~|r|); and we have |prev_dep(r)=q|, etc.
+
+@d dep_list(A) link(value_loc((A)))
+  /* half of the |value| field in a |dependent| variable */
+@d prev_dep(A) info(value_loc((A)))
+  /* the other half; makes a doubly linked list */
+@d dep_node_size 2 /* the number of words per dependency node */
+
+@<Initialize table entries...@>= mp->serial_no=0;
+link(dep_head)=dep_head; prev_dep(dep_head)=dep_head;
+info(dep_head)=null; dep_list(dep_head)=null;
+
+@ Actually the description above contains a little white lie. There's
+another kind of variable called |mp_proto_dependent|, which is
+just like a |dependent| one except that the $\alpha$ coefficients
+in its dependency list are |scaled| instead of being fractions.
+Proto-dependency lists are mixed with dependency lists in the
+nodes reachable from |dep_head|.
+
+@ Here is a procedure that prints a dependency list in symbolic form.
+The second parameter should be either |dependent| or |mp_proto_dependent|,
+to indicate the scaling of the coefficients.
+
+@<Declare subroutines for printing expressions@>=
+void mp_print_dependency (MP mp,pointer p, small_number t) {
+  integer v; /* a coefficient */
+  pointer pp,q; /* for list manipulation */
+  pp=p;
+  while (1) { 
+    v=abs(value(p)); q=info(p);
+    if ( q==null ) { /* the constant term */
+      if ( (v!=0)||(p==pp) ) {
+         if ( value(p)>0 ) if ( p!=pp ) mp_print_char(mp, '+');
+         mp_print_scaled(mp, value(p));
+      }
+      return;
+    }
+    @<Print the coefficient, unless it's $\pm1.0$@>;
+    if ( type(q)!=mp_independent ) mp_confusion(mp, "dep");
+@:this can't happen dep}{\quad dep@>
+    mp_print_variable_name(mp, q); v=value(q) % s_scale;
+    while ( v>0 ) { mp_print(mp, "*4"); v=v-2; }
+    p=link(p);
+  }
+}
+
+@ @<Print the coefficient, unless it's $\pm1.0$@>=
+if ( value(p)<0 ) mp_print_char(mp, '-');
+else if ( p!=pp ) mp_print_char(mp, '+');
+if ( t==mp_dependent ) v=mp_round_fraction(mp, v);
+if ( v!=unity ) mp_print_scaled(mp, v)
+
+@ The maximum absolute value of a coefficient in a given dependency list
+is returned by the following simple function.
+
+@c fraction mp_max_coef (MP mp,pointer p) {
+  fraction x; /* the maximum so far */
+  x=0;
+  while ( info(p)!=null ) {
+    if ( abs(value(p))>x ) x=abs(value(p));
+    p=link(p);
+  }
+  return x;
+}
+
+@ One of the main operations needed on dependency lists is to add a multiple
+of one list to the other; we call this |p_plus_fq|, where |p| and~|q| point
+to dependency lists and |f| is a fraction.
+
+If the coefficient of any independent variable becomes |coef_bound| or
+more, in absolute value, this procedure changes the type of that variable
+to `|independent_needing_fix|', and sets the global variable |fix_needed|
+to~|true|. The value of $|coef_bound|=\mu$ is chosen so that
+$\mu^2+\mu<8$; this means that the numbers we deal with won't
+get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx
+2.3723$, the safer value 7/3 is taken as the threshold.)
+
+The changes mentioned in the preceding paragraph are actually done only if
+the global variable |watch_coefs| is |true|. But it usually is; in fact,
+it is |false| only when \MP\ is making a dependency list that will soon
+be equated to zero.
+
+Several procedures that act on dependency lists, including |p_plus_fq|,
+set the global variable |dep_final| to the final (constant term) node of
+the dependency list that they produce.
+
+@d coef_bound 04525252525 /* |fraction| approximation to 7/3 */
+@d independent_needing_fix 0
+
+@<Glob...@>=
+boolean fix_needed; /* does at least one |independent| variable need scaling? */
+boolean watch_coefs; /* should we scale coefficients that exceed |coef_bound|? */
+pointer dep_final; /* location of the constant term and final link */
+
+@ @<Set init...@>=
+mp->fix_needed=false; mp->watch_coefs=true;
+
+@ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be
+set to |mp_proto_dependent| if |p| is a proto-dependency list. In this
+case |f| will be |scaled|, not a |fraction|. Similarly, the fifth parameter~|tt|
+should be |mp_proto_dependent| if |q| is a proto-dependency list.
+
+List |q| is unchanged by the operation; but list |p| is totally destroyed.
+
+The final link of the dependency list or proto-dependency list returned
+by |p_plus_fq| is the same as the original final link of~|p|. Indeed, the
+constant term of the result will be located in the same |mem| location
+as the original constant term of~|p|.
+
+Coefficients of the result are assumed to be zero if they are less than
+a certain threshold. This compensates for inevitable rounding errors,
+and tends to make more variables `|known|'. The threshold is approximately
+$10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for
+proto-dependencies.
+
+@d fraction_threshold 2685 /* a |fraction| coefficient less than this is zeroed */
+@d half_fraction_threshold 1342 /* half of |fraction_threshold| */
+@d scaled_threshold 8 /* a |scaled| coefficient less than this is zeroed */
+@d half_scaled_threshold 4 /* half of |scaled_threshold| */
+
+@<Declare basic dependency-list subroutines@>=
+pointer mp_p_plus_fq ( MP mp, pointer p, integer f, 
+                      pointer q, small_number t, small_number tt) ;
+
+@ @c
+pointer mp_p_plus_fq ( MP mp, pointer p, integer f, 
+                      pointer q, small_number t, small_number tt) {
+  pointer pp,qq; /* |info(p)| and |info(q)|, respectively */
+  pointer r,s; /* for list manipulation */
+  integer threshold; /* defines a neighborhood of zero */
+  integer v; /* temporary register */
+  if ( t==mp_dependent ) threshold=fraction_threshold;
+  else threshold=scaled_threshold;
+  r=temp_head; pp=info(p); qq=info(q);
+  while (1) {
+    if ( pp==qq ) {
+      if ( pp==null ) {
+       break;
+      } else {
+        @<Contribute a term from |p|, plus |f| times the
+          corresponding term from |q|@>
+      }
+    } else if ( value(pp)<value(qq) ) {
+      @<Contribute a term from |q|, multiplied by~|f|@>
+    } else { 
+     link(r)=p; r=p; p=link(p); pp=info(p);
+    }
+  }
+  if ( t==mp_dependent )
+    value(p)=mp_slow_add(mp, value(p),mp_take_fraction(mp, value(q),f));
+  else  
+    value(p)=mp_slow_add(mp, value(p),mp_take_scaled(mp, value(q),f));
+  link(r)=p; mp->dep_final=p; 
+  return link(temp_head);
+}
+
+@ @<Contribute a term from |p|, plus |f|...@>=
+{ 
+  if ( tt==mp_dependent ) v=value(p)+mp_take_fraction(mp, f,value(q));
+  else v=value(p)+mp_take_scaled(mp, f,value(q));
+  value(p)=v; s=p; p=link(p);
+  if ( abs(v)<threshold ) {
+    mp_free_node(mp, s,dep_node_size);
+  } else {
+    if ( (abs(v)>=coef_bound)  && mp->watch_coefs ) { 
+      type(qq)=independent_needing_fix; mp->fix_needed=true;
+    }
+    link(r)=s; r=s;
+  };
+  pp=info(p); q=link(q); qq=info(q);
+}
+
+@ @<Contribute a term from |q|, multiplied by~|f|@>=
+{ 
+  if ( tt==mp_dependent ) v=mp_take_fraction(mp, f,value(q));
+  else v=mp_take_scaled(mp, f,value(q));
+  if ( abs(v)>halfp(threshold) ) { 
+    s=mp_get_node(mp, dep_node_size); info(s)=qq; value(s)=v;
+    if ( (abs(v)>=coef_bound) && mp->watch_coefs ) { 
+      type(qq)=independent_needing_fix; mp->fix_needed=true;
+    }
+    link(r)=s; r=s;
+  }
+  q=link(q); qq=info(q);
+}
+
+@ It is convenient to have another subroutine for the special case
+of |p_plus_fq| when |f=1.0|. In this routine lists |p| and |q| are
+both of the same type~|t| (either |dependent| or |mp_proto_dependent|).
+
+@c pointer mp_p_plus_q (MP mp,pointer p, pointer q, small_number t) {
+  pointer pp,qq; /* |info(p)| and |info(q)|, respectively */
+  pointer r,s; /* for list manipulation */
+  integer threshold; /* defines a neighborhood of zero */
+  integer v; /* temporary register */
+  if ( t==mp_dependent ) threshold=fraction_threshold;
+  else threshold=scaled_threshold;
+  r=temp_head; pp=info(p); qq=info(q);
+  while (1) {
+    if ( pp==qq ) {
+      if ( pp==null ) {
+        break;
+      } else {
+        @<Contribute a term from |p|, plus the
+          corresponding term from |q|@>
+      }
+    } else { 
+	  if ( value(pp)<value(qq) ) {
+        s=mp_get_node(mp, dep_node_size); info(s)=qq; value(s)=value(q);
+        q=link(q); qq=info(q); link(r)=s; r=s;
+      } else { 
+        link(r)=p; r=p; p=link(p); pp=info(p);
+      }
+    }
+  }
+  value(p)=mp_slow_add(mp, value(p),value(q));
+  link(r)=p; mp->dep_final=p; 
+  return link(temp_head);
+}
+
+@ @<Contribute a term from |p|, plus the...@>=
+{ 
+  v=value(p)+value(q);
+  value(p)=v; s=p; p=link(p); pp=info(p);
+  if ( abs(v)<threshold ) {
+    mp_free_node(mp, s,dep_node_size);
+  } else { 
+    if ( (abs(v)>=coef_bound ) && mp->watch_coefs ) {
+      type(qq)=independent_needing_fix; mp->fix_needed=true;
+    }
+    link(r)=s; r=s;
+  }
+  q=link(q); qq=info(q);
+}
+
+@ A somewhat simpler routine will multiply a dependency list
+by a given constant~|v|. The constant is either a |fraction| less than
+|fraction_one|, or it is |scaled|. In the latter case we might be forced to
+convert a dependency list to a proto-dependency list.
+Parameters |t0| and |t1| are the list types before and after;
+they should agree unless |t0=mp_dependent| and |t1=mp_proto_dependent|
+and |v_is_scaled=true|.
+
+@c pointer mp_p_times_v (MP mp,pointer p, integer v, small_number t0,
+                         small_number t1, boolean v_is_scaled) {
+  pointer r,s; /* for list manipulation */
+  integer w; /* tentative coefficient */
+  integer threshold;
+  boolean scaling_down;
+  if ( t0!=t1 ) scaling_down=true; else scaling_down=(!v_is_scaled);
+  if ( t1==mp_dependent ) threshold=half_fraction_threshold;
+  else threshold=half_scaled_threshold;
+  r=temp_head;
+  while ( info(p)!=null ) {    
+    if ( scaling_down ) w=mp_take_fraction(mp, v,value(p));
+    else w=mp_take_scaled(mp, v,value(p));
+    if ( abs(w)<=threshold ) { 
+      s=link(p); mp_free_node(mp, p,dep_node_size); p=s;
+    } else {
+      if ( abs(w)>=coef_bound ) { 
+        mp->fix_needed=true; type(info(p))=independent_needing_fix;
+      }
+      link(r)=p; r=p; value(p)=w; p=link(p);
+    }
+  }
+  link(r)=p;
+  if ( v_is_scaled ) value(p)=mp_take_scaled(mp, value(p),v);
+  else value(p)=mp_take_fraction(mp, value(p),v);
+  return link(temp_head);
+}
+
+@ Similarly, we sometimes need to divide a dependency list
+by a given |scaled| constant.
+
+@<Declare basic dependency-list subroutines@>=
+pointer mp_p_over_v (MP mp,pointer p, scaled v, small_number 
+  t0, small_number t1) ;
+
+@ @c
+pointer mp_p_over_v (MP mp,pointer p, scaled v, small_number 
+  t0, small_number t1) {
+  pointer r,s; /* for list manipulation */
+  integer w; /* tentative coefficient */
+  integer threshold;
+  boolean scaling_down;
+  if ( t0!=t1 ) scaling_down=true; else scaling_down=false;
+  if ( t1==mp_dependent ) threshold=half_fraction_threshold;
+  else threshold=half_scaled_threshold;
+  r=temp_head;
+  while ( info( p)!=null ) {
+    if ( scaling_down ) {
+      if ( abs(v)<02000000 ) w=mp_make_scaled(mp, value(p),v*010000);
+      else w=mp_make_scaled(mp, mp_round_fraction(mp, value(p)),v);
+    } else {
+      w=mp_make_scaled(mp, value(p),v);
+    }
+    if ( abs(w)<=threshold ) {
+      s=link(p); mp_free_node(mp, p,dep_node_size); p=s;
+    } else { 
+      if ( abs(w)>=coef_bound ) {
+         mp->fix_needed=true; type(info(p))=independent_needing_fix;
+      }
+      link(r)=p; r=p; value(p)=w; p=link(p);
+    }
+  }
+  link(r)=p; value(p)=mp_make_scaled(mp, value(p),v);
+  return link(temp_head);
+}
+
+@ Here's another utility routine for dependency lists. When an independent
+variable becomes dependent, we want to remove it from all existing
+dependencies. The |p_with_x_becoming_q| function computes the
+dependency list of~|p| after variable~|x| has been replaced by~|q|.
+
+This procedure has basically the same calling conventions as |p_plus_fq|:
+List~|q| is unchanged; list~|p| is destroyed; the constant node and the
+final link are inherited from~|p|; and the fourth parameter tells whether
+or not |p| is |mp_proto_dependent|. However, the global variable |dep_final|
+is not altered if |x| does not occur in list~|p|.
+
+@c pointer mp_p_with_x_becoming_q (MP mp,pointer p,
+           pointer x, pointer q, small_number t) {
+  pointer r,s; /* for list manipulation */
+  integer v; /* coefficient of |x| */
+  integer sx; /* serial number of |x| */
+  s=p; r=temp_head; sx=value(x);
+  while ( value(info(s))>sx ) { r=s; s=link(s); };
+  if ( info(s)!=x ) { 
+    return p;
+  } else { 
+    link(temp_head)=p; link(r)=link(s); v=value(s);
+    mp_free_node(mp, s,dep_node_size);
+    return mp_p_plus_fq(mp, link(temp_head),v,q,t,mp_dependent);
+  }
+}
+
+@ Here's a simple procedure that reports an error when a variable
+has just received a known value that's out of the required range.
+
+@<Declare basic dependency-list subroutines@>=
+void mp_val_too_big (MP mp,scaled x) ;
+
+@ @c void mp_val_too_big (MP mp,scaled x) { 
+  if ( mp->internal[mp_warning_check]>0 ) { 
+    print_err("Value is too large ("); mp_print_scaled(mp, x); mp_print_char(mp, ')');
+@.Value is too large@>
+    help4("The equation I just processed has given some variable")
+      ("a value of 4096 or more. Continue and I'll try to cope")
+      ("with that big value; but it might be dangerous.")
+      ("(Set warningcheck:=0 to suppress this message.)");
+    mp_error(mp);
+  }
+}
+
+@ When a dependent variable becomes known, the following routine
+removes its dependency list. Here |p| points to the variable, and
+|q| points to the dependency list (which is one node long).
+
+@<Declare basic dependency-list subroutines@>=
+void mp_make_known (MP mp,pointer p, pointer q) ;
+
+@ @c void mp_make_known (MP mp,pointer p, pointer q) {
+  int t; /* the previous type */
+  prev_dep(link(q))=prev_dep(p);
+  link(prev_dep(p))=link(q); t=type(p);
+  type(p)=mp_known; value(p)=value(q); mp_free_node(mp, q,dep_node_size);
+  if ( abs(value(p))>=fraction_one ) mp_val_too_big(mp, value(p));
+  if (( mp->internal[mp_tracing_equations]>0) && mp_interesting(mp, p) ) {
+    mp_begin_diagnostic(mp); mp_print_nl(mp, "#### ");
+@:]]]\#\#\#\#_}{\.{\#\#\#\#}@>
+    mp_print_variable_name(mp, p); 
+    mp_print_char(mp, '='); mp_print_scaled(mp, value(p));
+    mp_end_diagnostic(mp, false);
+  }
+  if (( mp->cur_exp==p ) && mp->cur_type==t ) {
+    mp->cur_type=mp_known; mp->cur_exp=value(p);
+    mp_free_node(mp, p,value_node_size);
+  }
+}
+
+@ The |fix_dependencies| routine is called into action when |fix_needed|
+has been triggered. The program keeps a list~|s| of independent variables
+whose coefficients must be divided by~4.
+
+In unusual cases, this fixup process might reduce one or more coefficients
+to zero, so that a variable will become known more or less by default.
+
+@<Declare basic dependency-list subroutines@>=
+void mp_fix_dependencies (MP mp);
+
+@ @c void mp_fix_dependencies (MP mp) {
+  pointer p,q,r,s,t; /* list manipulation registers */
+  pointer x; /* an independent variable */
+  r=link(dep_head); s=null;
+  while ( r!=dep_head ){ 
+    t=r;
+    @<Run through the dependency list for variable |t|, fixing
+      all nodes, and ending with final link~|q|@>;
+    r=link(q);
+    if ( q==dep_list(t) ) mp_make_known(mp, t,q);
+  }
+  while ( s!=null ) { 
+    p=link(s); x=info(s); free_avail(s); s=p;
+    type(x)=mp_independent; value(x)=value(x)+2;
+  }
+  mp->fix_needed=false;
+}
+
+@ @d independent_being_fixed 1 /* this variable already appears in |s| */
+
+@<Run through the dependency list for variable |t|...@>=
+r=value_loc(t); /* |link(r)=dep_list(t)| */
+while (1) { 
+  q=link(r); x=info(q);
+  if ( x==null ) break;
+  if ( type(x)<=independent_being_fixed ) {
+    if ( type(x)<independent_being_fixed ) {
+      p=mp_get_avail(mp); link(p)=s; s=p;
+      info(s)=x; type(x)=independent_being_fixed;
+    }
+    value(q)=value(q) / 4;
+    if ( value(q)==0 ) {
+      link(r)=link(q); mp_free_node(mp, q,dep_node_size); q=r;
+    }
+  }
+  r=q;
+}
+
+
+@ The |new_dep| routine installs a dependency list~|p| into the value node~|q|,
+linking it into the list of all known dependencies. We assume that
+|dep_final| points to the final node of list~|p|.
+
+@c void mp_new_dep (MP mp,pointer q, pointer p) {
+  pointer r; /* what used to be the first dependency */
+  dep_list(q)=p; prev_dep(q)=dep_head;
+  r=link(dep_head); link(mp->dep_final)=r; prev_dep(r)=mp->dep_final;
+  link(dep_head)=q;
+}
+
+@ Here is one of the ways a dependency list gets started.
+The |const_dependency| routine produces a list that has nothing but
+a constant term.
+
+@c pointer mp_const_dependency (MP mp, scaled v) {
+  mp->dep_final=mp_get_node(mp, dep_node_size);
+  value(mp->dep_final)=v; info(mp->dep_final)=null;
+  return mp->dep_final;
+}
+
+@ And here's a more interesting way to start a dependency list from scratch:
+The parameter to |single_dependency| is the location of an
+independent variable~|x|, and the result is the simple dependency list
+`|x+0|'.
+
+In the unlikely event that the given independent variable has been doubled so
+often that we can't refer to it with a nonzero coefficient,
+|single_dependency| returns the simple list `0'.  This case can be
+recognized by testing that the returned list pointer is equal to
+|dep_final|.
+
+@c pointer mp_single_dependency (MP mp,pointer p) {
+  pointer q; /* the new dependency list */
+  integer m; /* the number of doublings */
+  m=value(p) % s_scale;
+  if ( m>28 ) {
+    return mp_const_dependency(mp, 0);
+  } else { 
+    q=mp_get_node(mp, dep_node_size);
+    value(q)=two_to_the(28-m); info(q)=p;
+    link(q)=mp_const_dependency(mp, 0);
+    return q;
+  }
+}
+
+@ We sometimes need to make an exact copy of a dependency list.
+
+@c pointer mp_copy_dep_list (MP mp,pointer p) {
+  pointer q; /* the new dependency list */
+  q=mp_get_node(mp, dep_node_size); mp->dep_final=q;
+  while (1) { 
+    info(mp->dep_final)=info(p); value(mp->dep_final)=value(p);
+    if ( info(mp->dep_final)==null ) break;
+    link(mp->dep_final)=mp_get_node(mp, dep_node_size);
+    mp->dep_final=link(mp->dep_final); p=link(p);
+  }
+  return q;
+}
+
+@ But how do variables normally become known? Ah, now we get to the heart of the
+equation-solving mechanism. The |linear_eq| procedure is given a |dependent|
+or |mp_proto_dependent| list,~|p|, in which at least one independent variable
+appears. It equates this list to zero, by choosing an independent variable
+with the largest coefficient and making it dependent on the others. The
+newly dependent variable is eliminated from all current dependencies,
+thereby possibly making other dependent variables known.
+
+The given list |p| is, of course, totally destroyed by all this processing.
+
+@c void mp_linear_eq (MP mp, pointer p, small_number t) {
+  pointer q,r,s; /* for link manipulation */
+  pointer x; /* the variable that loses its independence */
+  integer n; /* the number of times |x| had been halved */
+  integer v; /* the coefficient of |x| in list |p| */
+  pointer prev_r; /* lags one step behind |r| */
+  pointer final_node; /* the constant term of the new dependency list */
+  integer w; /* a tentative coefficient */
+   @<Find a node |q| in list |p| whose coefficient |v| is largest@>;
+  x=info(q); n=value(x) % s_scale;
+  @<Divide list |p| by |-v|, removing node |q|@>;
+  if ( mp->internal[mp_tracing_equations]>0 ) {
+    @<Display the new dependency@>;
+  }
+  @<Simplify all existing dependencies by substituting for |x|@>;
+  @<Change variable |x| from |independent| to |dependent| or |known|@>;
+  if ( mp->fix_needed ) mp_fix_dependencies(mp);
+}
+
+@ @<Find a node |q| in list |p| whose coefficient |v| is largest@>=
+q=p; r=link(p); v=value(q);
+while ( info(r)!=null ) { 
+  if ( abs(value(r))>abs(v) ) { q=r; v=value(r); };
+  r=link(r);
+}
+
+@ Here we want to change the coefficients from |scaled| to |fraction|,
+except in the constant term. In the common case of a trivial equation
+like `\.{x=3.14}', we will have |v=-fraction_one|, |q=p|, and |t=mp_dependent|.
+
+@<Divide list |p| by |-v|, removing node |q|@>=
+s=temp_head; link(s)=p; r=p;
+do { 
+  if ( r==q ) {
+    link(s)=link(r); mp_free_node(mp, r,dep_node_size);
+  } else  { 
+    w=mp_make_fraction(mp, value(r),v);
+    if ( abs(w)<=half_fraction_threshold ) {
+      link(s)=link(r); mp_free_node(mp, r,dep_node_size);
+    } else { 
+      value(r)=-w; s=r;
+    }
+  }
+  r=link(s);
+} while (info(r)!=null);
+if ( t==mp_proto_dependent ) {
+  value(r)=-mp_make_scaled(mp, value(r),v);
+} else if ( v!=-fraction_one ) {
+  value(r)=-mp_make_fraction(mp, value(r),v);
+}
+final_node=r; p=link(temp_head)
+
+@ @<Display the new dependency@>=
+if ( mp_interesting(mp, x) ) {
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "## "); 
+  mp_print_variable_name(mp, x);
+@:]]]\#\#_}{\.{\#\#}@>
+  w=n;
+  while ( w>0 ) { mp_print(mp, "*4"); w=w-2;  };
+  mp_print_char(mp, '='); mp_print_dependency(mp, p,mp_dependent); 
+  mp_end_diagnostic(mp, false);
+}
+
+@ @<Simplify all existing dependencies by substituting for |x|@>=
+prev_r=dep_head; r=link(dep_head);
+while ( r!=dep_head ) {
+  s=dep_list(r); q=mp_p_with_x_becoming_q(mp, s,x,p,type(r));
+  if ( info(q)==null ) {
+    mp_make_known(mp, r,q);
+  } else { 
+    dep_list(r)=q;
+    do {  q=link(q); } while (info(q)!=null);
+    prev_r=q;
+  }
+  r=link(prev_r);
+}
+
+@ @<Change variable |x| from |independent| to |dependent| or |known|@>=
+if ( n>0 ) @<Divide list |p| by $2^n$@>;
+if ( info(p)==null ) {
+  type(x)=mp_known;
+  value(x)=value(p);
+  if ( abs(value(x))>=fraction_one ) mp_val_too_big(mp, value(x));
+  mp_free_node(mp, p,dep_node_size);
+  if ( mp->cur_exp==x ) if ( mp->cur_type==mp_independent ) {
+    mp->cur_exp=value(x); mp->cur_type=mp_known;
+    mp_free_node(mp, x,value_node_size);
+  }
+} else { 
+  type(x)=mp_dependent; mp->dep_final=final_node; mp_new_dep(mp, x,p);
+  if ( mp->cur_exp==x ) if ( mp->cur_type==mp_independent ) mp->cur_type=mp_dependent;
+}
+
+@ @<Divide list |p| by $2^n$@>=
+{ 
+  s=temp_head; link(temp_head)=p; r=p;
+  do {  
+    if ( n>30 ) w=0;
+    else w=value(r) / two_to_the(n);
+    if ( (abs(w)<=half_fraction_threshold)&&(info(r)!=null) ) {
+      link(s)=link(r);
+      mp_free_node(mp, r,dep_node_size);
+    } else { 
+      value(r)=w; s=r;
+    }
+    r=link(s);
+  } while (info(s)!=null);
+  p=link(temp_head);
+}
+
+@ The |check_mem| procedure, which is used only when \MP\ is being
+debugged, makes sure that the current dependency lists are well formed.
+
+@<Check the list of linear dependencies@>=
+q=dep_head; p=link(q);
+while ( p!=dep_head ) {
+  if ( prev_dep(p)!=q ) {
+    mp_print_nl(mp, "Bad PREVDEP at "); mp_print_int(mp, p);
+@.Bad PREVDEP...@>
+  }
+  p=dep_list(p);
+  while (1) {
+    r=info(p); q=p; p=link(q);
+    if ( r==null ) break;
+    if ( value(info(p))>=value(r) ) {
+      mp_print_nl(mp, "Out of order at "); mp_print_int(mp, p);
+@.Out of order...@>
+    }
+  }
+}
+
+@* \[25] Dynamic nonlinear equations.
+Variables of numeric type are maintained by the general scheme of
+independent, dependent, and known values that we have just studied;
+and the components of pair and transform variables are handled in the
+same way. But \MP\ also has five other types of values: \&{boolean},
+\&{string}, \&{pen}, \&{path}, and \&{picture}; what about them?
+
+Equations are allowed between nonlinear quantities, but only in a
+simple form. Two variables that haven't yet been assigned values are
+either equal to each other, or they're not.
+
+Before a boolean variable has received a value, its type is |mp_unknown_boolean|;
+similarly, there are variables whose type is |mp_unknown_string|, |mp_unknown_pen|,
+|mp_unknown_path|, and |mp_unknown_picture|. In such cases the value is either
+|null| (which means that no other variables are equivalent to this one), or
+it points to another variable of the same undefined type. The pointers in the
+latter case form a cycle of nodes, which we shall call a ``ring.''
+Rings of undefined variables may include capsules, which arise as
+intermediate results within expressions or as \&{expr} parameters to macros.
+
+When one member of a ring receives a value, the same value is given to
+all the other members. In the case of paths and pictures, this implies
+making separate copies of a potentially large data structure; users should
+restrain their enthusiasm for such generality, unless they have lots and
+lots of memory space.
+
+@ The following procedure is called when a capsule node is being
+added to a ring (e.g., when an unknown variable is mentioned in an expression).
+
+@c pointer mp_new_ring_entry (MP mp,pointer p) {
+  pointer q; /* the new capsule node */
+  q=mp_get_node(mp, value_node_size); name_type(q)=mp_capsule;
+  type(q)=type(p);
+  if ( value(p)==null ) value(q)=p; else value(q)=value(p);
+  value(p)=q;
+  return q;
+}
+
+@ Conversely, we might delete a capsule or a variable before it becomes known.
+The following procedure simply detaches a quantity from its ring,
+without recycling the storage.
+
+@<Declare the recycling subroutines@>=
+void mp_ring_delete (MP mp,pointer p) {
+  pointer q; 
+  q=value(p);
+  if ( q!=null ) if ( q!=p ){ 
+    while ( value(q)!=p ) q=value(q);
+    value(q)=value(p);
+  }
+}
+
+@ Eventually there might be an equation that assigns values to all of the
+variables in a ring. The |nonlinear_eq| subroutine does the necessary
+propagation of values.
+
+If the parameter |flush_p| is |true|, node |p| itself needn't receive a
+value, it will soon be recycled.
+
+@c void mp_nonlinear_eq (MP mp,integer v, pointer p, boolean flush_p) {
+  small_number t; /* the type of ring |p| */
+  pointer q,r; /* link manipulation registers */
+  t=type(p)-unknown_tag; q=value(p);
+  if ( flush_p ) type(p)=mp_vacuous; else p=q;
+  do {  
+    r=value(q); type(q)=t;
+    switch (t) {
+    case mp_boolean_type: value(q)=v; break;
+    case mp_string_type: value(q)=v; add_str_ref(v); break;
+    case mp_pen_type: value(q)=copy_pen(v); break;
+    case mp_path_type: value(q)=mp_copy_path(mp, v); break;
+    case mp_picture_type: value(q)=v; add_edge_ref(v); break;
+    } /* there ain't no more cases */
+    q=r;
+  } while (q!=p);
+}
+
+@ If two members of rings are equated, and if they have the same type,
+the |ring_merge| procedure is called on to make them equivalent.
+
+@c void mp_ring_merge (MP mp,pointer p, pointer q) {
+  pointer r; /* traverses one list */
+  r=value(p);
+  while ( r!=p ) {
+    if ( r==q ) {
+      @<Exclaim about a redundant equation@>;
+      return;
+    };
+    r=value(r);
+  }
+  r=value(p); value(p)=value(q); value(q)=r;
+}
+
+@ @<Exclaim about a redundant equation@>=
+{ 
+  print_err("Redundant equation");
+@.Redundant equation@>
+  help2("I already knew that this equation was true.")
+   ("But perhaps no harm has been done; let's continue.");
+  mp_put_get_error(mp);
+}
+
+@* \[26] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \MP\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+while parsing expressions and locating operators and operands. The
+semantic routines act as an interpreter responding to these operators,
+which may be regarded as commands. And the output routines are
+periodically called on to produce compact font descriptions that can be
+used for typesetting or for making interim proof drawings. We have
+discussed the basic data structures and many of the details of semantic
+operations, so we are good and ready to plunge into the part of \MP\ that
+actually controls the activities.
+
+Our current goal is to come to grips with the |get_next| procedure,
+which is the keystone of \MP's input mechanism. Each call of |get_next|
+sets the value of three variables |cur_cmd|, |cur_mod|, and |cur_sym|,
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+  \hbox{|cur_cmd| denotes a command code from the long list of codes
+   given earlier;}\cr
+  \hbox{|cur_mod| denotes a modifier of the command code;}\cr
+  \hbox{|cur_sym| is the hash address of the symbolic token that was
+   just scanned,}\cr
+  \hbox{\qquad or zero in the case of a numeric or string
+   or capsule token.}\cr}}$$
+Underlying this external behavior of |get_next| is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \&{input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished reading some text that the user has inserted online,
+and so on. When reading a character file, the characters must be
+converted to tokens; comments and blank spaces must
+be removed, numeric and string tokens must be evaluated.
+
+To handle these situations, which might all be present simultaneously,
+\MP\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the |get_next| procedure is not recursive.
+
+@<Glob...@>=
+eight_bits cur_cmd; /* current command set by |get_next| */
+integer cur_mod; /* operand of current command */
+halfword cur_sym; /* hash address of current symbol */
+
+@ The |print_cmd_mod| routine prints a symbolic interpretation of a
+command code and its modifier.
+It consists of a rather tedious sequence of print
+commands, and most of it is essentially an inverse to the |primitive|
+routine that enters a \MP\ primitive into |hash| and |eqtb|. Therefore almost
+all of this procedure appears elsewhere in the program, together with the
+corresponding |primitive| calls.
+
+@<Declare the procedure called |print_cmd_mod|@>=
+void mp_print_cmd_mod (MP mp,integer c, integer m) { 
+ switch (c) {
+  @<Cases of |print_cmd_mod| for symbolic printing of primitives@>
+  default: mp_print(mp, "[unknown command code!]"); break;
+  }
+}
+
+@ Here is a procedure that displays a given command in braces, in the
+user's transcript file.
+
+@d show_cur_cmd_mod mp_show_cmd_mod(mp, mp->cur_cmd,mp->cur_mod)
+
+@c 
+void mp_show_cmd_mod (MP mp,integer c, integer m) { 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{");
+  mp_print_cmd_mod(mp, c,m); mp_print_char(mp, '}');
+  mp_end_diagnostic(mp, false);
+}
+
+@* \[27] Input stacks and states.
+The state of \MP's input mechanism appears in the input stack, whose
+entries are records with five fields, called |index|, |start|, |loc|,
+|limit|, and |name|. The top element of this stack is maintained in a
+global variable for which no subscripting needs to be done; the other
+elements of the stack appear in an array. Hence the stack is declared thus:
+
+@<Types...@>=
+typedef struct {
+  quarterword index_field;
+  halfword start_field, loc_field, limit_field, name_field;
+} in_state_record;
+
+@ @<Glob...@>=
+in_state_record *input_stack;
+integer input_ptr; /* first unused location of |input_stack| */
+integer max_in_stack; /* largest value of |input_ptr| when pushing */
+in_state_record cur_input; /* the ``top'' input state */
+int stack_size; /* maximum number of simultaneous input sources */
+
+@ @<Allocate or initialize ...@>=
+mp->stack_size = 300;
+mp->input_stack = xmalloc((mp->stack_size+1),sizeof(in_state_record));
+
+@ @<Dealloc variables@>=
+xfree(mp->input_stack);
+
+@ We've already defined the special variable |loc==cur_input.loc_field|
+in our discussion of basic input-output routines. The other components of
+|cur_input| are defined in the same way:
+
+@d index mp->cur_input.index_field /* reference for buffer information */
+@d start mp->cur_input.start_field /* starting position in |buffer| */
+@d limit mp->cur_input.limit_field /* end of current line in |buffer| */
+@d name mp->cur_input.name_field /* name of the current file */
+
+@ Let's look more closely now at the five control variables
+(|index|,~|start|,~|loc|,~|limit|,~|name|),
+assuming that \MP\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+|buffer| that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \MP\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it would be
+appropriate to combine |buffer| with the |str_pool| array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the
+buffer; the next character we are about to read is |buffer[loc]|; and
+|limit| is the location of the last character present. We always have
+|loc<=limit|. For convenience, |buffer[limit]| has been set to |"%"|, so
+that the end of a line is easily sensed.
+
+The |name| variable is a string number that designates the name of
+the current file, if we are reading an ordinary text file.  Special codes
+|is_term..max_spec_src| indicate other sources of input text.
+
+@d is_term 0 /* |name| value when reading from the terminal for normal input */
+@d is_read 1 /* |name| value when executing a \&{readstring} or \&{readfrom} */
+@d is_scantok 2 /* |name| value when reading text generated by \&{scantokens} */
+@d max_spec_src is_scantok
+
+@ Additional information about the current line is available via the
+|index| variable, which counts how many lines of characters are present
+in the buffer below the current level. We have |index=0| when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{input figs}', we will have |index=1| while reading
+the file \.{figs.mp}. However, it does not follow that |index| is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists and some |index| values may correspond
+to \.{MPX} files that are not currently on the stack.
+
+The global variable |in_open| is equal to the highest |index| value counting
+\.{MPX} files but excluding token-list input levels.  Thus, the number of
+partially read lines in the buffer is |in_open+1| and we have |in_open>=index|
+when we are not reading a token list.
+
+If we are not currently reading from the terminal,
+we are reading from the file variable |input_file[index]|. We use
+the notation |terminal_input| as a convenient abbreviation for |name=is_term|,
+and |cur_file| as an abbreviation for |input_file[index]|.
+
+When \MP\ is not reading from the terminal, the global variable |line| contains
+the line number in the current file, for use in error messages. More precisely,
+|line| is a macro for |line_stack[index]| and the |line_stack| array gives
+the line number for each file in the |input_file| array.
+
+When an \.{MPX} file is opened the file name is stored in the |mpx_name|
+array so that the name doesn't get lost when the file is temporarily removed
+from the input stack.
+Thus when |input_file[k]| is an \.{MPX} file, its name is |mpx_name[k]|
+and it contains translated \TeX\ pictures for |input_file[k-1]|.
+Since this is not an \.{MPX} file, we have
+$$ \hbox{|mpx_name[k-1]<=absent|}. $$
+This |name| field is set to |finished| when |input_file[k]| is completely
+read.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be put
+into a variable |page|, that is really a macro for the current entry
+in `\ignorespaces|page_stack:array[0..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@^system dependencies@>
+
+@d terminal_input (name==is_term) /* are we reading from the terminal? */
+@d cur_file mp->input_file[index] /* the current |void *| variable */
+@d line mp->line_stack[index] /* current line number in the current source file */
+@d in_name mp->iname_stack[index] /* a string used to construct \.{MPX} file names */
+@d in_area mp->iarea_stack[index] /* another string for naming \.{MPX} files */
+@d absent 1 /* |name_field| value for unused |mpx_in_stack| entries */
+@d mpx_reading (mp->mpx_name[index]>absent)
+  /* when reading a file, is it an \.{MPX} file? */
+@d finished 0
+  /* |name_field| value when the corresponding \.{MPX} file is finished */
+
+@<Glob...@>=
+integer in_open; /* the number of lines in the buffer, less one */
+unsigned int open_parens; /* the number of open text files */
+void  * *input_file ;
+integer *line_stack ; /* the line number for each file */
+char *  *iname_stack; /* used for naming \.{MPX} files */
+char *  *iarea_stack; /* used for naming \.{MPX} files */
+halfword*mpx_name  ;
+
+@ @<Allocate or ...@>=
+mp->input_file  = xmalloc((mp->max_in_open+1),sizeof(void *));
+mp->line_stack  = xmalloc((mp->max_in_open+1),sizeof(integer));
+mp->iname_stack = xmalloc((mp->max_in_open+1),sizeof(char *));
+mp->iarea_stack = xmalloc((mp->max_in_open+1),sizeof(char *));
+mp->mpx_name    = xmalloc((mp->max_in_open+1),sizeof(halfword));
+{
+  int k;
+  for (k=0;k<=mp->max_in_open;k++) {
+    mp->iname_stack[k] =NULL;
+    mp->iarea_stack[k] =NULL;
+  }
+}
+
+@ @<Dealloc variables@>=
+{
+  int l;
+  for (l=0;l<=mp->max_in_open;l++) {
+    xfree(mp->iname_stack[l]);
+    xfree(mp->iarea_stack[l]);
+  }
+}
+xfree(mp->input_file);
+xfree(mp->line_stack);
+xfree(mp->iname_stack);
+xfree(mp->iarea_stack);
+xfree(mp->mpx_name);
+
+
+@ However, all this discussion about input state really applies only to the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+|index>max_in_open|, and the conventions about the other state variables
+are different:
+
+\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If |loc=null|, the token list has been
+fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang|token_type|, which takes the place of |index| in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence
+being expanded, if the current token list is a macro not defined by
+\&{vardef}. Macros defined by \&{vardef} have |name=null|; their name
+can be deduced by looking at their first two parameters.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where
+the parameters of the current macro or loop text begin in the |param_stack|.
+
+\yskip\noindent The |token_type| can take several values, depending on
+where the current token list came from:
+
+\yskip
+\indent|forever_text|, if the token list being scanned is the body of
+a \&{forever} loop;
+
+\indent|loop_text|, if the token list being scanned is the body of
+a \&{for} or \&{forsuffixes} loop;
+
+\indent|parameter|, if a \&{text} or \&{suffix} parameter is being scanned;
+
+\indent|backed_up|, if the token list being scanned has been inserted as
+`to be read again'.
+
+\indent|inserted|, if the token list being scanned has been inserted as
+part of error recovery;
+
+\indent|macro|, if the expansion of a user-defined symbolic token is being
+scanned.
+
+\yskip\noindent
+The token list begins with a reference count if and only if |token_type=
+macro|.
+@^reference counts@>
+
+@d token_type index /* type of current token list */
+@d token_state (index>(int)mp->max_in_open) /* are we scanning a token list? */
+@d file_state (index<=(int)mp->max_in_open) /* are we scanning a file line? */
+@d param_start limit /* base of macro parameters in |param_stack| */
+@d forever_text (mp->max_in_open+1) /* |token_type| code for loop texts */
+@d loop_text (mp->max_in_open+2) /* |token_type| code for loop texts */
+@d parameter (mp->max_in_open+3) /* |token_type| code for parameter texts */
+@d backed_up (mp->max_in_open+4) /* |token_type| code for texts to be reread */
+@d inserted (mp->max_in_open+5) /* |token_type| code for inserted texts */
+@d macro (mp->max_in_open+6) /* |token_type| code for macro replacement texts */
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input.
+This stack grows at a different rate from the others.
+
+@<Glob...@>=
+pointer *param_stack;  /* token list pointers for parameters */
+integer param_ptr; /* first unused entry in |param_stack| */
+integer max_param_stack;  /* largest value of |param_ptr| */
+
+@ @<Allocate or initialize ...@>=
+mp->param_stack = xmalloc((mp->param_size+1),sizeof(pointer));
+
+@ @<Dealloc variables@>=
+xfree(mp->param_stack);
+
+@ Notice that the |line| isn't valid when |token_state| is true because it
+depends on |index|.  If we really need to know the line number for the
+topmost file in the index stack we use the following function.  If a page
+number or other information is needed, this routine should be modified to
+compute it as well.
+@^system dependencies@>
+
+@<Declare a function called |true_line|@>=
+integer mp_true_line (MP mp) {
+  int k; /* an index into the input stack */
+  if ( file_state && (name>max_spec_src) ) {
+    return line;
+  } else { 
+    k=mp->input_ptr;
+    while ((k>0) &&
+           ((mp->input_stack[(k-1)].index_field>mp->max_in_open)||
+            (mp->input_stack[(k-1)].name_field<=max_spec_src))) {
+      decr(k);
+    }
+    return (k>0 ? mp->line_stack[(k-1)] : 0 );
+  }
+}
+
+@ Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+|show_context| procedure, which is used by \MP's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable |file_ptr| contains the lowest level that was
+displayed by this procedure.
+
+@<Glob...@>=
+integer file_ptr; /* shallowest level shown by |show_context| */
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most |half_error_line| characters, and the second contains
+at most |error_line|. Non-current input levels whose |token_type| is
+`|backed_up|' are shown only if they have not been fully read.
+
+@c void mp_show_context (MP mp) { /* prints where the scanner is */
+  int old_setting; /* saved |selector| setting */
+  @<Local variables for formatting calculations@>
+  mp->file_ptr=mp->input_ptr; mp->input_stack[mp->file_ptr]=mp->cur_input;
+  /* store current state */
+  while (1) { 
+    mp->cur_input=mp->input_stack[mp->file_ptr]; /* enter into the context */
+    @<Display the current context@>;
+    if ( file_state )
+      if ( (name>max_spec_src) || (mp->file_ptr==0) ) break;
+    decr(mp->file_ptr);
+  }
+  mp->cur_input=mp->input_stack[mp->input_ptr]; /* restore original state */
+}
+
+@ @<Display the current context@>=
+if ( (mp->file_ptr==mp->input_ptr) || file_state ||
+   (token_type!=backed_up) || (loc!=null) ) {
+    /* we omit backed-up token lists that have already been read */
+  mp->tally=0; /* get ready to count characters */
+  old_setting=mp->selector;
+  if ( file_state ) {
+    @<Print location of current line@>;
+    @<Pseudoprint the line@>;
+  } else { 
+    @<Print type of token list@>;
+    @<Pseudoprint the token list@>;
+  }
+  mp->selector=old_setting; /* stop pseudoprinting */
+  @<Print two lines using the tricky pseudoprinted information@>;
+}
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+@^system dependencies@>
+
+@<Print location of current line@>=
+if ( name>max_spec_src ) {
+  mp_print_nl(mp, "l."); mp_print_int(mp, mp_true_line(mp));
+} else if ( terminal_input ) {
+  if ( mp->file_ptr==0 ) mp_print_nl(mp, "<*>");
+  else mp_print_nl(mp, "<insert>");
+} else if ( name==is_scantok ) {
+  mp_print_nl(mp, "<scantokens>");
+} else {
+  mp_print_nl(mp, "<read>");
+}
+mp_print_char(mp, ' ')
+
+@ Can't use case statement here because the |token_type| is not
+a constant expression.
+
+@<Print type of token list@>=
+{
+  if(token_type==forever_text) {
+    mp_print_nl(mp, "<forever> ");
+  } else if (token_type==loop_text) {
+    @<Print the current loop value@>;
+  } else if (token_type==parameter) {
+    mp_print_nl(mp, "<argument> "); 
+  } else if (token_type==backed_up) { 
+    if ( loc==null ) mp_print_nl(mp, "<recently read> ");
+    else mp_print_nl(mp, "<to be read again> ");
+  } else if (token_type==inserted) {
+    mp_print_nl(mp, "<inserted text> ");
+  } else if (token_type==macro) {
+    mp_print_ln(mp);
+    if ( name!=null ) mp_print_text(name);
+    else @<Print the name of a \&{vardef}'d macro@>;
+    mp_print(mp, "->");
+  } else {
+    mp_print_nl(mp, "?");/* this should never happen */
+@.?\relax@>
+  }
+}
+
+@ The parameter that corresponds to a loop text is either a token list
+(in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}).
+We'll discuss capsules later; for now, all we need to know is that
+the |link| field in a capsule parameter is |void| and that
+|print_exp(p,0)| displays the value of capsule~|p| in abbreviated form.
+
+@<Print the current loop value@>=
+{ mp_print_nl(mp, "<for("); p=mp->param_stack[param_start];
+  if ( p!=null ) {
+    if ( link(p)==mp_void ) mp_print_exp(mp, p,0); /* we're in a \&{for} loop */
+    else mp_show_token_list(mp, p,null,20,mp->tally);
+  }
+  mp_print(mp, ")> ");
+}
+
+@ The first two parameters of a macro defined by \&{vardef} will be token
+lists representing the macro's prefix and ``at point.'' By putting these
+together, we get the macro's full name.
+
+@<Print the name of a \&{vardef}'d macro@>=
+{ p=mp->param_stack[param_start];
+  if ( p==null ) {
+    mp_show_token_list(mp, mp->param_stack[param_start+1],null,20,mp->tally);
+  } else { 
+    q=p;
+    while ( link(q)!=null ) q=link(q);
+    link(q)=mp->param_stack[param_start+1];
+    mp_show_token_list(mp, p,null,20,mp->tally);
+    link(q)=null;
+  }
+}
+
+@ Now it is necessary to explain a little trick. We don't want to store a long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \MP's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length |error_line|, where character
+$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
+|k<trick_count|, otherwise character |k| is dropped. Initially we set
+|tally:=0| and |trick_count:=1000000|; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
+tally+1+error_line-half_error_line)|. At the end of the
+pseudoprinting, the values of |first_count|, |tally|, and
+|trick_count| give us all the information we need to print the two lines,
+and all of the necessary text is in |trick_buf|.
+
+Namely, let |l| be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is |k=first_count|, and the length of the context information
+gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
+where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
+descriptive information on line~1, and set |n:=l+k|; here |n| is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
+and print `\.{...}' followed by
+$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
+where subscripts of |trick_buf| are circular modulo |error_line|. The
+second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
+unless |n+m>error_line|; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+@<Local variables for formatting...@>=
+int i; /* index into |buffer| */
+integer l; /* length of descriptive information on line 1 */
+integer m; /* context information gathered for line 2 */
+int n; /* length of line 1 */
+integer p; /* starting or ending place in |trick_buf| */
+integer q; /* temporary index */
+
+@ The following code tells the print routines to gather
+the desired information.
+
+@d begin_pseudoprint { 
+  l=mp->tally; mp->tally=0; mp->selector=pseudo;
+  mp->trick_count=1000000;
+}
+@d set_trick_count {
+  mp->first_count=mp->tally;
+  mp->trick_count=mp->tally+1+mp->error_line-mp->half_error_line;
+  if ( mp->trick_count<mp->error_line ) mp->trick_count=mp->error_line;
+}
+
+@ And the following code uses the information after it has been gathered.
+
+@<Print two lines using the tricky pseudoprinted information@>=
+if ( mp->trick_count==1000000 ) set_trick_count;
+  /* |set_trick_count| must be performed */
+if ( mp->tally<mp->trick_count ) m=mp->tally-mp->first_count;
+else m=mp->trick_count-mp->first_count; /* context on line 2 */
+if ( l+mp->first_count<=mp->half_error_line ) {
+  p=0; n=l+mp->first_count;
+} else  { 
+  mp_print(mp, "..."); p=l+mp->first_count-mp->half_error_line+3;
+  n=mp->half_error_line;
+}
+for (q=p;q<=mp->first_count-1;q++) {
+  mp_print_char(mp, mp->trick_buf[q % mp->error_line]);
+}
+mp_print_ln(mp);
+for (q=1;q<=n;q++) {
+  mp_print_char(mp, ' '); /* print |n| spaces to begin line~2 */
+}
+if ( m+n<=mp->error_line ) p=mp->first_count+m; 
+else p=mp->first_count+(mp->error_line-n-3);
+for (q=mp->first_count;q<=p-1;q++) {
+  mp_print_char(mp, mp->trick_buf[q % mp->error_line]);
+}
+if ( m+n>mp->error_line ) mp_print(mp, "...")
+
+@ But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the |show_context| procedure.
+
+@<Pseudoprint the line@>=
+begin_pseudoprint;
+if ( limit>0 ) {
+  for (i=start;i<=limit-1;i++) {
+    if ( i==loc ) set_trick_count;
+    mp_print_str(mp, mp->buffer[i]);
+  }
+}
+
+@ @<Pseudoprint the token list@>=
+begin_pseudoprint;
+if ( token_type!=macro ) mp_show_token_list(mp, start,loc,100000,0);
+else mp_show_macro(mp, start,loc,100000)
+
+@ Here is the missing piece of |show_token_list| that is activated when the
+token beginning line~2 is about to be shown:
+
+@<Do magic computation@>=set_trick_count
+
+@* \[28] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes |push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+@d push_input  { /* enter a new input level, save the old */
+  if ( mp->input_ptr>mp->max_in_stack ) {
+    mp->max_in_stack=mp->input_ptr;
+    if ( mp->input_ptr==mp->stack_size ) {
+      int l = (mp->stack_size+(mp->stack_size>>2));
+      XREALLOC(mp->input_stack, l, in_state_record);
+      mp->stack_size = l;
+    }         
+  }
+  mp->input_stack[mp->input_ptr]=mp->cur_input; /* stack the record */
+  incr(mp->input_ptr);
+}
+
+@ And of course what goes up must come down.
+
+@d pop_input { /* leave an input level, re-enter the old */
+    decr(mp->input_ptr); mp->cur_input=mp->input_stack[mp->input_ptr];
+  }
+
+@ Here is a procedure that starts a new level of token-list input, given
+a token list |p| and its type |t|. If |t=macro|, the calling routine should
+set |name|, reset~|loc|, and increase the macro's reference count.
+
+@d back_list(A) mp_begin_token_list(mp, (A),backed_up) /* backs up a simple token list */
+
+@c void mp_begin_token_list (MP mp,pointer p, quarterword t)  { 
+  push_input; start=p; token_type=t;
+  param_start=mp->param_ptr; loc=p;
+}
+
+@ When a token list has been fully scanned, the following computations
+should be done as we leave that level of input.
+@^inner loop@>
+
+@c void mp_end_token_list (MP mp) { /* leave a token-list input level */
+  pointer p; /* temporary register */
+  if ( token_type>=backed_up ) { /* token list to be deleted */
+    if ( token_type<=inserted ) { 
+      mp_flush_token_list(mp, start); goto DONE;
+    } else {
+      mp_delete_mac_ref(mp, start); /* update reference count */
+    }
+  }
+  while ( mp->param_ptr>param_start ) { /* parameters must be flushed */
+    decr(mp->param_ptr);
+    p=mp->param_stack[mp->param_ptr];
+    if ( p!=null ) {
+      if ( link(p)==mp_void ) { /* it's an \&{expr} parameter */
+        mp_recycle_value(mp, p); mp_free_node(mp, p,value_node_size);
+      } else {
+        mp_flush_token_list(mp, p); /* it's a \&{suffix} or \&{text} parameter */
+      }
+    }
+  }
+DONE: 
+  pop_input; check_interrupt;
+}
+
+@ The contents of |cur_cmd,cur_mod,cur_sym| are placed into an equivalent
+token by the |cur_tok| routine.
+@^inner loop@>
+
+@c @<Declare the procedure called |make_exp_copy|@>
+pointer mp_cur_tok (MP mp) {
+  pointer p; /* a new token node */
+  small_number save_type; /* |cur_type| to be restored */
+  integer save_exp; /* |cur_exp| to be restored */
+  if ( mp->cur_sym==0 ) {
+    if ( mp->cur_cmd==capsule_token ) {
+      save_type=mp->cur_type; save_exp=mp->cur_exp;
+      mp_make_exp_copy(mp, mp->cur_mod); p=mp_stash_cur_exp(mp); link(p)=null;
+      mp->cur_type=save_type; mp->cur_exp=save_exp;
+    } else { 
+      p=mp_get_node(mp, token_node_size);
+      value(p)=mp->cur_mod; name_type(p)=mp_token;
+      if ( mp->cur_cmd==numeric_token ) type(p)=mp_known;
+      else type(p)=mp_string_type;
+    }
+  } else { 
+    fast_get_avail(p); info(p)=mp->cur_sym;
+  }
+  return p;
+}
+
+@ Sometimes \MP\ has read too far and wants to ``unscan'' what it has
+seen. The |back_input| procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again.
+If |cur_sym<>0|, the values of |cur_cmd| and |cur_mod| are irrelevant.
+
+@<Declarations@>= 
+void mp_back_input (MP mp);
+
+@ @c void mp_back_input (MP mp) {/* undoes one token of input */
+  pointer p; /* a token list of length one */
+  p=mp_cur_tok(mp);
+  while ( token_state &&(loc==null) ) 
+    mp_end_token_list(mp); /* conserve stack space */
+  back_list(p);
+}
+
+@ The |back_error| routine is used when we want to restore or replace an
+offending token just before issuing an error message.  We disable interrupts
+during the call of |back_input| so that the help message won't be lost.
+
+@<Declarations@>=
+void mp_error (MP mp);
+void mp_back_error (MP mp);
+
+@ @c void mp_back_error (MP mp) { /* back up one token and call |error| */
+  mp->OK_to_interrupt=false; 
+  mp_back_input(mp); 
+  mp->OK_to_interrupt=true; mp_error(mp);
+}
+void mp_ins_error (MP mp) { /* back up one inserted token and call |error| */
+  mp->OK_to_interrupt=false; 
+  mp_back_input(mp); token_type=inserted;
+  mp->OK_to_interrupt=true; mp_error(mp);
+}
+
+@ The |begin_file_reading| procedure starts a new level of input for lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set |loc|
+or |limit| or |line|.
+@^system dependencies@>
+
+@c void mp_begin_file_reading (MP mp) { 
+  if ( mp->in_open==mp->max_in_open ) 
+    mp_overflow(mp, "text input levels",mp->max_in_open);
+@:MetaPost capacity exceeded text input levels}{\quad text input levels@>
+  if ( mp->first==mp->buf_size ) 
+    mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size>>2)));
+  incr(mp->in_open); push_input; index=mp->in_open;
+  mp->mpx_name[index]=absent;
+  start=mp->first;
+  name=is_term; /* |terminal_input| is now |true| */
+}
+
+@ Conversely, the variables must be downdated when such a level of input
+is finished.  Any associated \.{MPX} file must also be closed and popped
+off the file stack.
+
+@c void mp_end_file_reading (MP mp) { 
+  if ( mp->in_open>index ) {
+    if ( (mp->mpx_name[mp->in_open]==absent)||(name<=max_spec_src) ) {
+      mp_confusion(mp, "endinput");
+@:this can't happen endinput}{\quad endinput@>
+    } else { 
+      (mp->close_file)(mp,mp->input_file[mp->in_open]); /* close an \.{MPX} file */
+      delete_str_ref(mp->mpx_name[mp->in_open]);
+      decr(mp->in_open);
+    }
+  }
+  mp->first=start;
+  if ( index!=mp->in_open ) mp_confusion(mp, "endinput");
+  if ( name>max_spec_src ) {
+    (mp->close_file)(mp,cur_file);
+    delete_str_ref(name);
+    xfree(in_name); 
+    xfree(in_area);
+  }
+  pop_input; decr(mp->in_open);
+}
+
+@ Here is a function that tries to resume input from an \.{MPX} file already
+associated with the current input file.  It returns |false| if this doesn't
+work.
+
+@c boolean mp_begin_mpx_reading (MP mp) { 
+  if ( mp->in_open!=index+1 ) {
+     return false;
+  } else { 
+    if ( mp->mpx_name[mp->in_open]<=absent ) mp_confusion(mp, "mpx");
+@:this can't happen mpx}{\quad mpx@>
+    if ( mp->first==mp->buf_size ) 
+      mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size>>2)));
+    push_input; index=mp->in_open;
+    start=mp->first;
+    name=mp->mpx_name[mp->in_open]; add_str_ref(name);
+    @<Put an empty line in the input buffer@>;
+    return true;
+  }
+}
+
+@ This procedure temporarily stops reading an \.{MPX} file.
+
+@c void mp_end_mpx_reading (MP mp) { 
+  if ( mp->in_open!=index ) mp_confusion(mp, "mpx");
+@:this can't happen mpx}{\quad mpx@>
+  if ( loc<limit ) {
+    @<Complain that we are not at the end of a line in the \.{MPX} file@>;
+  }
+  mp->first=start;
+  pop_input;
+}
+
+@ Here we enforce a restriction that simplifies the input stacks considerably.
+This should not inconvenience the user because \.{MPX} files are generated
+by an auxiliary program called \.{DVItoMP}.
+
+@ @<Complain that we are not at the end of a line in the \.{MPX} file@>=
+{ 
+print_err("`mpxbreak' must be at the end of a line");
+help4("This file contains picture expressions for btex...etex")
+  ("blocks.  Such files are normally generated automatically")
+  ("but this one seems to be messed up.  I'm going to ignore")
+  ("the rest of this line.");
+mp_error(mp);
+}
+
+@ In order to keep the stack from overflowing during a long sequence of
+inserted `\.{show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+@c void mp_clear_for_error_prompt (MP mp) { 
+  while ( file_state && terminal_input &&
+    (mp->input_ptr>0)&&(loc==limit) ) mp_end_file_reading(mp);
+  mp_print_ln(mp); clear_terminal;
+}
+
+@ To get \MP's whole input mechanism going, we perform the following
+actions.
+
+@<Initialize the input routines@>=
+{ mp->input_ptr=0; mp->max_in_stack=0;
+  mp->in_open=0; mp->open_parens=0; mp->max_buf_stack=0;
+  mp->param_ptr=0; mp->max_param_stack=0;
+  mp->first=1;
+  start=1; index=0; line=0; name=is_term;
+  mp->mpx_name[0]=absent;
+  mp->force_eof=false;
+  if ( ! mp_init_terminal(mp) ) mp_jump_out(mp);
+  limit=mp->last; mp->first=mp->last+1; 
+  /* |init_terminal| has set |loc| and |last| */
+}
+
+@* \[29] Getting the next token.
+The heart of \MP's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however; it really acts as \MP's
+eyes and mouth, reading the source files and gobbling them up. And it also
+helps \MP\ to regurgitate stored token lists that are to be processed again.
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_mod| to that token's command code and modifier. Furthermore, if
+the input token is a symbolic token, that token's |hash| address
+is stored in |cur_sym|; otherwise |cur_sym| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+@ Before getting into |get_next|, we need to consider a mechanism by which
+\MP\ helps keep errors from propagating too far. Whenever the program goes
+into a mode where it keeps calling |get_next| repeatedly until a certain
+condition is met, it sets |scanner_status| to some value other than |normal|.
+Then if an input file ends, or if an `\&{outer}' symbol appears,
+an appropriate error recovery will be possible.
+
+The global variable |warning_info| helps in this error recovery by providing
+additional information. For example, |warning_info| might indicate the
+name of a macro whose replacement text is being scanned.
+
+@d normal 0 /* |scanner_status| at ``quiet times'' */
+@d skipping 1 /* |scanner_status| when false conditional text is being skipped */
+@d flushing 2 /* |scanner_status| when junk after a statement is being ignored */
+@d absorbing 3 /* |scanner_status| when a \&{text} parameter is being scanned */
+@d var_defining 4 /* |scanner_status| when a \&{vardef} is being scanned */
+@d op_defining 5 /* |scanner_status| when a macro \&{def} is being scanned */
+@d loop_defining 6 /* |scanner_status| when a \&{for} loop is being scanned */
+@d tex_flushing 7 /* |scanner_status| when skipping \TeX\ material */
+
+@<Glob...@>=
+integer scanner_status; /* are we scanning at high speed? */
+integer warning_info; /* if so, what else do we need to know,
+    in case an error occurs? */
+
+@ @<Initialize the input routines@>=
+mp->scanner_status=normal;
+
+@ The following subroutine
+is called when an `\&{outer}' symbolic token has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by |cur_sym|, which is zero at the end of a file.
+
+@c boolean mp_check_outer_validity (MP mp) {
+  pointer p; /* points to inserted token list */
+  if ( mp->scanner_status==normal ) {
+    return true;
+  } else if ( mp->scanner_status==tex_flushing ) {
+    @<Check if the file has ended while flushing \TeX\ material and set the
+      result value for |check_outer_validity|@>;
+  } else { 
+    mp->deletions_allowed=false;
+    @<Back up an outer symbolic token so that it can be reread@>;
+    if ( mp->scanner_status>skipping ) {
+      @<Tell the user what has run away and try to recover@>;
+    } else { 
+      print_err("Incomplete if; all text was ignored after line ");
+@.Incomplete if...@>
+      mp_print_int(mp, mp->warning_info);
+      help3("A forbidden `outer' token occurred in skipped text.")
+        ("This kind of error happens when you say `if...' and forget")
+        ("the matching `fi'. I've inserted a `fi'; this might work.");
+      if ( mp->cur_sym==0 ) 
+        mp->help_line[2]="The file ended while I was skipping conditional text.";
+      mp->cur_sym=frozen_fi; mp_ins_error(mp);
+    }
+    mp->deletions_allowed=true; 
+	return false;
+  }
+}
+
+@ @<Check if the file has ended while flushing \TeX\ material and set...@>=
+if ( mp->cur_sym!=0 ) { 
+   return true;
+} else { 
+  mp->deletions_allowed=false;
+  print_err("TeX mode didn't end; all text was ignored after line ");
+  mp_print_int(mp, mp->warning_info);
+  help2("The file ended while I was looking for the `etex' to")
+    ("finish this TeX material.  I've inserted `etex' now.");
+  mp->cur_sym = frozen_etex;
+  mp_ins_error(mp);
+  mp->deletions_allowed=true;
+  return false;
+}
+
+@ @<Back up an outer symbolic token so that it can be reread@>=
+if ( mp->cur_sym!=0 ) {
+  p=mp_get_avail(mp); info(p)=mp->cur_sym;
+  back_list(p); /* prepare to read the symbolic token again */
+}
+
+@ @<Tell the user what has run away...@>=
+{ 
+  mp_runaway(mp); /* print the definition-so-far */
+  if ( mp->cur_sym==0 ) {
+    print_err("File ended");
+@.File ended while scanning...@>
+  } else { 
+    print_err("Forbidden token found");
+@.Forbidden token found...@>
+  }
+  mp_print(mp, " while scanning ");
+  help4("I suspect you have forgotten an `enddef',")
+    ("causing me to read past where you wanted me to stop.")
+    ("I'll try to recover; but if the error is serious,")
+    ("you'd better type `E' or `X' now and fix your file.");
+  switch (mp->scanner_status) {
+    @<Complete the error message,
+      and set |cur_sym| to a token that might help recover from the error@>
+  } /* there are no other cases */
+  mp_ins_error(mp);
+}
+
+@ As we consider various kinds of errors, it is also appropriate to
+change the first line of the help message just given; |help_line[3]|
+points to the string that might be changed.
+
+@<Complete the error message,...@>=
+case flushing: 
+  mp_print(mp, "to the end of the statement");
+  mp->help_line[3]="A previous error seems to have propagated,";
+  mp->cur_sym=frozen_semicolon;
+  break;
+case absorbing: 
+  mp_print(mp, "a text argument");
+  mp->help_line[3]="It seems that a right delimiter was left out,";
+  if ( mp->warning_info==0 ) {
+    mp->cur_sym=frozen_end_group;
+  } else { 
+    mp->cur_sym=frozen_right_delimiter;
+    equiv(frozen_right_delimiter)=mp->warning_info;
+  }
+  break;
+case var_defining:
+case op_defining: 
+  mp_print(mp, "the definition of ");
+  if ( mp->scanner_status==op_defining ) 
+     mp_print_text(mp->warning_info);
+  else 
+     mp_print_variable_name(mp, mp->warning_info);
+  mp->cur_sym=frozen_end_def;
+  break;
+case loop_defining: 
+  mp_print(mp, "the text of a "); 
+  mp_print_text(mp->warning_info);
+  mp_print(mp, " loop");
+  mp->help_line[3]="I suspect you have forgotten an `endfor',";
+  mp->cur_sym=frozen_end_for;
+  break;
+
+@ The |runaway| procedure displays the first part of the text that occurred
+when \MP\ began its special |scanner_status|, if that text has been saved.
+
+@<Declare the procedure called |runaway|@>=
+void mp_runaway (MP mp) { 
+  if ( mp->scanner_status>flushing ) { 
+     mp_print_nl(mp, "Runaway ");
+ 	 switch (mp->scanner_status) { 
+	 case absorbing: mp_print(mp, "text?"); break;
+	 case var_defining: 
+     case op_defining: mp_print(mp,"definition?"); break;
+     case loop_defining: mp_print(mp, "loop?"); break;
+     } /* there are no other cases */
+     mp_print_ln(mp); 
+     mp_show_token_list(mp, link(hold_head),null,mp->error_line-10,0);
+  }
+}
+
+@ We need to mention a procedure that may be called by |get_next|.
+
+@<Declarations@>= 
+void mp_firm_up_the_line (MP mp);
+
+@ And now we're ready to take the plunge into |get_next| itself.
+Note that the behavior depends on the |scanner_status| because percent signs
+and double quotes need to be passed over when skipping TeX material.
+
+@c 
+void mp_get_next (MP mp) {
+  /* sets |cur_cmd|, |cur_mod|, |cur_sym| to next token */
+@^inner loop@>
+  /*restart*/ /* go here to get the next input token */
+  /*exit*/ /* go here when the next input token has been got */
+  /*|common_ending|*/ /* go here to finish getting a symbolic token */
+  /*found*/ /* go here when the end of a symbolic token has been found */
+  /*switch*/ /* go here to branch on the class of an input character */
+  /*|start_numeric_token|,|start_decimal_token|,|fin_numeric_token|,|done|*/
+    /* go here at crucial stages when scanning a number */
+  int k; /* an index into |buffer| */
+  ASCII_code c; /* the current character in the buffer */
+  ASCII_code class; /* its class number */
+  integer n,f; /* registers for decimal-to-binary conversion */
+RESTART: 
+  mp->cur_sym=0;
+  if ( file_state ) {
+    @<Input from external file; |goto restart| if no input found,
+    or |return| if a non-symbolic token is found@>;
+  } else {
+    @<Input from token list; |goto restart| if end of list or
+      if a parameter needs to be expanded,
+      or |return| if a non-symbolic token is found@>;
+  }
+COMMON_ENDING: 
+  @<Finish getting the symbolic token in |cur_sym|;
+   |goto restart| if it is illegal@>;
+}
+
+@ When a symbolic token is declared to be `\&{outer}', its command code
+is increased by |outer_tag|.
+@^inner loop@>
+
+@<Finish getting the symbolic token in |cur_sym|...@>=
+mp->cur_cmd=eq_type(mp->cur_sym); mp->cur_mod=equiv(mp->cur_sym);
+if ( mp->cur_cmd>=outer_tag ) {
+  if ( mp_check_outer_validity(mp) ) 
+    mp->cur_cmd=mp->cur_cmd-outer_tag;
+  else 
+    goto RESTART;
+}
+
+@ A percent sign appears in |buffer[limit]|; this makes it unnecessary
+to have a special test for end-of-line.
+@^inner loop@>
+
+@<Input from external file;...@>=
+{ 
+SWITCH: 
+  c=mp->buffer[loc]; incr(loc); class=mp->char_class[c];
+  switch (class) {
+  case digit_class: goto START_NUMERIC_TOKEN; break;
+  case period_class: 
+    class=mp->char_class[mp->buffer[loc]];
+    if ( class>period_class ) {
+      goto SWITCH;
+    } else if ( class<period_class ) { /* |class=digit_class| */
+      n=0; goto START_DECIMAL_TOKEN;
+    }
+@:. }{\..\ token@>
+    break;
+  case space_class: goto SWITCH; break;
+  case percent_class: 
+    if ( mp->scanner_status==tex_flushing ) {
+      if ( loc<limit ) goto SWITCH;
+    }
+    @<Move to next line of file, or |goto restart| if there is no next line@>;
+    check_interrupt;
+    goto SWITCH;
+    break;
+  case string_class: 
+    if ( mp->scanner_status==tex_flushing ) goto SWITCH;
+    else @<Get a string token and |return|@>;
+    break;
+  case isolated_classes: 
+    k=loc-1; goto FOUND; break;
+  case invalid_class: 
+    if ( mp->scanner_status==tex_flushing ) goto SWITCH;
+    else @<Decry the invalid character and |goto restart|@>;
+    break;
+  default: break; /* letters, etc. */
+  }
+  k=loc-1;
+  while ( mp->char_class[mp->buffer[loc]]==class ) incr(loc);
+  goto FOUND;
+START_NUMERIC_TOKEN:
+  @<Get the integer part |n| of a numeric token;
+    set |f:=0| and |goto fin_numeric_token| if there is no decimal point@>;
+START_DECIMAL_TOKEN:
+  @<Get the fraction part |f| of a numeric token@>;
+FIN_NUMERIC_TOKEN:
+  @<Pack the numeric and fraction parts of a numeric token
+    and |return|@>;
+FOUND: 
+  mp->cur_sym=mp_id_lookup(mp, k,loc-k);
+}
+
+@ We go to |restart| instead of to |SWITCH|, because we might enter
+|token_state| after the error has been dealt with
+(cf.\ |clear_for_error_prompt|).
+
+@<Decry the invalid...@>=
+{ 
+  print_err("Text line contains an invalid character");
+@.Text line contains...@>
+  help2("A funny symbol that I can\'t read has just been input.")
+    ("Continue, and I'll forget that it ever happened.");
+  mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true;
+  goto RESTART;
+}
+
+@ @<Get a string token and |return|@>=
+{ 
+  if ( mp->buffer[loc]=='"' ) {
+    mp->cur_mod=rts("");
+  } else { 
+    k=loc; mp->buffer[limit+1]='"';
+    do {  
+     incr(loc);
+    } while (mp->buffer[loc]!='"');
+    if ( loc>limit ) {
+      @<Decry the missing string delimiter and |goto restart|@>;
+    }
+    if ( loc==k+1 ) {
+      mp->cur_mod=mp->buffer[k];
+    } else { 
+      str_room(loc-k);
+      do {  
+        append_char(mp->buffer[k]); incr(k);
+      } while (k!=loc);
+      mp->cur_mod=mp_make_string(mp);
+    }
+  }
+  incr(loc); mp->cur_cmd=string_token; 
+  return;
+}
+
+@ We go to |restart| after this error message, not to |SWITCH|,
+because the |clear_for_error_prompt| routine might have reinstated
+|token_state| after |error| has finished.
+
+@<Decry the missing string delimiter and |goto restart|@>=
+{ 
+  loc=limit; /* the next character to be read on this line will be |"%"| */
+  print_err("Incomplete string token has been flushed");
+@.Incomplete string token...@>
+  help3("Strings should finish on the same line as they began.")
+    ("I've deleted the partial string; you might want to")
+    ("insert another by typing, e.g., `I\"new string\"'.");
+  mp->deletions_allowed=false; mp_error(mp);
+  mp->deletions_allowed=true; 
+  goto RESTART;
+}
+
+@ @<Get the integer part |n| of a numeric token...@>=
+n=c-'0';
+while ( mp->char_class[mp->buffer[loc]]==digit_class ) {
+  if ( n<32768 ) n=10*n+mp->buffer[loc]-'0';
+  incr(loc);
+}
+if ( mp->buffer[loc]=='.' ) 
+  if ( mp->char_class[mp->buffer[loc+1]]==digit_class ) 
+    goto DONE;
+f=0; 
+goto FIN_NUMERIC_TOKEN;
+DONE: incr(loc)
+
+@ @<Get the fraction part |f| of a numeric token@>=
+k=0;
+do { 
+  if ( k<17 ) { /* digits for |k>=17| cannot affect the result */
+    mp->dig[k]=mp->buffer[loc]-'0'; incr(k);
+  }
+  incr(loc);
+} while (mp->char_class[mp->buffer[loc]]==digit_class);
+f=mp_round_decimals(mp, k);
+if ( f==unity ) {
+  incr(n); f=0;
+}
+
+@ @<Pack the numeric and fraction parts of a numeric token and |return|@>=
+if ( n<32768 ) {
+  @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably large@>;
+} else if ( mp->scanner_status!=tex_flushing ) {
+  print_err("Enormous number has been reduced");
+@.Enormous number...@>
+  help2("I can\'t handle numbers bigger than 32767.99998;")
+    ("so I've changed your constant to that maximum amount.");
+  mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true;
+  mp->cur_mod=el_gordo;
+}
+mp->cur_cmd=numeric_token; return
+
+@ @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably large@>=
+{ 
+  mp->cur_mod=n*unity+f;
+  if ( mp->cur_mod>=fraction_one ) {
+    if ( (mp->internal[mp_warning_check]>0) &&
+         (mp->scanner_status!=tex_flushing) ) {
+      print_err("Number is too large (");
+      mp_print_scaled(mp, mp->cur_mod);
+      mp_print_char(mp, ')');
+      help3("It is at least 4096. Continue and I'll try to cope")
+      ("with that big value; but it might be dangerous.")
+      ("(Set warningcheck:=0 to suppress this message.)");
+      mp_error(mp);
+    }
+  }
+}
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+@^inner loop@>
+
+@<Input from token list;...@>=
+if ( loc>=mp->hi_mem_min ) { /* one-word token */
+  mp->cur_sym=info(loc); loc=link(loc); /* move to next */
+  if ( mp->cur_sym>=expr_base ) {
+    if ( mp->cur_sym>=suffix_base ) {
+      @<Insert a suffix or text parameter and |goto restart|@>;
+    } else { 
+      mp->cur_cmd=capsule_token;
+      mp->cur_mod=mp->param_stack[param_start+mp->cur_sym-(expr_base)];
+      mp->cur_sym=0; return;
+    }
+  }
+} else if ( loc>null ) {
+  @<Get a stored numeric or string or capsule token and |return|@>
+} else { /* we are done with this token list */
+  mp_end_token_list(mp); goto RESTART; /* resume previous level */
+}
+
+@ @<Insert a suffix or text parameter...@>=
+{ 
+  if ( mp->cur_sym>=text_base ) mp->cur_sym=mp->cur_sym-mp->param_size;
+  /* |param_size=text_base-suffix_base| */
+  mp_begin_token_list(mp,
+                      mp->param_stack[param_start+mp->cur_sym-(suffix_base)],
+                      parameter);
+  goto RESTART;
+}
+
+@ @<Get a stored numeric or string or capsule token...@>=
+{ 
+  if ( name_type(loc)==mp_token ) {
+    mp->cur_mod=value(loc);
+    if ( type(loc)==mp_known ) {
+      mp->cur_cmd=numeric_token;
+    } else { 
+      mp->cur_cmd=string_token; add_str_ref(mp->cur_mod);
+    }
+  } else { 
+    mp->cur_mod=loc; mp->cur_cmd=capsule_token;
+  };
+  loc=link(loc); return;
+}
+
+@ All of the easy branches of |get_next| have now been taken care of.
+There is one more branch.
+
+@<Move to next line of file, or |goto restart|...@>=
+if ( name>max_spec_src ) {
+  @<Read next line of file into |buffer|, or
+    |goto restart| if the file has ended@>;
+} else { 
+  if ( mp->input_ptr>0 ) {
+     /* text was inserted during error recovery or by \&{scantokens} */
+    mp_end_file_reading(mp); goto RESTART; /* resume previous level */
+  }
+  if ( mp->selector<log_only || mp->selector>=write_file) mp_open_log_file(mp);
+  if ( mp->interaction>mp_nonstop_mode ) {
+    if ( limit==start ) /* previous line was empty */
+      mp_print_nl(mp, "(Please type a command or say `end')");
+@.Please type...@>
+    mp_print_ln(mp); mp->first=start;
+    prompt_input("*"); /* input on-line into |buffer| */
+@.*\relax@>
+    limit=mp->last; mp->buffer[limit]='%';
+    mp->first=limit+1; loc=start;
+  } else {
+    mp_fatal_error(mp, "*** (job aborted, no legal end found)");
+@.job aborted@>
+    /* nonstop mode, which is intended for overnight batch processing,
+    never waits for on-line input */
+  }
+}
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \&{endinput} command.
+
+@<Glob...@>=
+boolean force_eof; /* should the next \&{input} be aborted early? */
+
+@ We must decrement |loc| in order to leave the buffer in a valid state
+when an error condition causes us to |goto restart| without calling
+|end_file_reading|.
+
+@<Read next line of file into |buffer|, or
+  |goto restart| if the file has ended@>=
+{ 
+  incr(line); mp->first=start;
+  if ( ! mp->force_eof ) {
+    if ( mp_input_ln(mp, cur_file ) ) /* not end of file */
+      mp_firm_up_the_line(mp); /* this sets |limit| */
+    else 
+      mp->force_eof=true;
+  };
+  if ( mp->force_eof ) {
+    mp->force_eof=false;
+    decr(loc);
+    if ( mpx_reading ) {
+      @<Complain that the \.{MPX} file ended unexpectly; then set
+        |cur_sym:=frozen_mpx_break| and |goto comon_ending|@>;
+    } else { 
+      mp_print_char(mp, ')'); decr(mp->open_parens);
+      update_terminal; /* show user that file has been read */
+      mp_end_file_reading(mp); /* resume previous level */
+      if ( mp_check_outer_validity(mp) ) goto  RESTART;  
+      else goto RESTART;
+    }
+  }
+  mp->buffer[limit]='%'; mp->first=limit+1; loc=start; /* ready to read */
+}
+
+@ We should never actually come to the end of an \.{MPX} file because such
+files should have an \&{mpxbreak} after the translation of the last
+\&{btex}$\,\ldots\,$\&{etex} block.
+
+@<Complain that the \.{MPX} file ended unexpectly; then set...@>=
+{ 
+  mp->mpx_name[index]=finished;
+  print_err("mpx file ended unexpectedly");
+  help4("The file had too few picture expressions for btex...etex")
+    ("blocks.  Such files are normally generated automatically")
+    ("but this one got messed up.  You might want to insert a")
+    ("picture expression now.");
+  mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true;
+  mp->cur_sym=frozen_mpx_break; goto COMMON_ENDING;
+}
+
+@ Sometimes we want to make it look as though we have just read a blank line
+without really doing so.
+
+@<Put an empty line in the input buffer@>=
+mp->last=mp->first; limit=mp->last; /* simulate |input_ln| and |firm_up_the_line| */
+mp->buffer[limit]='%'; mp->first=limit+1; loc=start
+
+@ If the user has set the |mp_pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\MP\ waits for a response. If the response is null (i.e., if nothing is
+typed except perhaps a few blank spaces), the original
+line is accepted as it stands; otherwise the line typed is
+used instead of the line in the file.
+
+@c void mp_firm_up_the_line (MP mp) {
+  size_t k; /* an index into |buffer| */
+  limit=mp->last;
+  if ( mp->internal[mp_pausing]>0) if ( mp->interaction>mp_nonstop_mode ) {
+    wake_up_terminal; mp_print_ln(mp);
+    if ( start<limit ) {
+      for (k=(size_t)start;k<=(size_t)(limit-1);k++) {
+        mp_print_str(mp, mp->buffer[k]);
+      } 
+    }
+    mp->first=limit; prompt_input("=>"); /* wait for user response */
+@.=>@>
+    if ( mp->last>mp->first ) {
+      for (k=mp->first;k<=mp->last-1;k++) { /* move line down in buffer */
+        mp->buffer[k+start-mp->first]=mp->buffer[k];
+      }
+      limit=start+mp->last-mp->first;
+    }
+  }
+}
+
+@* \[30] Dealing with \TeX\ material.
+The \&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}$\,\ldots\,$\&{etex}
+features need to be implemented at a low level in the scanning process
+so that \MP\ can stay in synch with the a preprocessor that treats
+blocks of \TeX\ material as they occur in the input file without trying
+to expand \MP\ macros.  Thus we need a special version of |get_next|
+that does not expand macros and such but does handle \&{btex},
+\&{verbatimtex}, etc.
+
+The special version of |get_next| is called |get_t_next|.  It works by flushing
+\&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}\allowbreak
+$\,\ldots\,$\&{etex} blocks, switching to the \.{MPX} file when it sees
+\&{btex}, and switching back when it sees \&{mpxbreak}.
+
+@d btex_code 0
+@d verbatim_code 1
+
+@ @<Put each...@>=
+mp_primitive(mp, "btex",start_tex,btex_code);
+@:btex_}{\&{btex} primitive@>
+mp_primitive(mp, "verbatimtex",start_tex,verbatim_code);
+@:verbatimtex_}{\&{verbatimtex} primitive@>
+mp_primitive(mp, "etex",etex_marker,0); mp->eqtb[frozen_etex]=mp->eqtb[mp->cur_sym];
+@:etex_}{\&{etex} primitive@>
+mp_primitive(mp, "mpxbreak",mpx_break,0); mp->eqtb[frozen_mpx_break]=mp->eqtb[mp->cur_sym];
+@:mpx_break_}{\&{mpxbreak} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case start_tex: if ( m==btex_code ) mp_print(mp, "btex");
+  else mp_print(mp, "verbatimtex"); break;
+case etex_marker: mp_print(mp, "etex"); break;
+case mpx_break: mp_print(mp, "mpxbreak"); break;
+
+@ Actually, |get_t_next| is a macro that avoids procedure overhead except
+in the unusual case where \&{btex}, \&{verbatimtex}, \&{etex}, or \&{mpxbreak}
+is encountered.
+
+@d get_t_next {mp_get_next(mp); if ( mp->cur_cmd<=max_pre_command ) mp_t_next(mp); }
+
+@<Declarations@>=
+void mp_start_mpx_input (MP mp);
+
+@ @c 
+void mp_t_next (MP mp) {
+  int old_status; /* saves the |scanner_status| */
+  integer old_info; /* saves the |warning_info| */
+  while ( mp->cur_cmd<=max_pre_command ) {
+    if ( mp->cur_cmd==mpx_break ) {
+      if ( ! file_state || (mp->mpx_name[index]==absent) ) {
+        @<Complain about a misplaced \&{mpxbreak}@>;
+      } else { 
+        mp_end_mpx_reading(mp); 
+      	goto TEX_FLUSH;
+      }
+    } else if ( mp->cur_cmd==start_tex ) {
+      if ( token_state || (name<=max_spec_src) ) {
+        @<Complain that we are not reading a file@>;
+      } else if ( mpx_reading ) {
+        @<Complain that \.{MPX} files cannot contain \TeX\ material@>;
+      } else if ( (mp->cur_mod!=verbatim_code)&&
+                  (mp->mpx_name[index]!=finished) ) {
+        if ( ! mp_begin_mpx_reading(mp) ) mp_start_mpx_input(mp);
+      } else {
+        goto TEX_FLUSH;
+      }
+    } else {
+       @<Complain about a misplaced \&{etex}@>;
+    }
+    goto COMMON_ENDING;
+  TEX_FLUSH: 
+    @<Flush the \TeX\ material@>;
+  COMMON_ENDING: 
+    mp_get_next(mp);
+  }
+}
+
+@ We could be in the middle of an operation such as skipping false conditional
+text when \TeX\ material is encountered, so we must be careful to save the
+|scanner_status|.
+
+@<Flush the \TeX\ material@>=
+old_status=mp->scanner_status;
+old_info=mp->warning_info;
+mp->scanner_status=tex_flushing;
+mp->warning_info=line;
+do {  mp_get_next(mp); } while (mp->cur_cmd!=etex_marker);
+mp->scanner_status=old_status;
+mp->warning_info=old_info
+
+@ @<Complain that \.{MPX} files cannot contain \TeX\ material@>=
+{ print_err("An mpx file cannot contain btex or verbatimtex blocks");
+help4("This file contains picture expressions for btex...etex")
+  ("blocks.  Such files are normally generated automatically")
+  ("but this one seems to be messed up.  I'll just keep going")
+  ("and hope for the best.");
+mp_error(mp);
+}
+
+@ @<Complain that we are not reading a file@>=
+{ print_err("You can only use `btex' or `verbatimtex' in a file");
+help3("I'll have to ignore this preprocessor command because it")
+  ("only works when there is a file to preprocess.  You might")
+  ("want to delete everything up to the next `etex`.");
+mp_error(mp);
+}
+
+@ @<Complain about a misplaced \&{mpxbreak}@>=
+{ print_err("Misplaced mpxbreak");
+help2("I'll ignore this preprocessor command because it")
+  ("doesn't belong here");
+mp_error(mp);
+}
+
+@ @<Complain about a misplaced \&{etex}@>=
+{ print_err("Extra etex will be ignored");
+help1("There is no btex or verbatimtex for this to match");
+mp_error(mp);
+}
+
+@* \[31] Scanning macro definitions.
+\MP\ has a variety of ways to tuck tokens away into token lists for later
+use: Macros can be defined with \&{def}, \&{vardef}, \&{primarydef}, etc.;
+repeatable code can be defined with \&{for}, \&{forever}, \&{forsuffixes}.
+All such operations are handled by the routines in this part of the program.
+
+The modifier part of each command code is zero for the ``ending delimiters''
+like \&{enddef} and \&{endfor}.
+
+@d start_def 1 /* command modifier for \&{def} */
+@d var_def 2 /* command modifier for \&{vardef} */
+@d end_def 0 /* command modifier for \&{enddef} */
+@d start_forever 1 /* command modifier for \&{forever} */
+@d end_for 0 /* command modifier for \&{endfor} */
+
+@<Put each...@>=
+mp_primitive(mp, "def",macro_def,start_def);
+@:def_}{\&{def} primitive@>
+mp_primitive(mp, "vardef",macro_def,var_def);
+@:var_def_}{\&{vardef} primitive@>
+mp_primitive(mp, "primarydef",macro_def,secondary_primary_macro);
+@:primary_def_}{\&{primarydef} primitive@>
+mp_primitive(mp, "secondarydef",macro_def,tertiary_secondary_macro);
+@:secondary_def_}{\&{secondarydef} primitive@>
+mp_primitive(mp, "tertiarydef",macro_def,expression_tertiary_macro);
+@:tertiary_def_}{\&{tertiarydef} primitive@>
+mp_primitive(mp, "enddef",macro_def,end_def); mp->eqtb[frozen_end_def]=mp->eqtb[mp->cur_sym];
+@:end_def_}{\&{enddef} primitive@>
+@#
+mp_primitive(mp, "for",iteration,expr_base);
+@:for_}{\&{for} primitive@>
+mp_primitive(mp, "forsuffixes",iteration,suffix_base);
+@:for_suffixes_}{\&{forsuffixes} primitive@>
+mp_primitive(mp, "forever",iteration,start_forever);
+@:forever_}{\&{forever} primitive@>
+mp_primitive(mp, "endfor",iteration,end_for); mp->eqtb[frozen_end_for]=mp->eqtb[mp->cur_sym];
+@:end_for_}{\&{endfor} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case macro_def:
+  if ( m<=var_def ) {
+    if ( m==start_def ) mp_print(mp, "def");
+    else if ( m<start_def ) mp_print(mp, "enddef");
+    else mp_print(mp, "vardef");
+  } else if ( m==secondary_primary_macro ) { 
+    mp_print(mp, "primarydef");
+  } else if ( m==tertiary_secondary_macro ) { 
+    mp_print(mp, "secondarydef");
+  } else { 
+    mp_print(mp, "tertiarydef");
+  }
+  break;
+case iteration: 
+  if ( m<=start_forever ) {
+    if ( m==start_forever ) mp_print(mp, "forever"); 
+    else mp_print(mp, "endfor");
+  } else if ( m==expr_base ) {
+    mp_print(mp, "for"); 
+  } else { 
+    mp_print(mp, "forsuffixes");
+  }
+  break;
+
+@ Different macro-absorbing operations have different syntaxes, but they
+also have a lot in common. There is a list of special symbols that are to
+be replaced by parameter tokens; there is a special command code that
+ends the definition; the quotation conventions are identical.  Therefore
+it makes sense to have most of the work done by a single subroutine. That
+subroutine is called |scan_toks|.
+
+The first parameter to |scan_toks| is the command code that will
+terminate scanning (either |macro_def| or |iteration|).
+
+The second parameter, |subst_list|, points to a (possibly empty) list
+of two-word nodes whose |info| and |value| fields specify symbol tokens
+before and after replacement. The list will be returned to free storage
+by |scan_toks|.
+
+The third parameter is simply appended to the token list that is built.
+And the final parameter tells how many of the special operations
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#} are to be replaced by suffix parameters.
+When such parameters are present, they are called \.{(SUFFIX0)},
+\.{(SUFFIX1)}, and \.{(SUFFIX2)}.
+
+@c pointer mp_scan_toks (MP mp,command_code terminator, pointer 
+  subst_list, pointer tail_end, small_number suffix_count) {
+  pointer p; /* tail of the token list being built */
+  pointer q; /* temporary for link management */
+  integer balance; /* left delimiters minus right delimiters */
+  p=hold_head; balance=1; link(hold_head)=null;
+  while (1) { 
+    get_t_next;
+    if ( mp->cur_sym>0 ) {
+      @<Substitute for |cur_sym|, if it's on the |subst_list|@>;
+      if ( mp->cur_cmd==terminator ) {
+        @<Adjust the balance; |break| if it's zero@>;
+      } else if ( mp->cur_cmd==macro_special ) {
+        @<Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}@>;
+      }
+    }
+    link(p)=mp_cur_tok(mp); p=link(p);
+  }
+  link(p)=tail_end; mp_flush_node_list(mp, subst_list);
+  return link(hold_head);
+}
+
+@ @<Substitute for |cur_sym|...@>=
+{ 
+  q=subst_list;
+  while ( q!=null ) {
+    if ( info(q)==mp->cur_sym ) {
+      mp->cur_sym=value(q); mp->cur_cmd=relax; break;
+    }
+    q=link(q);
+  }
+}
+
+@ @<Adjust the balance; |break| if it's zero@>=
+if ( mp->cur_mod>0 ) {
+  incr(balance);
+} else { 
+  decr(balance);
+  if ( balance==0 )
+    break;
+}
+
+@ Four commands are intended to be used only within macro texts: \&{quote},
+\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#}. They are variants of a single command
+code called |macro_special|.
+
+@d quote 0 /* |macro_special| modifier for \&{quote} */
+@d macro_prefix 1 /* |macro_special| modifier for \.{\#\AT!} */
+@d macro_at 2 /* |macro_special| modifier for \.{\AT!} */
+@d macro_suffix 3 /* |macro_special| modifier for \.{\AT!\#} */
+
+@<Put each...@>=
+mp_primitive(mp, "quote",macro_special,quote);
+@:quote_}{\&{quote} primitive@>
+mp_primitive(mp, "#@@",macro_special,macro_prefix);
+@:]]]\#\AT!_}{\.{\#\AT!} primitive@>
+mp_primitive(mp, "@@",macro_special,macro_at);
+@:]]]\AT!_}{\.{\AT!} primitive@>
+mp_primitive(mp, "@@#",macro_special,macro_suffix);
+@:]]]\AT!\#_}{\.{\AT!\#} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case macro_special: 
+  switch (m) {
+  case macro_prefix: mp_print(mp, "#@@"); break;
+  case macro_at: mp_print_char(mp, '@@'); break;
+  case macro_suffix: mp_print(mp, "@@#"); break;
+  default: mp_print(mp, "quote"); break;
+  }
+  break;
+
+@ @<Handle quoted...@>=
+{ 
+  if ( mp->cur_mod==quote ) { get_t_next; } 
+  else if ( mp->cur_mod<=suffix_count ) 
+    mp->cur_sym=suffix_base-1+mp->cur_mod;
+}
+
+@ Here is a routine that's used whenever a token will be redefined. If
+the user's token is unredefinable, the `|frozen_inaccessible|' token is
+substituted; the latter is redefinable but essentially impossible to use,
+hence \MP's tables won't get fouled up.
+
+@c void mp_get_symbol (MP mp) { /* sets |cur_sym| to a safe symbol */
+RESTART: 
+  get_t_next;
+  if ( (mp->cur_sym==0)||(mp->cur_sym>frozen_inaccessible) ) {
+    print_err("Missing symbolic token inserted");
+@.Missing symbolic token...@>
+    help3("Sorry: You can\'t redefine a number, string, or expr.")
+      ("I've inserted an inaccessible symbol so that your")
+      ("definition will be completed without mixing me up too badly.");
+    if ( mp->cur_sym>0 )
+      mp->help_line[2]="Sorry: You can\'t redefine my error-recovery tokens.";
+    else if ( mp->cur_cmd==string_token ) 
+      delete_str_ref(mp->cur_mod);
+    mp->cur_sym=frozen_inaccessible; mp_ins_error(mp); goto RESTART;
+  }
+}
+
+@ Before we actually redefine a symbolic token, we need to clear away its
+former value, if it was a variable. The following stronger version of
+|get_symbol| does that.
+
+@c void mp_get_clear_symbol (MP mp) { 
+  mp_get_symbol(mp); mp_clear_symbol(mp, mp->cur_sym,false);
+}
+
+@ Here's another little subroutine; it checks that an equals sign
+or assignment sign comes along at the proper place in a macro definition.
+
+@c void mp_check_equals (MP mp) { 
+  if ( mp->cur_cmd!=equals ) if ( mp->cur_cmd!=assignment ) {
+     mp_missing_err(mp, "=");
+@.Missing `='@>
+    help5("The next thing in this `def' should have been `=',")
+      ("because I've already looked at the definition heading.")
+      ("But don't worry; I'll pretend that an equals sign")
+      ("was present. Everything from here to `enddef'")
+      ("will be the replacement text of this macro.");
+    mp_back_error(mp);
+  }
+}
+
+@ A \&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily
+handled now that we have |scan_toks|.  In this case there are
+two parameters, which will be \.{EXPR0} and \.{EXPR1} (i.e.,
+|expr_base| and |expr_base+1|).
+
+@c void mp_make_op_def (MP mp) {
+  command_code m; /* the type of definition */
+  pointer p,q,r; /* for list manipulation */
+  m=mp->cur_mod;
+  mp_get_symbol(mp); q=mp_get_node(mp, token_node_size);
+  info(q)=mp->cur_sym; value(q)=expr_base;
+  mp_get_clear_symbol(mp); mp->warning_info=mp->cur_sym;
+  mp_get_symbol(mp); p=mp_get_node(mp, token_node_size);
+  info(p)=mp->cur_sym; value(p)=expr_base+1; link(p)=q;
+  get_t_next; mp_check_equals(mp);
+  mp->scanner_status=op_defining; q=mp_get_avail(mp); ref_count(q)=null;
+  r=mp_get_avail(mp); link(q)=r; info(r)=general_macro;
+  link(r)=mp_scan_toks(mp, macro_def,p,null,0);
+  mp->scanner_status=normal; eq_type(mp->warning_info)=m;
+  equiv(mp->warning_info)=q; mp_get_x_next(mp);
+}
+
+@ Parameters to macros are introduced by the keywords \&{expr},
+\&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}.
+
+@<Put each...@>=
+mp_primitive(mp, "expr",param_type,expr_base);
+@:expr_}{\&{expr} primitive@>
+mp_primitive(mp, "suffix",param_type,suffix_base);
+@:suffix_}{\&{suffix} primitive@>
+mp_primitive(mp, "text",param_type,text_base);
+@:text_}{\&{text} primitive@>
+mp_primitive(mp, "primary",param_type,primary_macro);
+@:primary_}{\&{primary} primitive@>
+mp_primitive(mp, "secondary",param_type,secondary_macro);
+@:secondary_}{\&{secondary} primitive@>
+mp_primitive(mp, "tertiary",param_type,tertiary_macro);
+@:tertiary_}{\&{tertiary} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case param_type:
+  if ( m>=expr_base ) {
+    if ( m==expr_base ) mp_print(mp, "expr");
+    else if ( m==suffix_base ) mp_print(mp, "suffix");
+    else mp_print(mp, "text");
+  } else if ( m<secondary_macro ) {
+    mp_print(mp, "primary");
+  } else if ( m==secondary_macro ) {
+    mp_print(mp, "secondary");
+  } else {
+    mp_print(mp, "tertiary");
+  }
+  break;
+
+@ Let's turn next to the more complex processing associated with \&{def}
+and \&{vardef}. When the following procedure is called, |cur_mod|
+should be either |start_def| or |var_def|.
+
+@c @<Declare the procedure called |check_delimiter|@>
+@<Declare the function called |scan_declared_variable|@>
+void mp_scan_def (MP mp) {
+  int m; /* the type of definition */
+  int n; /* the number of special suffix parameters */
+  int k; /* the total number of parameters */
+  int c; /* the kind of macro we're defining */
+  pointer r; /* parameter-substitution list */
+  pointer q; /* tail of the macro token list */
+  pointer p; /* temporary storage */
+  halfword base; /* |expr_base|, |suffix_base|, or |text_base| */
+  pointer l_delim,r_delim; /* matching delimiters */
+  m=mp->cur_mod; c=general_macro; link(hold_head)=null;
+  q=mp_get_avail(mp); ref_count(q)=null; r=null;
+  @<Scan the token or variable to be defined;
+    set |n|, |scanner_status|, and |warning_info|@>;
+  k=n;
+  if ( mp->cur_cmd==left_delimiter ) {
+    @<Absorb delimited parameters, putting them into lists |q| and |r|@>;
+  }
+  if ( mp->cur_cmd==param_type ) {
+    @<Absorb undelimited parameters, putting them into list |r|@>;
+  }
+  mp_check_equals(mp);
+  p=mp_get_avail(mp); info(p)=c; link(q)=p;
+  @<Attach the replacement text to the tail of node |p|@>;
+  mp->scanner_status=normal; mp_get_x_next(mp);
+}
+
+@ We don't put `|frozen_end_group|' into the replacement text of
+a \&{vardef}, because the user may want to redefine `\.{endgroup}'.
+
+@<Attach the replacement text to the tail of node |p|@>=
+if ( m==start_def ) {
+  link(p)=mp_scan_toks(mp, macro_def,r,null,n);
+} else { 
+  q=mp_get_avail(mp); info(q)=mp->bg_loc; link(p)=q;
+  p=mp_get_avail(mp); info(p)=mp->eg_loc;
+  link(q)=mp_scan_toks(mp, macro_def,r,p,n);
+}
+if ( mp->warning_info==bad_vardef ) 
+  mp_flush_token_list(mp, value(bad_vardef))
+
+@ @<Glob...@>=
+int bg_loc;
+int eg_loc; /* hash addresses of `\.{begingroup}' and `\.{endgroup}' */
+
+@ @<Scan the token or variable to be defined;...@>=
+if ( m==start_def ) {
+  mp_get_clear_symbol(mp); mp->warning_info=mp->cur_sym; get_t_next;
+  mp->scanner_status=op_defining; n=0;
+  eq_type(mp->warning_info)=defined_macro; equiv(mp->warning_info)=q;
+} else { 
+  p=mp_scan_declared_variable(mp);
+  mp_flush_variable(mp, equiv(info(p)),link(p),true);
+  mp->warning_info=mp_find_variable(mp, p); mp_flush_list(mp, p);
+  if ( mp->warning_info==null ) @<Change to `\.{a bad variable}'@>;
+  mp->scanner_status=var_defining; n=2;
+  if ( mp->cur_cmd==macro_special ) if ( mp->cur_mod==macro_suffix ) {/* \.{\AT!\#} */
+    n=3; get_t_next;
+  }
+  type(mp->warning_info)=mp_unsuffixed_macro-2+n; value(mp->warning_info)=q;
+} /* |mp_suffixed_macro=mp_unsuffixed_macro+1| */
+
+@ @<Change to `\.{a bad variable}'@>=
+{ 
+  print_err("This variable already starts with a macro");
+@.This variable already...@>
+  help2("After `vardef a' you can\'t say `vardef a.b'.")
+    ("So I'll have to discard this definition.");
+  mp_error(mp); mp->warning_info=bad_vardef;
+}
+
+@ @<Initialize table entries...@>=
+name_type(bad_vardef)=mp_root; link(bad_vardef)=frozen_bad_vardef;
+equiv(frozen_bad_vardef)=bad_vardef; eq_type(frozen_bad_vardef)=tag_token;
+
+@ @<Absorb delimited parameters, putting them into lists |q| and |r|@>=
+do {  
+  l_delim=mp->cur_sym; r_delim=mp->cur_mod; get_t_next;
+  if ( (mp->cur_cmd==param_type)&&(mp->cur_mod>=expr_base) ) {
+   base=mp->cur_mod;
+  } else { 
+    print_err("Missing parameter type; `expr' will be assumed");
+@.Missing parameter type@>
+    help1("You should've had `expr' or `suffix' or `text' here.");
+    mp_back_error(mp); base=expr_base;
+  }
+  @<Absorb parameter tokens for type |base|@>;
+  mp_check_delimiter(mp, l_delim,r_delim);
+  get_t_next;
+} while (mp->cur_cmd==left_delimiter)
+
+@ @<Absorb parameter tokens for type |base|@>=
+do { 
+  link(q)=mp_get_avail(mp); q=link(q); info(q)=base+k;
+  mp_get_symbol(mp); p=mp_get_node(mp, token_node_size); 
+  value(p)=base+k; info(p)=mp->cur_sym;
+  if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+  incr(k); link(p)=r; r=p; get_t_next;
+} while (mp->cur_cmd==comma)
+
+@ @<Absorb undelimited parameters, putting them into list |r|@>=
+{ 
+  p=mp_get_node(mp, token_node_size);
+  if ( mp->cur_mod<expr_base ) {
+    c=mp->cur_mod; value(p)=expr_base+k;
+  } else { 
+    value(p)=mp->cur_mod+k;
+    if ( mp->cur_mod==expr_base ) c=expr_macro;
+    else if ( mp->cur_mod==suffix_base ) c=suffix_macro;
+    else c=text_macro;
+  }
+  if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size);
+  incr(k); mp_get_symbol(mp); info(p)=mp->cur_sym; link(p)=r; r=p; get_t_next;
+  if ( c==expr_macro ) if ( mp->cur_cmd==of_token ) {
+    c=of_macro; p=mp_get_node(mp, token_node_size);
+    if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size);
+    value(p)=expr_base+k; mp_get_symbol(mp); info(p)=mp->cur_sym;
+    link(p)=r; r=p; get_t_next;
+  }
+}
+
+@* \[32] Expanding the next token.
+Only a few command codes |<min_command| can possibly be returned by
+|get_t_next|; in increasing order, they are
+|if_test|, |fi_or_else|, |input|, |iteration|, |repeat_loop|,
+|exit_test|, |relax|, |scan_tokens|, |expand_after|, and |defined_macro|.
+
+\MP\ usually gets the next token of input by saying |get_x_next|. This is
+like |get_t_next| except that it keeps getting more tokens until
+finding |cur_cmd>=min_command|. In other words, |get_x_next| expands
+macros and removes conditionals or iterations or input instructions that
+might be present.
+
+It follows that |get_x_next| might invoke itself recursively. In fact,
+there is massive recursion, since macro expansion can involve the
+scanning of arbitrarily complex expressions, which in turn involve
+macro expansion and conditionals, etc.
+@^recursion@>
+
+Therefore it's necessary to declare a whole bunch of |forward|
+procedures at this point, and to insert some other procedures
+that will be invoked by |get_x_next|.
+
+@<Declarations@>= 
+void mp_scan_primary (MP mp);
+void mp_scan_secondary (MP mp);
+void mp_scan_tertiary (MP mp);
+void mp_scan_expression (MP mp);
+void mp_scan_suffix (MP mp);
+@<Declare the procedure called |macro_call|@>
+void mp_get_boolean (MP mp);
+void mp_pass_text (MP mp);
+void mp_conditional (MP mp);
+void mp_start_input (MP mp);
+void mp_begin_iteration (MP mp);
+void mp_resume_iteration (MP mp);
+void mp_stop_iteration (MP mp);
+
+@ An auxiliary subroutine called |expand| is used by |get_x_next|
+when it has to do exotic expansion commands.
+
+@c void mp_expand (MP mp) {
+  pointer p; /* for list manipulation */
+  size_t k; /* something that we hope is |<=buf_size| */
+  pool_pointer j; /* index into |str_pool| */
+  if ( mp->internal[mp_tracing_commands]>unity ) 
+    if ( mp->cur_cmd!=defined_macro )
+      show_cur_cmd_mod;
+  switch (mp->cur_cmd)  {
+  case if_test:
+    mp_conditional(mp); /* this procedure is discussed in Part 36 below */
+    break;
+  case fi_or_else:
+    @<Terminate the current conditional and skip to \&{fi}@>;
+    break;
+  case input:
+    @<Initiate or terminate input from a file@>;
+    break;
+  case iteration:
+    if ( mp->cur_mod==end_for ) {
+      @<Scold the user for having an extra \&{endfor}@>;
+    } else {
+      mp_begin_iteration(mp); /* this procedure is discussed in Part 37 below */
+    }
+    break;
+  case repeat_loop: 
+    @<Repeat a loop@>;
+    break;
+  case exit_test: 
+    @<Exit a loop if the proper time has come@>;
+    break;
+  case relax: 
+    break;
+  case expand_after: 
+    @<Expand the token after the next token@>;
+    break;
+  case scan_tokens: 
+    @<Put a string into the input buffer@>;
+    break;
+  case defined_macro:
+   mp_macro_call(mp, mp->cur_mod,null,mp->cur_sym);
+   break;
+  }; /* there are no other cases */
+}
+
+@ @<Scold the user...@>=
+{ 
+  print_err("Extra `endfor'");
+@.Extra `endfor'@>
+  help2("I'm not currently working on a for loop,")
+    ("so I had better not try to end anything.");
+  mp_error(mp);
+}
+
+@ The processing of \&{input} involves the |start_input| subroutine,
+which will be declared later; the processing of \&{endinput} is trivial.
+
+@<Put each...@>=
+mp_primitive(mp, "input",input,0);
+@:input_}{\&{input} primitive@>
+mp_primitive(mp, "endinput",input,1);
+@:end_input_}{\&{endinput} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case input: 
+  if ( m==0 ) mp_print(mp, "input");
+  else mp_print(mp, "endinput");
+  break;
+
+@ @<Initiate or terminate input...@>=
+if ( mp->cur_mod>0 ) mp->force_eof=true;
+else mp_start_input(mp)
+
+@ We'll discuss the complicated parts of loop operations later. For now
+it suffices to know that there's a global variable called |loop_ptr|
+that will be |null| if no loop is in progress.
+
+@<Repeat a loop@>=
+{ while ( token_state &&(loc==null) ) 
+    mp_end_token_list(mp); /* conserve stack space */
+  if ( mp->loop_ptr==null ) {
+    print_err("Lost loop");
+@.Lost loop@>
+    help2("I'm confused; after exiting from a loop, I still seem")
+      ("to want to repeat it. I'll try to forget the problem.");
+    mp_error(mp);
+  } else {
+    mp_resume_iteration(mp); /* this procedure is in Part 37 below */
+  }
+}
+
+@ @<Exit a loop if the proper time has come@>=
+{ mp_get_boolean(mp);
+  if ( mp->internal[mp_tracing_commands]>unity ) 
+    mp_show_cmd_mod(mp, nullary,mp->cur_exp);
+  if ( mp->cur_exp==true_code ) {
+    if ( mp->loop_ptr==null ) {
+      print_err("No loop is in progress");
+@.No loop is in progress@>
+      help1("Why say `exitif' when there's nothing to exit from?");
+      if ( mp->cur_cmd==semicolon ) mp_error(mp); else mp_back_error(mp);
+    } else {
+     @<Exit prematurely from an iteration@>;
+    }
+  } else if ( mp->cur_cmd!=semicolon ) {
+    mp_missing_err(mp, ";");
+@.Missing `;'@>
+    help2("After `exitif <boolean exp>' I expect to see a semicolon.")
+    ("I shall pretend that one was there."); mp_back_error(mp);
+  }
+}
+
+@ Here we use the fact that |forever_text| is the only |token_type| that
+is less than |loop_text|.
+
+@<Exit prematurely...@>=
+{ p=null;
+  do {  
+    if ( file_state ) {
+      mp_end_file_reading(mp);
+    } else { 
+      if ( token_type<=loop_text ) p=start;
+      mp_end_token_list(mp);
+    }
+  } while (p==null);
+  if ( p!=info(mp->loop_ptr) ) mp_fatal_error(mp, "*** (loop confusion)");
+@.loop confusion@>
+  mp_stop_iteration(mp); /* this procedure is in Part 34 below */
+}
+
+@ @<Expand the token after the next token@>=
+{ get_t_next;
+  p=mp_cur_tok(mp); get_t_next;
+  if ( mp->cur_cmd<min_command ) mp_expand(mp); 
+  else mp_back_input(mp);
+  back_list(p);
+}
+
+@ @<Put a string into the input buffer@>=
+{ mp_get_x_next(mp); mp_scan_primary(mp);
+  if ( mp->cur_type!=mp_string_type ) {
+    mp_disp_err(mp, null,"Not a string");
+@.Not a string@>
+    help2("I'm going to flush this expression, since")
+       ("scantokens should be followed by a known string.");
+    mp_put_get_flush_error(mp, 0);
+  } else { 
+    mp_back_input(mp);
+    if ( length(mp->cur_exp)>0 )
+       @<Pretend we're reading a new one-line file@>;
+  }
+}
+
+@ @<Pretend we're reading a new one-line file@>=
+{ mp_begin_file_reading(mp); name=is_scantok;
+  k=mp->first+length(mp->cur_exp);
+  if ( k>=mp->max_buf_stack ) {
+    while ( k>=mp->buf_size ) {
+      mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size>>2)));
+    }
+    mp->max_buf_stack=k+1;
+  }
+  j=mp->str_start[mp->cur_exp]; limit=k;
+  while ( mp->first<(size_t)limit ) {
+    mp->buffer[mp->first]=mp->str_pool[j]; incr(j); incr(mp->first);
+  }
+  mp->buffer[limit]='%'; mp->first=limit+1; loc=start; 
+  mp_flush_cur_exp(mp, 0);
+}
+
+@ Here finally is |get_x_next|.
+
+The expression scanning routines to be considered later
+communicate via the global quantities |cur_type| and |cur_exp|;
+we must be very careful to save and restore these quantities while
+macros are being expanded.
+@^inner loop@>
+
+@<Declarations@>=
+void mp_get_x_next (MP mp);
+
+@ @c void mp_get_x_next (MP mp) {
+  pointer save_exp; /* a capsule to save |cur_type| and |cur_exp| */
+  get_t_next;
+  if ( mp->cur_cmd<min_command ) {
+    save_exp=mp_stash_cur_exp(mp);
+    do {  
+      if ( mp->cur_cmd==defined_macro ) 
+        mp_macro_call(mp, mp->cur_mod,null,mp->cur_sym);
+      else 
+        mp_expand(mp);
+      get_t_next;
+     } while (mp->cur_cmd<min_command);
+     mp_unstash_cur_exp(mp, save_exp); /* that restores |cur_type| and |cur_exp| */
+  }
+}
+
+@ Now let's consider the |macro_call| procedure, which is used to start up
+all user-defined macros. Since the arguments to a macro might be expressions,
+|macro_call| is recursive.
+@^recursion@>
+
+The first parameter to |macro_call| points to the reference count of the
+token list that defines the macro. The second parameter contains any
+arguments that have already been parsed (see below).  The third parameter
+points to the symbolic token that names the macro. If the third parameter
+is |null|, the macro was defined by \&{vardef}, so its name can be
+reconstructed from the prefix and ``at'' arguments found within the
+second parameter.
+
+What is this second parameter? It's simply a linked list of one-word items,
+whose |info| fields point to the arguments. In other words, if |arg_list=null|,
+no arguments have been scanned yet; otherwise |info(arg_list)| points to
+the first scanned argument, and |link(arg_list)| points to the list of
+further arguments (if any).
+
+Arguments of type \&{expr} are so-called capsules, which we will
+discuss later when we concentrate on expressions; they can be
+recognized easily because their |link| field is |void|. Arguments of type
+\&{suffix} and \&{text} are token lists without reference counts.
+
+@ After argument scanning is complete, the arguments are moved to the
+|param_stack|. (They can't be put on that stack any sooner, because
+the stack is growing and shrinking in unpredictable ways as more arguments
+are being acquired.)  Then the macro body is fed to the scanner; i.e.,
+the replacement text of the macro is placed at the top of the \MP's
+input stack, so that |get_t_next| will proceed to read it next.
+
+@<Declare the procedure called |macro_call|@>=
+@<Declare the procedure called |print_macro_name|@>
+@<Declare the procedure called |print_arg|@>
+@<Declare the procedure called |scan_text_arg|@>
+void mp_macro_call (MP mp,pointer def_ref, pointer arg_list, 
+                    pointer macro_name) ;
+
+@ @c
+void mp_macro_call (MP mp,pointer def_ref, pointer arg_list, 
+                    pointer macro_name) {
+  /* invokes a user-defined control sequence */
+  pointer r; /* current node in the macro's token list */
+  pointer p,q; /* for list manipulation */
+  integer n; /* the number of arguments */
+  pointer tail = 0; /* tail of the argument list */
+  pointer l_delim=0,r_delim=0; /* a delimiter pair */
+  r=link(def_ref); add_mac_ref(def_ref);
+  if ( arg_list==null ) {
+    n=0;
+  } else {
+   @<Determine the number |n| of arguments already supplied,
+    and set |tail| to the tail of |arg_list|@>;
+  }
+  if ( mp->internal[mp_tracing_macros]>0 ) {
+    @<Show the text of the macro being expanded, and the existing arguments@>;
+  }
+  @<Scan the remaining arguments, if any; set |r| to the first token
+    of the replacement text@>;
+  @<Feed the arguments and replacement text to the scanner@>;
+}
+
+@ @<Show the text of the macro...@>=
+mp_begin_diagnostic(mp); mp_print_ln(mp); 
+mp_print_macro_name(mp, arg_list,macro_name);
+if ( n==3 ) mp_print(mp, "@@#"); /* indicate a suffixed macro */
+mp_show_macro(mp, def_ref,null,100000);
+if ( arg_list!=null ) {
+  n=0; p=arg_list;
+  do {  
+    q=info(p);
+    mp_print_arg(mp, q,n,0);
+    incr(n); p=link(p);
+  } while (p!=null);
+}
+mp_end_diagnostic(mp, false)
+
+
+@ @<Declare the procedure called |print_macro_name|@>=
+void mp_print_macro_name (MP mp,pointer a, pointer n);
+
+@ @c
+void mp_print_macro_name (MP mp,pointer a, pointer n) {
+  pointer p,q; /* they traverse the first part of |a| */
+  if ( n!=null ) {
+    mp_print_text(n);
+  } else  { 
+    p=info(a);
+    if ( p==null ) {
+      mp_print_text(info(info(link(a))));
+    } else { 
+      q=p;
+      while ( link(q)!=null ) q=link(q);
+      link(q)=info(link(a));
+      mp_show_token_list(mp, p,null,1000,0);
+      link(q)=null;
+    }
+  }
+}
+
+@ @<Declare the procedure called |print_arg|@>=
+void mp_print_arg (MP mp,pointer q, integer n, pointer b) ;
+
+@ @c
+void mp_print_arg (MP mp,pointer q, integer n, pointer b) {
+  if ( link(q)==mp_void ) mp_print_nl(mp, "(EXPR");
+  else if ( (b<text_base)&&(b!=text_macro) ) mp_print_nl(mp, "(SUFFIX");
+  else mp_print_nl(mp, "(TEXT");
+  mp_print_int(mp, n); mp_print(mp, ")<-");
+  if ( link(q)==mp_void ) mp_print_exp(mp, q,1);
+  else mp_show_token_list(mp, q,null,1000,0);
+}
+
+@ @<Determine the number |n| of arguments already supplied...@>=
+{  
+  n=1; tail=arg_list;
+  while ( link(tail)!=null ) { 
+    incr(n); tail=link(tail);
+  }
+}
+
+@ @<Scan the remaining arguments, if any; set |r|...@>=
+mp->cur_cmd=comma+1; /* anything |<>comma| will do */
+while ( info(r)>=expr_base ) { 
+  @<Scan the delimited argument represented by |info(r)|@>;
+  r=link(r);
+}
+if ( mp->cur_cmd==comma ) {
+  print_err("Too many arguments to ");
+@.Too many arguments...@>
+  mp_print_macro_name(mp, arg_list,macro_name); mp_print_char(mp, ';');
+  mp_print_nl(mp, "  Missing `"); mp_print_text(r_delim);
+@.Missing `)'...@>
+  mp_print(mp, "' has been inserted");
+  help3("I'm going to assume that the comma I just read was a")
+   ("right delimiter, and then I'll begin expanding the macro.")
+   ("You might want to delete some tokens before continuing.");
+  mp_error(mp);
+}
+if ( info(r)!=general_macro ) {
+  @<Scan undelimited argument(s)@>;
+}
+r=link(r)
+
+@ At this point, the reader will find it advisable to review the explanation
+of token list format that was presented earlier, paying special attention to
+the conventions that apply only at the beginning of a macro's token list.
+
+On the other hand, the reader will have to take the expression-parsing
+aspects of the following program on faith; we will explain |cur_type|
+and |cur_exp| later. (Several things in this program depend on each other,
+and it's necessary to jump into the circle somewhere.)
+
+@<Scan the delimited argument represented by |info(r)|@>=
+if ( mp->cur_cmd!=comma ) {
+  mp_get_x_next(mp);
+  if ( mp->cur_cmd!=left_delimiter ) {
+    print_err("Missing argument to ");
+@.Missing argument...@>
+    mp_print_macro_name(mp, arg_list,macro_name);
+    help3("That macro has more parameters than you thought.")
+     ("I'll continue by pretending that each missing argument")
+     ("is either zero or null.");
+    if ( info(r)>=suffix_base ) {
+      mp->cur_exp=null; mp->cur_type=mp_token_list;
+    } else { 
+      mp->cur_exp=0; mp->cur_type=mp_known;
+    }
+    mp_back_error(mp); mp->cur_cmd=right_delimiter; 
+    goto FOUND;
+  }
+  l_delim=mp->cur_sym; r_delim=mp->cur_mod;
+}
+@<Scan the argument represented by |info(r)|@>;
+if ( mp->cur_cmd!=comma ) 
+  @<Check that the proper right delimiter was present@>;
+FOUND:  
+@<Append the current expression to |arg_list|@>
+
+@ @<Check that the proper right delim...@>=
+if ( (mp->cur_cmd!=right_delimiter)||(mp->cur_mod!=l_delim) ) {
+  if ( info(link(r))>=expr_base ) {
+    mp_missing_err(mp, ",");
+@.Missing `,'@>
+    help3("I've finished reading a macro argument and am about to")
+      ("read another; the arguments weren't delimited correctly.")
+       ("You might want to delete some tokens before continuing.");
+    mp_back_error(mp); mp->cur_cmd=comma;
+  } else { 
+    mp_missing_err(mp, str(text(r_delim)));
+@.Missing `)'@>
+    help2("I've gotten to the end of the macro parameter list.")
+       ("You might want to delete some tokens before continuing.");
+    mp_back_error(mp);
+  }
+}
+
+@ A \&{suffix} or \&{text} parameter will have been scanned as
+a token list pointed to by |cur_exp|, in which case we will have
+|cur_type=token_list|.
+
+@<Append the current expression to |arg_list|@>=
+{ 
+  p=mp_get_avail(mp);
+  if ( mp->cur_type==mp_token_list ) info(p)=mp->cur_exp;
+  else info(p)=mp_stash_cur_exp(mp);
+  if ( mp->internal[mp_tracing_macros]>0 ) {
+    mp_begin_diagnostic(mp); mp_print_arg(mp, info(p),n,info(r)); 
+    mp_end_diagnostic(mp, false);
+  }
+  if ( arg_list==null ) arg_list=p;
+  else link(tail)=p;
+  tail=p; incr(n);
+}
+
+@ @<Scan the argument represented by |info(r)|@>=
+if ( info(r)>=text_base ) {
+  mp_scan_text_arg(mp, l_delim,r_delim);
+} else { 
+  mp_get_x_next(mp);
+  if ( info(r)>=suffix_base ) mp_scan_suffix(mp);
+  else mp_scan_expression(mp);
+}
+
+@ The parameters to |scan_text_arg| are either a pair of delimiters
+or zero; the latter case is for undelimited text arguments, which
+end with the first semicolon or \&{endgroup} or \&{end} that is not
+contained in a group.
+
+@<Declare the procedure called |scan_text_arg|@>=
+void mp_scan_text_arg (MP mp,pointer l_delim, pointer r_delim) ;
+
+@ @c
+void mp_scan_text_arg (MP mp,pointer l_delim, pointer r_delim) {
+  integer balance; /* excess of |l_delim| over |r_delim| */
+  pointer p; /* list tail */
+  mp->warning_info=l_delim; mp->scanner_status=absorbing;
+  p=hold_head; balance=1; link(hold_head)=null;
+  while (1)  { 
+    get_t_next;
+    if ( l_delim==0 ) {
+      @<Adjust the balance for an undelimited argument; |break| if done@>;
+    } else {
+ 	  @<Adjust the balance for a delimited argument; |break| if done@>;
+    }
+    link(p)=mp_cur_tok(mp); p=link(p);
+  }
+  mp->cur_exp=link(hold_head); mp->cur_type=mp_token_list;
+  mp->scanner_status=normal;
+}
+
+@ @<Adjust the balance for a delimited argument...@>=
+if ( mp->cur_cmd==right_delimiter ) { 
+  if ( mp->cur_mod==l_delim ) { 
+    decr(balance);
+    if ( balance==0 ) break;
+  }
+} else if ( mp->cur_cmd==left_delimiter ) {
+  if ( mp->cur_mod==r_delim ) incr(balance);
+}
+
+@ @<Adjust the balance for an undelimited...@>=
+if ( end_of_statement ) { /* |cur_cmd=semicolon|, |end_group|, or |stop| */
+  if ( balance==1 ) { break; }
+  else  { if ( mp->cur_cmd==end_group ) decr(balance); }
+} else if ( mp->cur_cmd==begin_group ) { 
+  incr(balance); 
+}
+
+@ @<Scan undelimited argument(s)@>=
+{ 
+  if ( info(r)<text_macro ) {
+    mp_get_x_next(mp);
+    if ( info(r)!=suffix_macro ) {
+      if ( (mp->cur_cmd==equals)||(mp->cur_cmd==assignment) ) mp_get_x_next(mp);
+    }
+  }
+  switch (info(r)) {
+  case primary_macro:mp_scan_primary(mp); break;
+  case secondary_macro:mp_scan_secondary(mp); break;
+  case tertiary_macro:mp_scan_tertiary(mp); break;
+  case expr_macro:mp_scan_expression(mp); break;
+  case of_macro:
+    @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>;
+    break;
+  case suffix_macro:
+    @<Scan a suffix with optional delimiters@>;
+    break;
+  case text_macro:mp_scan_text_arg(mp, 0,0); break;
+  } /* there are no other cases */
+  mp_back_input(mp); 
+  @<Append the current expression to |arg_list|@>;
+}
+
+@ @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>=
+{ 
+  mp_scan_expression(mp); p=mp_get_avail(mp); info(p)=mp_stash_cur_exp(mp);
+  if ( mp->internal[mp_tracing_macros]>0 ) { 
+    mp_begin_diagnostic(mp); mp_print_arg(mp, info(p),n,0); 
+    mp_end_diagnostic(mp, false);
+  }
+  if ( arg_list==null ) arg_list=p; else link(tail)=p;
+  tail=p;incr(n);
+  if ( mp->cur_cmd!=of_token ) {
+    mp_missing_err(mp, "of"); mp_print(mp, " for ");
+@.Missing `of'@>
+    mp_print_macro_name(mp, arg_list,macro_name);
+    help1("I've got the first argument; will look now for the other.");
+    mp_back_error(mp);
+  }
+  mp_get_x_next(mp); mp_scan_primary(mp);
+}
+
+@ @<Scan a suffix with optional delimiters@>=
+{ 
+  if ( mp->cur_cmd!=left_delimiter ) {
+    l_delim=null;
+  } else { 
+    l_delim=mp->cur_sym; r_delim=mp->cur_mod; mp_get_x_next(mp);
+  };
+  mp_scan_suffix(mp);
+  if ( l_delim!=null ) {
+    if ((mp->cur_cmd!=right_delimiter)||(mp->cur_mod!=l_delim) ) {
+      mp_missing_err(mp, str(text(r_delim)));
+@.Missing `)'@>
+      help2("I've gotten to the end of the macro parameter list.")
+         ("You might want to delete some tokens before continuing.");
+      mp_back_error(mp);
+    }
+    mp_get_x_next(mp);
+  }
+}
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the arguments and replacement text to the scanner@>=
+while ( token_state &&(loc==null) ) mp_end_token_list(mp); /* conserve stack space */
+if ( mp->param_ptr+n>mp->max_param_stack ) {
+  mp->max_param_stack=mp->param_ptr+n;
+  if ( mp->max_param_stack>mp->param_size )
+    mp_overflow(mp, "parameter stack size",mp->param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+}
+mp_begin_token_list(mp, def_ref,macro); name=macro_name; loc=r;
+if ( n>0 ) {
+  p=arg_list;
+  do {  
+   mp->param_stack[mp->param_ptr]=info(p); incr(mp->param_ptr); p=link(p);
+  } while (p!=null);
+  mp_flush_list(mp, arg_list);
+}
+
+@ It's sometimes necessary to put a single argument onto |param_stack|.
+The |stack_argument| subroutine does this.
+
+@c void mp_stack_argument (MP mp,pointer p) { 
+  if ( mp->param_ptr==mp->max_param_stack ) {
+    incr(mp->max_param_stack);
+    if ( mp->max_param_stack>mp->param_size )
+      mp_overflow(mp, "parameter stack size",mp->param_size);
+@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@>
+  }
+  mp->param_stack[mp->param_ptr]=p; incr(mp->param_ptr);
+}
+
+@* \[33] Conditional processing.
+Let's consider now the way \&{if} commands are handled.
+
+Conditions can be inside conditions, and this nesting has a stack
+that is independent of other stacks.
+Four global variables represent the top of the condition stack:
+|cond_ptr| points to pushed-down entries, if~any; |cur_if| tells whether
+we are processing \&{if} or \&{elseif}; |if_limit| specifies
+the largest code of a |fi_or_else| command that is syntactically legal;
+and |if_line| is the line number at which the current conditional began.
+
+If no conditions are currently in progress, the condition stack has the
+special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
+Otherwise |cond_ptr| points to a two-word node; the |type|, |name_type|, and
+|link| fields of the first word contain |if_limit|, |cur_if|, and
+|cond_ptr| at the next level, and the second word contains the
+corresponding |if_line|.
+
+@d if_node_size 2 /* number of words in stack entry for conditionals */
+@d if_line_field(A) mp->mem[(A)+1].cint
+@d if_code 1 /* code for \&{if} being evaluated */
+@d fi_code 2 /* code for \&{fi} */
+@d else_code 3 /* code for \&{else} */
+@d else_if_code 4 /* code for \&{elseif} */
+
+@<Glob...@>=
+pointer cond_ptr; /* top of the condition stack */
+integer if_limit; /* upper bound on |fi_or_else| codes */
+small_number cur_if; /* type of conditional being worked on */
+integer if_line; /* line where that conditional began */
+
+@ @<Set init...@>=
+mp->cond_ptr=null; mp->if_limit=normal; mp->cur_if=0; mp->if_line=0;
+
+@ @<Put each...@>=
+mp_primitive(mp, "if",if_test,if_code);
+@:if_}{\&{if} primitive@>
+mp_primitive(mp, "fi",fi_or_else,fi_code); mp->eqtb[frozen_fi]=mp->eqtb[mp->cur_sym];
+@:fi_}{\&{fi} primitive@>
+mp_primitive(mp, "else",fi_or_else,else_code);
+@:else_}{\&{else} primitive@>
+mp_primitive(mp, "elseif",fi_or_else,else_if_code);
+@:else_if_}{\&{elseif} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case if_test:
+case fi_or_else: 
+  switch (m) {
+  case if_code:mp_print(mp, "if"); break;
+  case fi_code:mp_print(mp, "fi");  break;
+  case else_code:mp_print(mp, "else"); break;
+  default: mp_print(mp, "elseif"); break;
+  }
+  break;
+
+@ Here is a procedure that ignores text until coming to an \&{elseif},
+\&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$
+nesting. After it has acted, |cur_mod| will indicate the token that
+was found.
+
+\MP's smallest two command codes are |if_test| and |fi_or_else|; this
+makes the skipping process a bit simpler.
+
+@c 
+void mp_pass_text (MP mp) {
+  integer l = 0;
+  mp->scanner_status=skipping;
+  mp->warning_info=mp_true_line(mp);
+  while (1)  { 
+    get_t_next;
+    if ( mp->cur_cmd<=fi_or_else ) {
+      if ( mp->cur_cmd<fi_or_else ) {
+        incr(l);
+      } else { 
+        if ( l==0 ) break;
+        if ( mp->cur_mod==fi_code ) decr(l);
+      }
+    } else {
+      @<Decrease the string reference count,
+       if the current token is a string@>;
+    }
+  }
+  mp->scanner_status=normal;
+}
+
+@ @<Decrease the string reference count...@>=
+if ( mp->cur_cmd==string_token ) { delete_str_ref(mp->cur_mod); }
+
+@ When we begin to process a new \&{if}, we set |if_limit:=if_code|; then
+if \&{elseif} or \&{else} or \&{fi} occurs before the current \&{if}
+condition has been evaluated, a colon will be inserted.
+A construction like `\.{if fi}' would otherwise get \MP\ confused.
+
+@<Push the condition stack@>=
+{ p=mp_get_node(mp, if_node_size); link(p)=mp->cond_ptr; type(p)=mp->if_limit;
+  name_type(p)=mp->cur_if; if_line_field(p)=mp->if_line;
+  mp->cond_ptr=p; mp->if_limit=if_code; mp->if_line=mp_true_line(mp); 
+  mp->cur_if=if_code;
+}
+
+@ @<Pop the condition stack@>=
+{ p=mp->cond_ptr; mp->if_line=if_line_field(p);
+  mp->cur_if=name_type(p); mp->if_limit=type(p); mp->cond_ptr=link(p);
+  mp_free_node(mp, p,if_node_size);
+}
+
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@c void mp_change_if_limit (MP mp,small_number l, pointer p) {
+  pointer q;
+  if ( p==mp->cond_ptr ) {
+    mp->if_limit=l; /* that's the easy case */
+  } else  { 
+    q=mp->cond_ptr;
+    while (1) { 
+      if ( q==null ) mp_confusion(mp, "if");
+@:this can't happen if}{\quad if@>
+      if ( link(q)==p ) { 
+        type(q)=l; return;
+      }
+      q=link(q);
+    }
+  }
+}
+
+@ The user is supposed to put colons into the proper parts of conditional
+statements. Therefore, \MP\ has to check for their presence.
+
+@c 
+void mp_check_colon (MP mp) { 
+  if ( mp->cur_cmd!=colon ) { 
+    mp_missing_err(mp, ":");
+@.Missing `:'@>
+    help2("There should've been a colon after the condition.")
+         ("I shall pretend that one was there.");;
+    mp_back_error(mp);
+  }
+}
+
+@ A condition is started when the |get_x_next| procedure encounters
+an |if_test| command; in that case |get_x_next| calls |conditional|,
+which is a recursive procedure.
+@^recursion@>
+
+@c void mp_conditional (MP mp) {
+  pointer save_cond_ptr; /* |cond_ptr| corresponding to this conditional */
+  int new_if_limit; /* future value of |if_limit| */
+  pointer p; /* temporary register */
+  @<Push the condition stack@>; 
+  save_cond_ptr=mp->cond_ptr;
+RESWITCH: 
+  mp_get_boolean(mp); new_if_limit=else_if_code;
+  if ( mp->internal[mp_tracing_commands]>unity ) {
+    @<Display the boolean value of |cur_exp|@>;
+  }
+FOUND: 
+  mp_check_colon(mp);
+  if ( mp->cur_exp==true_code ) {
+    mp_change_if_limit(mp, new_if_limit,save_cond_ptr);
+    return; /* wait for \&{elseif}, \&{else}, or \&{fi} */
+  };
+  @<Skip to \&{elseif} or \&{else} or \&{fi}, then |goto done|@>;
+DONE: 
+  mp->cur_if=mp->cur_mod; mp->if_line=mp_true_line(mp);
+  if ( mp->cur_mod==fi_code ) {
+    @<Pop the condition stack@>
+  } else if ( mp->cur_mod==else_if_code ) {
+    goto RESWITCH;
+  } else  { 
+    mp->cur_exp=true_code; new_if_limit=fi_code; mp_get_x_next(mp); 
+    goto FOUND;
+  }
+}
+
+@ In a construction like `\&{if} \&{if} \&{true}: $0=1$: \\{foo}
+\&{else}: \\{bar} \&{fi}', the first \&{else}
+that we come to after learning that the \&{if} is false is not the
+\&{else} we're looking for. Hence the following curious logic is needed.
+
+@<Skip to \&{elseif}...@>=
+while (1) { 
+  mp_pass_text(mp);
+  if ( mp->cond_ptr==save_cond_ptr ) goto DONE;
+  else if ( mp->cur_mod==fi_code ) @<Pop the condition stack@>;
+}
+
+
+@ @<Display the boolean value...@>=
+{ mp_begin_diagnostic(mp);
+  if ( mp->cur_exp==true_code ) mp_print(mp, "{true}");
+  else mp_print(mp, "{false}");
+  mp_end_diagnostic(mp, false);
+}
+
+@ The processing of conditionals is complete except for the following
+code, which is actually part of |get_x_next|. It comes into play when
+\&{elseif}, \&{else}, or \&{fi} is scanned.
+
+@<Terminate the current conditional and skip to \&{fi}@>=
+if ( mp->cur_mod>mp->if_limit ) {
+  if ( mp->if_limit==if_code ) { /* condition not yet evaluated */
+    mp_missing_err(mp, ":");
+@.Missing `:'@>
+    mp_back_input(mp); mp->cur_sym=frozen_colon; mp_ins_error(mp);
+  } else  { 
+    print_err("Extra "); mp_print_cmd_mod(mp, fi_or_else,mp->cur_mod);
+@.Extra else@>
+@.Extra elseif@>
+@.Extra fi@>
+    help1("I'm ignoring this; it doesn't match any if.");
+    mp_error(mp);
+  }
+} else  { 
+  while ( mp->cur_mod!=fi_code ) mp_pass_text(mp); /* skip to \&{fi} */
+  @<Pop the condition stack@>;
+}
+
+@* \[34] Iterations.
+To bring our treatment of |get_x_next| to a close, we need to consider what
+\MP\ does when it sees \&{for}, \&{forsuffixes}, and \&{forever}.
+
+There's a global variable |loop_ptr| that keeps track of the \&{for} loops
+that are currently active. If |loop_ptr=null|, no loops are in progress;
+otherwise |info(loop_ptr)| points to the iterative text of the current
+(innermost) loop, and |link(loop_ptr)| points to the data for any other
+loops that enclose the current one.
+
+A loop-control node also has two other fields, called |loop_type| and
+|loop_list|, whose contents depend on the type of loop:
+
+\yskip\indent|loop_type(loop_ptr)=null| means that |loop_list(loop_ptr)|
+points to a list of one-word nodes whose |info| fields point to the
+remaining argument values of a suffix list and expression list.
+
+\yskip\indent|loop_type(loop_ptr)=mp_void| means that the current loop is
+`\&{forever}'.
+
+\yskip\indent|loop_type(loop_ptr)=progression_flag| means that
+|p=loop_list(loop_ptr)| points to a ``progression node'' and |value(p)|,
+|step_size(p)|, and |final_value(p)| contain the data for an arithmetic
+progression.
+
+\yskip\indent|loop_type(loop_ptr)=p>mp_void| means that |p| points to an edge
+header and |loop_list(loop_ptr)| points into the graphical object list for
+that edge header.
+
+\yskip\noindent In the case of a progression node, the first word is not used
+because the link field of words in the dynamic memory area cannot be arbitrary.
+
+@d loop_list_loc(A) ((A)+1) /* where the |loop_list| field resides */
+@d loop_type(A) info(loop_list_loc((A))) /* the type of \&{for} loop */
+@d loop_list(A) link(loop_list_loc((A))) /* the remaining list elements */
+@d loop_node_size 2 /* the number of words in a loop control node */
+@d progression_node_size 4 /* the number of words in a progression node */
+@d step_size(A) mp->mem[(A)+2].sc /* the step size in an arithmetic progression */
+@d final_value(A) mp->mem[(A)+3].sc /* the final value in an arithmetic progression */
+@d progression_flag (null+2)
+  /* |loop_type| value when |loop_list| points to a progression node */
+
+@<Glob...@>=
+pointer loop_ptr; /* top of the loop-control-node stack */
+
+@ @<Set init...@>=
+mp->loop_ptr=null;
+
+@ If the expressions that define an arithmetic progression in
+a \&{for} loop don't have known numeric values, the |bad_for|
+subroutine screams at the user.
+
+@c void mp_bad_for (MP mp, const char * s) {
+  mp_disp_err(mp, null,"Improper "); /* show the bad expression above the message */
+@.Improper...replaced by 0@>
+  mp_print(mp, s); mp_print(mp, " has been replaced by 0");
+  help4("When you say `for x=a step b until c',")
+    ("the initial value `a' and the step size `b'")
+    ("and the final value `c' must have known numeric values.")
+    ("I'm zeroing this one. Proceed, with fingers crossed.");
+  mp_put_get_flush_error(mp, 0);
+}
+
+@ Here's what \MP\ does when \&{for}, \&{forsuffixes}, or \&{forever}
+has just been scanned. (This code requires slight familiarity with
+expression-parsing routines that we have not yet discussed; but it seems
+to belong in the present part of the program, even though the original author
+didn't write it until later. The reader may wish to come back to it.)
+
+@c void mp_begin_iteration (MP mp) {
+  halfword m; /* |expr_base| (\&{for}) or |suffix_base| (\&{forsuffixes}) */
+  halfword n; /* hash address of the current symbol */
+  pointer s; /* the new loop-control node */
+  pointer p; /* substitution list for |scan_toks| */
+  pointer q;  /* link manipulation register */
+  pointer pp; /* a new progression node */
+  m=mp->cur_mod; n=mp->cur_sym; s=mp_get_node(mp, loop_node_size);
+  if ( m==start_forever ){ 
+    loop_type(s)=mp_void; p=null; mp_get_x_next(mp);
+  } else { 
+    mp_get_symbol(mp); p=mp_get_node(mp, token_node_size);
+    info(p)=mp->cur_sym; value(p)=m;
+    mp_get_x_next(mp);
+    if ( mp->cur_cmd==within_token ) {
+      @<Set up a picture iteration@>;
+    } else { 
+      @<Check for the |"="| or |":="| in a loop header@>;
+      @<Scan the values to be used in the loop@>;
+    }
+  }
+  @<Check for the presence of a colon@>;
+  @<Scan the loop text and put it on the loop control stack@>;
+  mp_resume_iteration(mp);
+}
+
+@ @<Check for the |"="| or |":="| in a loop header@>=
+if ( (mp->cur_cmd!=equals)&&(mp->cur_cmd!=assignment) ) { 
+  mp_missing_err(mp, "=");
+@.Missing `='@>
+  help3("The next thing in this loop should have been `=' or `:='.")
+    ("But don't worry; I'll pretend that an equals sign")
+    ("was present, and I'll look for the values next.");
+  mp_back_error(mp);
+}
+
+@ @<Check for the presence of a colon@>=
+if ( mp->cur_cmd!=colon ) { 
+  mp_missing_err(mp, ":");
+@.Missing `:'@>
+  help3("The next thing in this loop should have been a `:'.")
+    ("So I'll pretend that a colon was present;")
+    ("everything from here to `endfor' will be iterated.");
+  mp_back_error(mp);
+}
+
+@ We append a special |frozen_repeat_loop| token in place of the
+`\&{endfor}' at the end of the loop. This will come through \MP's scanner
+at the proper time to cause the loop to be repeated.
+
+(If the user tries some shenanigan like `\&{for} $\ldots$ \&{let} \&{endfor}',
+he will be foiled by the |get_symbol| routine, which keeps frozen
+tokens unchanged. Furthermore the |frozen_repeat_loop| is an \&{outer}
+token, so it won't be lost accidentally.)
+
+@ @<Scan the loop text...@>=
+q=mp_get_avail(mp); info(q)=frozen_repeat_loop;
+mp->scanner_status=loop_defining; mp->warning_info=n;
+info(s)=mp_scan_toks(mp, iteration,p,q,0); mp->scanner_status=normal;
+link(s)=mp->loop_ptr; mp->loop_ptr=s
+
+@ @<Initialize table...@>=
+eq_type(frozen_repeat_loop)=repeat_loop+outer_tag;
+text(frozen_repeat_loop)=intern(" ENDFOR");
+
+@ The loop text is inserted into \MP's scanning apparatus by the
+|resume_iteration| routine.
+
+@c void mp_resume_iteration (MP mp) {
+  pointer p,q; /* link registers */
+  p=loop_type(mp->loop_ptr);
+  if ( p==progression_flag ) { 
+    p=loop_list(mp->loop_ptr); /* now |p| points to a progression node */
+    mp->cur_exp=value(p);
+    if ( @<The arithmetic progression has ended@> ) {
+      mp_stop_iteration(mp);
+      return;
+    }
+    mp->cur_type=mp_known; q=mp_stash_cur_exp(mp); /* make |q| an \&{expr} argument */
+    value(p)=mp->cur_exp+step_size(p); /* set |value(p)| for the next iteration */
+  } else if ( p==null ) { 
+    p=loop_list(mp->loop_ptr);
+    if ( p==null ) {
+      mp_stop_iteration(mp);
+      return;
+    }
+    loop_list(mp->loop_ptr)=link(p); q=info(p); free_avail(p);
+  } else if ( p==mp_void ) { 
+    mp_begin_token_list(mp, info(mp->loop_ptr),forever_text); return;
+  } else {
+    @<Make |q| a capsule containing the next picture component from
+      |loop_list(loop_ptr)| or |goto not_found|@>;
+  }
+  mp_begin_token_list(mp, info(mp->loop_ptr),loop_text);
+  mp_stack_argument(mp, q);
+  if ( mp->internal[mp_tracing_commands]>unity ) {
+     @<Trace the start of a loop@>;
+  }
+  return;
+NOT_FOUND:
+  mp_stop_iteration(mp);
+}
+
+@ @<The arithmetic progression has ended@>=
+((step_size(p)>0)&&(mp->cur_exp>final_value(p)))||
+ ((step_size(p)<0)&&(mp->cur_exp<final_value(p)))
+
+@ @<Trace the start of a loop@>=
+{ 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{loop value=");
+@.loop value=n@>
+  if ( (q!=null)&&(link(q)==mp_void) ) mp_print_exp(mp, q,1);
+  else mp_show_token_list(mp, q,null,50,0);
+  mp_print_char(mp, '}'); mp_end_diagnostic(mp, false);
+}
+
+@ @<Make |q| a capsule containing the next picture component from...@>=
+{ q=loop_list(mp->loop_ptr);
+  if ( q==null ) goto NOT_FOUND;
+  skip_component(q) goto NOT_FOUND;
+  mp->cur_exp=mp_copy_objects(mp, loop_list(mp->loop_ptr),q);
+  mp_init_bbox(mp, mp->cur_exp);
+  mp->cur_type=mp_picture_type;
+  loop_list(mp->loop_ptr)=q;
+  q=mp_stash_cur_exp(mp);
+}
+
+@ A level of loop control disappears when |resume_iteration| has decided
+not to resume, or when an \&{exitif} construction has removed the loop text
+from the input stack.
+
+@c void mp_stop_iteration (MP mp) {
+  pointer p,q; /* the usual */
+  p=loop_type(mp->loop_ptr);
+  if ( p==progression_flag )  {
+    mp_free_node(mp, loop_list(mp->loop_ptr),progression_node_size);
+  } else if ( p==null ){ 
+    q=loop_list(mp->loop_ptr);
+    while ( q!=null ) {
+      p=info(q);
+      if ( p!=null ) {
+        if ( link(p)==mp_void ) { /* it's an \&{expr} parameter */
+          mp_recycle_value(mp, p); mp_free_node(mp, p,value_node_size);
+        } else {
+          mp_flush_token_list(mp, p); /* it's a \&{suffix} or \&{text} parameter */
+        }
+      }
+      p=q; q=link(q); free_avail(p);
+    }
+  } else if ( p>progression_flag ) {
+    delete_edge_ref(p);
+  }
+  p=mp->loop_ptr; mp->loop_ptr=link(p); mp_flush_token_list(mp, info(p));
+  mp_free_node(mp, p,loop_node_size);
+}
+
+@ Now that we know all about loop control, we can finish up
+the missing portion of |begin_iteration| and we'll be done.
+
+The following code is performed after the `\.=' has been scanned in
+a \&{for} construction (if |m=expr_base|) or a \&{forsuffixes} construction
+(if |m=suffix_base|).
+
+@<Scan the values to be used in the loop@>=
+loop_type(s)=null; q=loop_list_loc(s); link(q)=null; /* |link(q)=loop_list(s)| */
+do {  
+  mp_get_x_next(mp);
+  if ( m!=expr_base ) {
+    mp_scan_suffix(mp);
+  } else { 
+    if ( mp->cur_cmd>=colon ) if ( mp->cur_cmd<=comma ) 
+	  goto CONTINUE;
+    mp_scan_expression(mp);
+    if ( mp->cur_cmd==step_token ) if ( q==loop_list_loc(s) ) {
+      @<Prepare for step-until construction and |break|@>;
+    }
+    mp->cur_exp=mp_stash_cur_exp(mp);
+  }
+  link(q)=mp_get_avail(mp); q=link(q); 
+  info(q)=mp->cur_exp; mp->cur_type=mp_vacuous;
+CONTINUE:
+  ;
+} while (mp->cur_cmd==comma)
+
+@ @<Prepare for step-until construction and |break|@>=
+{ 
+  if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "initial value");
+  pp=mp_get_node(mp, progression_node_size); value(pp)=mp->cur_exp;
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "step size");
+  step_size(pp)=mp->cur_exp;
+  if ( mp->cur_cmd!=until_token ) { 
+    mp_missing_err(mp, "until");
+@.Missing `until'@>
+    help2("I assume you meant to say `until' after `step'.")
+      ("So I'll look for the final value and colon next.");
+    mp_back_error(mp);
+  }
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "final value");
+  final_value(pp)=mp->cur_exp; loop_list(s)=pp;
+  loop_type(s)=progression_flag; 
+  break;
+}
+
+@ The last case is when we have just seen ``\&{within}'', and we need to
+parse a picture expression and prepare to iterate over it.
+
+@<Set up a picture iteration@>=
+{ mp_get_x_next(mp);
+  mp_scan_expression(mp);
+  @<Make sure the current expression is a known picture@>;
+  loop_type(s)=mp->cur_exp; mp->cur_type=mp_vacuous;
+  q=link(dummy_loc(mp->cur_exp));
+  if ( q!= null ) 
+    if ( is_start_or_stop(q) )
+      if ( mp_skip_1component(mp, q)==null ) q=link(q);
+  loop_list(s)=q;
+}
+
+@ @<Make sure the current expression is a known picture@>=
+if ( mp->cur_type!=mp_picture_type ) {
+  mp_disp_err(mp, null,"Improper iteration spec has been replaced by nullpicture");
+  help1("When you say `for x in p', p must be a known picture.");
+  mp_put_get_flush_error(mp, mp_get_node(mp, edge_header_size));
+  mp_init_edges(mp, mp->cur_exp); mp->cur_type=mp_picture_type;
+}
+
+@* \[35] File names.
+It's time now to fret about file names.  Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+@^system dependencies@>
+
+\MP\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system.  The extension of an input file is assumed to be
+`\.{.mp}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \MP; it is `\.{.tfm}' on the font
+metric files that describe characters in any fonts created by \MP; it is
+`\.{.ps}' or `.{\it nnn}' for some number {\it nnn} on the \ps\ output files;
+and it is `\.{.mem}' on the mem files written by \.{INIMP} to initialize \MP.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area.  If an input file cannot be
+found on the specified area, \MP\ will look for it on a special system
+area; this special area is intended for commonly used input files.
+
+Simple uses of \MP\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{input} \.{cmr10}'
+instead of `\.{input} \.{cmr10.new}'. Simple file
+names are best, because they make the \MP\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \MP. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+@ \MP\ uses the same conventions that have proved to be satisfactory for
+\TeX\ and \MF. In order to isolate the system-dependent aspects of file names,
+@^system dependencies@>
+the system-independent parts of \MP\ are expressed in terms
+of three system-dependent
+procedures called |begin_name|, |more_name|, and |end_name|. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;\,|more_name|(c_n);
+\,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called |cur_name|\penalty10000\hskip-.05em,
+|cur_area|, and |cur_ext|; the latter two are null (i.e.,
+|""|), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \MP\ needs
+to know when the file name ends. The |more_name| routine is a function
+(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
+\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
+returns |false|; or, it returns |true| and $c_n$ is the last character
+on the current input line. In other words,
+|more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able
+to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
+whether $|more_name|(c_n)$ returned |true| or |false|.
+
+@<Glob...@>=
+char * cur_name; /* name of file just scanned */
+char * cur_area; /* file area just scanned, or \.{""} */
+char * cur_ext; /* file extension just scanned, or \.{""} */
+
+@ It is easier to maintain reference counts if we assign initial values.
+
+@<Set init...@>=
+mp->cur_name=xstrdup(""); 
+mp->cur_area=xstrdup(""); 
+mp->cur_ext=xstrdup("");
+
+@ @<Dealloc variables@>=
+xfree(mp->cur_area);
+xfree(mp->cur_name);
+xfree(mp->cur_ext);
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure:  If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null.  If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters.  Note that these variables
+cannot be of type |pool_pointer| because a string pool compaction could occur
+while scanning a file name.
+
+@<Glob...@>=
+integer area_delimiter;
+  /* most recent `\.>' or `\.:' relative to |str_start[str_ptr]| */
+integer ext_delimiter; /* the relevant `\..', if any */
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@<Declare subroutines for parsing file names@>=
+void mp_begin_name (MP mp) { 
+  xfree(mp->cur_name); 
+  xfree(mp->cur_area); 
+  xfree(mp->cur_ext);
+  mp->area_delimiter=-1; 
+  mp->ext_delimiter=-1;
+}
+
+@ And here's the second.
+@^system dependencies@>
+
+@<Declare subroutines for parsing file names@>=
+boolean mp_more_name (MP mp, ASCII_code c) { 
+  if (c==' ') {
+    return false;
+  } else { 
+    if ( (c=='>')||(c==':') ) { 
+      mp->area_delimiter=mp->pool_ptr; 
+      mp->ext_delimiter=-1;
+    } else if ( (c=='.')&&(mp->ext_delimiter<0) ) {
+      mp->ext_delimiter=mp->pool_ptr;
+    }
+    str_room(1); append_char(c); /* contribute |c| to the current string */
+    return true;
+  }
+}
+
+@ The third.
+@^system dependencies@>
+
+@d copy_pool_segment(A,B,C) { 
+      A = xmalloc(C+1,sizeof(char)); 
+      strncpy(A,(char *)(mp->str_pool+B),C);  
+      A[C] = 0;}
+
+@<Declare subroutines for parsing file names@>=
+void mp_end_name (MP mp) {
+  pool_pointer s; /* length of area, name, and extension */
+  unsigned int len;
+  /* "my/w.mp" */
+  s = mp->str_start[mp->str_ptr];
+  if ( mp->area_delimiter<0 ) {    
+    mp->cur_area=xstrdup("");
+  } else {
+    len = mp->area_delimiter-s; 
+    copy_pool_segment(mp->cur_area,s,len);
+    s += len+1;
+  }
+  if ( mp->ext_delimiter<0 ) {
+    mp->cur_ext=xstrdup("");
+    len = mp->pool_ptr-s; 
+  } else {
+    copy_pool_segment(mp->cur_ext,mp->ext_delimiter,(mp->pool_ptr-mp->ext_delimiter));
+    len = mp->ext_delimiter-s;
+  }
+  copy_pool_segment(mp->cur_name,s,len);
+  mp->pool_ptr=s; /* don't need this partial string */
+}
+
+@ Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+@^system dependencies@>
+
+@<Basic printing...@>=
+void mp_print_file_name (MP mp, char * n, char * a, char * e) { 
+  mp_print(mp, a); mp_print(mp, n); mp_print(mp, e);
+}
+
+@ Another system-dependent routine is needed to convert three internal
+\MP\ strings
+to the |name_of_file| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(A) { c=(A); 
+  if ( k<file_name_size ) {
+    mp->name_of_file[k]=xchr(c);
+    incr(k);
+  }
+}
+
+@<Declare subroutines for parsing file names@>=
+void mp_pack_file_name (MP mp, const char *n, const char *a, const char *e) {
+  integer k; /* number of positions filled in |name_of_file| */
+  ASCII_code c; /* character being packed */
+  const char *j; /* a character  index */
+  k=0;
+  assert(n);
+  if (a!=NULL) {
+    for (j=a;*j;j++) { append_to_name(*j); }
+  }
+  for (j=n;*j;j++) { append_to_name(*j); }
+  if (e!=NULL) {
+    for (j=e;*j;j++) { append_to_name(*j); }
+  }
+  mp->name_of_file[k]=0;
+  mp->name_length=k; 
+}
+
+@ @<Internal library declarations@>=
+void mp_pack_file_name (MP mp, const char *n, const char *a, const char *e) ;
+
+@ A messier routine is also needed, since mem file names must be scanned
+before \MP's string mechanism has been initialized. We shall use the
+global variable |MP_mem_default| to supply the text for default system areas
+and extensions related to mem files.
+@^system dependencies@>
+
+@d mem_default_length 9 /* length of the |MP_mem_default| string */
+@d mem_ext_length 4 /* length of its `\.{.mem}' part */
+@d mem_extension ".mem" /* the extension, as a \.{WEB} constant */
+
+@<Glob...@>=
+char *MP_mem_default;
+
+@ @<Option variables@>=
+char *mem_name; /* for commandline */
+
+@ @<Allocate or initialize ...@>=
+mp->MP_mem_default = xstrdup("plain.mem");
+mp->mem_name = xstrdup(opt->mem_name);
+@.plain@>
+@^system dependencies@>
+
+@ @<Dealloc variables@>=
+xfree(mp->MP_mem_default);
+xfree(mp->mem_name);
+
+@ @<Check the ``constant'' values for consistency@>=
+if ( mem_default_length>file_name_size ) mp->bad=20;
+
+@ Here is the messy routine that was just mentioned. It sets |name_of_file|
+from the first |n| characters of |MP_mem_default|, followed by
+|buffer[a..b-1]|, followed by the last |mem_ext_length| characters of
+|MP_mem_default|.
+
+We dare not give error messages here, since \MP\ calls this routine before
+the |error| routine is ready to roll. Instead, we simply drop excess characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+@^system dependencies@>
+
+@c void mp_pack_buffered_name (MP mp,small_number n, integer a,
+                               integer b) {
+  integer k; /* number of positions filled in |name_of_file| */
+  ASCII_code c; /* character being packed */
+  integer j; /* index into |buffer| or |MP_mem_default| */
+  if ( n+b-a+1+mem_ext_length>file_name_size )
+    b=a+file_name_size-n-1-mem_ext_length;
+  k=0;
+  for (j=0;j<n;j++) {
+    append_to_name(xord((int)mp->MP_mem_default[j]));
+  }
+  for (j=a;j<b;j++) {
+    append_to_name(mp->buffer[j]);
+  }
+  for (j=mem_default_length-mem_ext_length;
+      j<mem_default_length;j++) {
+    append_to_name(xord((int)mp->MP_mem_default[j]));
+  } 
+  mp->name_of_file[k]=0;
+  mp->name_length=k; 
+}
+
+@ Here is the only place we use |pack_buffered_name|. This part of the program
+becomes active when a ``virgin'' \MP\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+mem file by typing `\.\&' after the initial `\.{**}' prompt.  The buffer
+contains the first line of input in |buffer[loc..(last-1)]|, where
+|loc<last| and |buffer[loc]<>" "|.
+
+@<Declarations@>=
+boolean mp_open_mem_file (MP mp) ;
+
+@ @c
+boolean mp_open_mem_file (MP mp) {
+  int j; /* the first space after the file name */
+  if (mp->mem_name!=NULL) {
+    mp->mem_file = (mp->open_file)(mp,mp->mem_name, "r", mp_filetype_memfile);
+    if ( mp->mem_file ) return true;
+  }
+  j=loc;
+  if ( mp->buffer[loc]=='&' ) {
+    incr(loc); j=loc; mp->buffer[mp->last]=' ';
+    while ( mp->buffer[j]!=' ' ) incr(j);
+    mp_pack_buffered_name(mp, 0,loc,j); /* try first without the system file area */
+    if ( mp_w_open_in(mp, &mp->mem_file) ) goto FOUND;
+    wake_up_terminal;
+    wterm_ln("Sorry, I can\'t find that mem file; will try PLAIN.");
+@.Sorry, I can't find...@>
+    update_terminal;
+  }
+  /* now pull out all the stops: try for the system \.{plain} file */
+  mp_pack_buffered_name(mp, mem_default_length-mem_ext_length,0,0);
+  if ( ! mp_w_open_in(mp, &mp->mem_file) ) {
+    wake_up_terminal;
+    wterm_ln("I can\'t find the PLAIN mem file!\n");
+@.I can't find PLAIN...@>
+@.plain@>
+    return false;
+  }
+FOUND:
+  loc=j; return true;
+}
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MP\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this.
+@^system dependencies@>
+
+@<Declarations@>=
+#define mp_a_make_name_string(A,B)  mp_make_name_string(A)
+#define mp_b_make_name_string(A,B)  mp_make_name_string(A)
+#define mp_w_make_name_string(A,B)  mp_make_name_string(A)
+
+@ @c 
+str_number mp_make_name_string (MP mp) {
+  int k; /* index into |name_of_file| */
+  str_room(mp->name_length);
+  for (k=0;k<mp->name_length;k++) {
+    append_char(xord((int)mp->name_of_file[k]));
+  }
+  return mp_make_string(mp);
+}
+
+@ Now let's consider the ``driver''
+routines by which \MP\ deals with file names
+in a system-independent manner.  First comes a procedure that looks for a
+file name in the input by taking the information from the input buffer.
+(We can't use |get_next|, because the conversion to tokens would
+destroy necessary information.)
+
+This procedure doesn't allow semicolons or percent signs to be part of
+file names, because of other conventions of \MP.
+{\sl The {\logos METAFONT\/}book} doesn't
+use semicolons or percents immediately after file names, but some users
+no doubt will find it natural to do so; therefore system-dependent
+changes to allow such characters in file names should probably
+be made with reluctance, and only when an entire file name that
+includes special characters is ``quoted'' somehow.
+@^system dependencies@>
+
+@c void mp_scan_file_name (MP mp) { 
+  mp_begin_name(mp);
+  while ( mp->buffer[loc]==' ' ) incr(loc);
+  while (1) { 
+    if ( (mp->buffer[loc]==';')||(mp->buffer[loc]=='%') ) break;
+    if ( ! mp_more_name(mp, mp->buffer[loc]) ) break;
+    incr(loc);
+  }
+  mp_end_name(mp);
+}
+
+@ Here is another version that takes its input from a string.
+
+@<Declare subroutines for parsing file names@>=
+void mp_str_scan_file (MP mp,  str_number s) {
+  pool_pointer p,q; /* current position and stopping point */
+  mp_begin_name(mp);
+  p=mp->str_start[s]; q=str_stop(s);
+  while ( p<q ){ 
+    if ( ! mp_more_name(mp, mp->str_pool[p]) ) break;
+    incr(p);
+  }
+  mp_end_name(mp);
+}
+
+@ And one that reads from a |char*|.
+
+@<Declare subroutines for parsing file names@>=
+void mp_ptr_scan_file (MP mp,  char *s) {
+  char *p, *q; /* current position and stopping point */
+  mp_begin_name(mp);
+  p=s; q=p+strlen(s);
+  while ( p<q ){ 
+    if ( ! mp_more_name(mp, *p)) break;
+    p++;
+  }
+  mp_end_name(mp);
+}
+
+
+@ The global variable |job_name| contains the file name that was first
+\&{input} by the user. This name is extended by `\.{.log}' and `\.{ps}' and
+`\.{.mem}' and `\.{.tfm}' in order to make the names of \MP's output files.
+
+@<Glob...@>=
+boolean log_opened; /* has the transcript file been opened? */
+char *log_name; /* full name of the log file */
+
+@ @<Option variables@>=
+char *job_name; /* principal file name */
+
+@ Initially |job_name=NULL|; it becomes nonzero as soon as the true name is known.
+We have |job_name=NULL| if and only if the `\.{log}' file has not been opened,
+except of course for a short time just after |job_name| has become nonzero.
+
+@<Allocate or ...@>=
+mp->job_name=mp_xstrdup(mp, opt->job_name); 
+mp->log_opened=false;
+
+@ @<Dealloc variables@>=
+xfree(mp->job_name);
+
+@ Here is a routine that manufactures the output file names, assuming that
+|job_name<>0|. It ignores and changes the current settings of |cur_area|
+and |cur_ext|.
+
+@d pack_cur_name mp_pack_file_name(mp, mp->cur_name,mp->cur_area,mp->cur_ext)
+
+@<Declarations@>=
+void mp_pack_job_name (MP mp, const char *s) ;
+
+@ @c 
+void mp_pack_job_name (MP mp, const char  *s) { /* |s = ".log"|, |".mem"|, |".ps"|, or .\\{nnn} */
+  xfree(mp->cur_name); mp->cur_name=xstrdup(mp->job_name);
+  xfree(mp->cur_area); mp->cur_area=xstrdup(""); 
+  xfree(mp->cur_ext);  mp->cur_ext=xstrdup(s);
+  pack_cur_name;
+}
+
+@ If some trouble arises when \MP\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~|s|
+is used in the error message to identify the type of file; parameter~|e|
+is the default extension if none is given. Upon exit from the routine,
+variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are
+ready for another attempt at file opening.
+
+@<Declarations@>=
+void mp_prompt_file_name (MP mp, const char * s, const char * e) ;
+
+@ @c void mp_prompt_file_name (MP mp, const char * s, const char * e) {
+  size_t k; /* index into |buffer| */
+  char * saved_cur_name;
+  if ( mp->interaction==mp_scroll_mode ) 
+	wake_up_terminal;
+  if (strcmp(s,"input file name")==0) {
+	print_err("I can\'t find file `");
+@.I can't find file x@>
+  } else {
+	print_err("I can\'t write on file `");
+  }
+@.I can't write on file x@>
+  mp_print_file_name(mp, mp->cur_name,mp->cur_area,mp->cur_ext); 
+  mp_print(mp, "'.");
+  if (strcmp(e,"")==0) 
+	mp_show_context(mp);
+  mp_print_nl(mp, "Please type another "); mp_print(mp, s);
+@.Please type...@>
+  if ( mp->interaction<mp_scroll_mode )
+    mp_fatal_error(mp, "*** (job aborted, file error in nonstop mode)");
+@.job aborted, file error...@>
+  saved_cur_name = xstrdup(mp->cur_name);
+  clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+  if (strcmp(mp->cur_ext,"")==0) 
+	mp->cur_ext=xstrdup(e);
+  if (strlen(mp->cur_name)==0) {
+    mp->cur_name=saved_cur_name;
+  } else {
+    xfree(saved_cur_name);
+  }
+  pack_cur_name;
+}
+
+@ @<Scan file name in the buffer@>=
+{ 
+  mp_begin_name(mp); k=mp->first;
+  while ( (mp->buffer[k]==' ')&&(k<mp->last) ) incr(k);
+  while (1) { 
+    if ( k==mp->last ) break;
+    if ( ! mp_more_name(mp, mp->buffer[k]) ) break;
+    incr(k);
+  }
+  mp_end_name(mp);
+}
+
+@ The |open_log_file| routine is used to open the transcript file and to help
+it catch up to what has previously been printed on the terminal.
+
+@c void mp_open_log_file (MP mp) {
+  int old_setting; /* previous |selector| setting */
+  int k; /* index into |months| and |buffer| */
+  int l; /* end of first input line */
+  integer m; /* the current month */
+  const char *months="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"; 
+    /* abbreviations of month names */
+  old_setting=mp->selector;
+  if ( mp->job_name==NULL ) {
+     mp->job_name=xstrdup("mpout");
+  }
+  mp_pack_job_name(mp,".log");
+  while ( ! mp_a_open_out(mp, &mp->log_file, mp_filetype_log) ) {
+    @<Try to get a different log file name@>;
+  }
+  mp->log_name=xstrdup(mp->name_of_file);
+  mp->selector=log_only; mp->log_opened=true;
+  @<Print the banner line, including the date and time@>;
+  mp->input_stack[mp->input_ptr]=mp->cur_input; 
+    /* make sure bottom level is in memory */
+@.**@>
+  if (!mp->noninteractive) {
+    mp_print_nl(mp, "**");
+    l=mp->input_stack[0].limit_field-1; /* last position of first line */
+    for (k=0;k<=l;k++) mp_print_str(mp, mp->buffer[k]);
+    mp_print_ln(mp); /* now the transcript file contains the first line of input */
+  }
+  mp->selector=old_setting+2; /* |log_only| or |term_and_log| */
+}
+
+@ @<Dealloc variables@>=
+xfree(mp->log_name);
+
+@ Sometimes |open_log_file| is called at awkward moments when \MP\ is
+unable to print error messages or even to |show_context|.
+The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
+routine will not be invoked because |log_opened| will be false.
+
+The normal idea of |mp_batch_mode| is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+@<Try to get a different log file name@>=
+{  
+  mp->selector=term_only;
+  mp_prompt_file_name(mp, "transcript file name",".log");
+}
+
+@ @<Print the banner...@>=
+{ 
+  wlog(banner);
+  mp_print(mp, mp->mem_ident); mp_print(mp, "  ");
+  mp_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_day])); 
+  mp_print_char(mp, ' ');
+  m=mp_round_unscaled(mp, mp->internal[mp_month]);
+  for (k=3*m-3;k<3*m;k++) { wlog_chr(months[k]); }
+  mp_print_char(mp, ' '); 
+  mp_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_year])); 
+  mp_print_char(mp, ' ');
+  m=mp_round_unscaled(mp, mp->internal[mp_time]);
+  mp_print_dd(mp, m / 60); mp_print_char(mp, ':'); mp_print_dd(mp, m % 60);
+}
+
+@ The |try_extension| function tries to open an input file determined by
+|cur_name|, |cur_area|, and the argument |ext|.  It returns |false| if it
+can't find the file in |cur_area| or the appropriate system area.
+
+@c boolean mp_try_extension (MP mp, const char *ext) { 
+  mp_pack_file_name(mp, mp->cur_name,mp->cur_area, ext);
+  in_name=xstrdup(mp->cur_name); 
+  in_area=xstrdup(mp->cur_area);
+  if ( mp_a_open_in(mp, &cur_file, mp_filetype_program) ) {
+    return true;
+  } else { 
+    mp_pack_file_name(mp, mp->cur_name,NULL,ext);
+    return mp_a_open_in(mp, &cur_file, mp_filetype_program);
+  }
+}
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{input}' command is being processed.
+
+@c void mp_start_input (MP mp) { /* \MP\ will \.{input} something */
+  char *fname = NULL;
+  @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>;
+  while (1) { 
+    mp_begin_file_reading(mp); /* set up |cur_file| and new level of input */
+    if ( strlen(mp->cur_ext)==0 ) {
+      if ( mp_try_extension(mp, ".mp") ) break;
+      else if ( mp_try_extension(mp, "") ) break;
+      else if ( mp_try_extension(mp, ".mf") ) break;
+      /* |else do_nothing; | */
+    } else if ( mp_try_extension(mp, mp->cur_ext) ) {
+      break;
+    }
+    mp_end_file_reading(mp); /* remove the level that didn't work */
+    mp_prompt_file_name(mp, "input file name","");
+  }
+  name=mp_a_make_name_string(mp, cur_file);
+  fname = xstrdup(mp->name_of_file);
+  if ( mp->job_name==NULL ) {
+    mp->job_name=xstrdup(mp->cur_name); 
+    mp_open_log_file(mp);
+  } /* |open_log_file| doesn't |show_context|, so |limit|
+        and |loc| needn't be set to meaningful values yet */
+  if ( ((int)mp->term_offset+(int)strlen(fname)) > (mp->max_print_line-2)) mp_print_ln(mp);
+  else if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_char(mp, ' ');
+  mp_print_char(mp, '('); incr(mp->open_parens); mp_print(mp, fname); 
+  xfree(fname);
+  update_terminal;
+  @<Flush |name| and replace it with |cur_name| if it won't be needed@>;
+  @<Read the first line of the new file@>;
+}
+
+@ This code should be omitted if |a_make_name_string| returns something other
+than just a copy of its argument and the full file name is needed for opening
+\.{MPX} files or implementing the switch-to-editor option.
+@^system dependencies@>
+
+@<Flush |name| and replace it with |cur_name| if it won't be needed@>=
+mp_flush_string(mp, name); name=rts(mp->cur_name); xfree(mp->cur_name)
+
+@ If the file is empty, it is considered to contain a single blank line,
+so there is no need to test the return value.
+
+@<Read the first line...@>=
+{ 
+  line=1;
+  (void)mp_input_ln(mp, cur_file ); 
+  mp_firm_up_the_line(mp);
+  mp->buffer[limit]='%'; mp->first=limit+1; loc=start;
+}
+
+@ @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>=
+while ( token_state &&(loc==null) ) mp_end_token_list(mp);
+if ( token_state ) { 
+  print_err("File names can't appear within macros");
+@.File names can't...@>
+  help3("Sorry...I've converted what follows to tokens,")
+    ("possibly garbaging the name you gave.")
+    ("Please delete the tokens and insert the name again.");
+  mp_error(mp);
+}
+if ( file_state ) {
+  mp_scan_file_name(mp);
+} else { 
+   xfree(mp->cur_name); mp->cur_name=xstrdup(""); 
+   xfree(mp->cur_ext);  mp->cur_ext =xstrdup(""); 
+   xfree(mp->cur_area); mp->cur_area=xstrdup(""); 
+}
+
+@ The following simple routine starts reading the \.{MPX} file associated
+with the current input file.
+
+@c void mp_start_mpx_input (MP mp) {
+  char *origname = NULL; /* a copy of nameoffile */
+  mp_pack_file_name(mp, in_name, in_area, ".mpx");
+  @<Try to make sure |name_of_file| refers to a valid \.{MPX} file and
+    |goto not_found| if there is a problem@>;
+  mp_begin_file_reading(mp);
+  if ( ! mp_a_open_in(mp, &cur_file, mp_filetype_program) ) {
+    mp_end_file_reading(mp);
+    goto NOT_FOUND;
+  }
+  name=mp_a_make_name_string(mp, cur_file);
+  mp->mpx_name[index]=name; add_str_ref(name);
+  @<Read the first line of the new file@>;
+  return;
+NOT_FOUND: 
+    @<Explain that the \.{MPX} file can't be read and |succumb|@>;
+  xfree(origname);
+}
+
+@ This should ideally be changed to do whatever is necessary to create the
+\.{MPX} file given by |name_of_file| if it does not exist or if it is out
+of date.  This requires invoking \.{MPtoTeX} on the |origname| and passing
+the results through \TeX\ and \.{DVItoMP}.  (It is possible to use a
+completely different typesetting program if suitable postprocessor is
+available to perform the function of \.{DVItoMP}.)
+@^system dependencies@>
+
+@ @<Exported types@>=
+typedef int (*mp_run_make_mpx_command)(MP mp, char *origname, char *mtxname);
+
+@ @<Option variables@>=
+mp_run_make_mpx_command run_make_mpx;
+
+@ @<Allocate or initialize ...@>=
+set_callback_option(run_make_mpx);
+
+@ @<Internal library declarations@>=
+int mp_run_make_mpx (MP mp, char *origname, char *mtxname);
+
+@ The default does nothing.
+@c 
+int mp_run_make_mpx (MP mp, char *origname, char *mtxname) {
+  (void)mp;
+  (void)origname;
+  (void)mtxname;
+  return false;
+}
+
+@ @<Try to make sure |name_of_file| refers to a valid \.{MPX} file and
+  |goto not_found| if there is a problem@>=
+origname = mp_xstrdup(mp,mp->name_of_file);
+*(origname+strlen(origname)-1)=0; /* drop the x */
+if (!(mp->run_make_mpx)(mp, origname, mp->name_of_file))
+  goto NOT_FOUND 
+
+@ @<Explain that the \.{MPX} file can't be read and |succumb|@>=
+if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal;
+mp_print_nl(mp, ">> ");
+mp_print(mp, origname);
+mp_print_nl(mp, ">> ");
+mp_print(mp, mp->name_of_file);
+mp_print_nl(mp, "! Unable to make mpx file");
+help4("The two files given above are one of your source files")
+  ("and an auxiliary file I need to read to find out what your")
+  ("btex..etex blocks mean. If you don't know why I had trouble,")
+  ("try running it manually through MPtoTeX, TeX, and DVItoMP");
+succumb;
+
+@ The last file-opening commands are for files accessed via the \&{readfrom}
+@:read_from_}{\&{readfrom} primitive@>
+operator and the \&{write} command.  Such files are stored in separate arrays.
+@:write_}{\&{write} primitive@>
+
+@<Types in the outer block@>=
+typedef unsigned int readf_index; /* |0..max_read_files| */
+typedef unsigned int write_index;  /* |0..max_write_files| */
+
+@ @<Glob...@>=
+readf_index max_read_files; /* maximum number of simultaneously open \&{readfrom} files */
+void ** rd_file; /* \&{readfrom} files */
+char ** rd_fname; /* corresponding file name or 0 if file not open */
+readf_index read_files; /* number of valid entries in the above arrays */
+write_index max_write_files; /* maximum number of simultaneously open \&{write} */
+void ** wr_file; /* \&{write} files */
+char ** wr_fname; /* corresponding file name or 0 if file not open */
+write_index write_files; /* number of valid entries in the above arrays */
+
+@ @<Allocate or initialize ...@>=
+mp->max_read_files=8;
+mp->rd_file = xmalloc((mp->max_read_files+1),sizeof(void *));
+mp->rd_fname = xmalloc((mp->max_read_files+1),sizeof(char *));
+memset(mp->rd_fname, 0, sizeof(char *)*(mp->max_read_files+1));
+mp->read_files=0;
+mp->max_write_files=8;
+mp->wr_file = xmalloc((mp->max_write_files+1),sizeof(void *));
+mp->wr_fname = xmalloc((mp->max_write_files+1),sizeof(char *));
+memset(mp->wr_fname, 0, sizeof(char *)*(mp->max_write_files+1));
+mp->write_files=0;
+
+
+@ This routine starts reading the file named by string~|s| without setting
+|loc|, |limit|, or |name|.  It returns |false| if the file is empty or cannot
+be opened.  Otherwise it updates |rd_file[n]| and |rd_fname[n]|.
+
+@c boolean mp_start_read_input (MP mp,char *s, readf_index  n) {
+  mp_ptr_scan_file(mp, s);
+  pack_cur_name;
+  mp_begin_file_reading(mp);
+  if ( ! mp_a_open_in(mp, &mp->rd_file[n], (mp_filetype_text+n)) ) 
+	goto NOT_FOUND;
+  if ( ! mp_input_ln(mp, mp->rd_file[n] ) ) {
+    (mp->close_file)(mp,mp->rd_file[n]); 
+	goto NOT_FOUND; 
+  }
+  mp->rd_fname[n]=xstrdup(mp->name_of_file);
+  return true;
+NOT_FOUND: 
+  mp_end_file_reading(mp);
+  return false;
+}
+
+@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|.
+
+@<Declarations@>=
+void mp_open_write_file (MP mp, char *s, readf_index  n) ;
+
+@ @c void mp_open_write_file (MP mp,char *s, readf_index  n) {
+  mp_ptr_scan_file(mp, s);
+  pack_cur_name;
+  while ( ! mp_a_open_out(mp, &mp->wr_file[n], (mp_filetype_text+n)) )
+    mp_prompt_file_name(mp, "file name for write output","");
+  mp->wr_fname[n]=xstrdup(mp->name_of_file);
+}
+
+
+@* \[36] Introduction to the parsing routines.
+We come now to the central nervous system that sparks many of \MP's activities.
+By evaluating expressions, from their primary constituents to ever larger
+subexpressions, \MP\ builds the structures that ultimately define complete
+pictures or fonts of type.
+
+Four mutually recursive subroutines are involved in this process: We call them
+$$\hbox{|scan_primary|, |scan_secondary|, |scan_tertiary|,
+and |scan_expression|.}$$
+@^recursion@>
+Each of them is parameterless and begins with the first token to be scanned
+already represented in |cur_cmd|, |cur_mod|, and |cur_sym|. After execution,
+the value of the primary or secondary or tertiary or expression that was
+found will appear in the global variables |cur_type| and |cur_exp|. The
+token following the expression will be represented in |cur_cmd|, |cur_mod|,
+and |cur_sym|.
+
+Technically speaking, the parsing algorithms are ``LL(1),'' more or less;
+backup mechanisms have been added in order to provide reasonable error
+recovery.
+
+@<Glob...@>=
+small_number cur_type; /* the type of the expression just found */
+integer cur_exp; /* the value of the expression just found */
+
+@ @<Set init...@>=
+mp->cur_exp=0;
+
+@ Many different kinds of expressions are possible, so it is wise to have
+precise descriptions of what |cur_type| and |cur_exp| mean in all cases:
+
+\smallskip\hang
+|cur_type=mp_vacuous| means that this expression didn't turn out to have a
+value at all, because it arose from a \&{begingroup}$\,\ldots\,$\&{endgroup}
+construction in which there was no expression before the \&{endgroup}.
+In this case |cur_exp| has some irrelevant value.
+
+\smallskip\hang
+|cur_type=mp_boolean_type| means that |cur_exp| is either |true_code|
+or |false_code|.
+
+\smallskip\hang
+|cur_type=mp_unknown_boolean| means that |cur_exp| points to a capsule
+node that is in 
+a ring of equivalent booleans whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type=mp_string_type| means that |cur_exp| is a string number (i.e., an
+integer in the range |0<=cur_exp<str_ptr|). That string's reference count
+includes this particular reference.
+
+\smallskip\hang
+|cur_type=mp_unknown_string| means that |cur_exp| points to a capsule
+node that is in
+a ring of equivalent strings whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type=mp_pen_type| means that |cur_exp| points to a node in a pen.  Nobody
+else points to any of the nodes in this pen.  The pen may be polygonal or
+elliptical.
+
+\smallskip\hang
+|cur_type=mp_unknown_pen| means that |cur_exp| points to a capsule
+node that is in
+a ring of equivalent pens whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type=mp_path_type| means that |cur_exp| points to a the first node of
+a path; nobody else points to this particular path. The control points of
+the path will have been chosen.
+
+\smallskip\hang
+|cur_type=mp_unknown_path| means that |cur_exp| points to a capsule
+node that is in
+a ring of equivalent paths whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type=mp_picture_type| means that |cur_exp| points to an edge header node.
+There may be other pointers to this particular set of edges.  The header node
+contains a reference count that includes this particular reference.
+
+\smallskip\hang
+|cur_type=mp_unknown_picture| means that |cur_exp| points to a capsule
+node that is in
+a ring of equivalent pictures whose value has not yet been defined.
+
+\smallskip\hang
+|cur_type=mp_transform_type| means that |cur_exp| points to a |mp_transform_type|
+capsule node. The |value| part of this capsule
+points to a transform node that contains six numeric values,
+each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=mp_color_type| means that |cur_exp| points to a |color_type|
+capsule node. The |value| part of this capsule
+points to a color node that contains three numeric values,
+each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=mp_cmykcolor_type| means that |cur_exp| points to a |mp_cmykcolor_type|
+capsule node. The |value| part of this capsule
+points to a color node that contains four numeric values,
+each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=mp_pair_type| means that |cur_exp| points to a capsule
+node whose type is |mp_pair_type|. The |value| part of this capsule
+points to a pair node that contains two numeric values,
+each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|.
+
+\smallskip\hang
+|cur_type=mp_known| means that |cur_exp| is a |scaled| value.
+
+\smallskip\hang
+|cur_type=mp_dependent| means that |cur_exp| points to a capsule node whose type
+is |dependent|. The |dep_list| field in this capsule points to the associated
+dependency list.
+
+\smallskip\hang
+|cur_type=mp_proto_dependent| means that |cur_exp| points to a |mp_proto_dependent|
+capsule node. The |dep_list| field in this capsule
+points to the associated dependency list.
+
+\smallskip\hang
+|cur_type=independent| means that |cur_exp| points to a capsule node
+whose type is |independent|. This somewhat unusual case can arise, for
+example, in the expression
+`$x+\&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'.
+
+\smallskip\hang
+|cur_type=mp_token_list| means that |cur_exp| points to a linked list of
+tokens. 
+
+\smallskip\noindent
+The possible settings of |cur_type| have been listed here in increasing
+numerical order. Notice that |cur_type| will never be |mp_numeric_type| or
+|suffixed_macro| or |mp_unsuffixed_macro|, although variables of those types
+are allowed.  Conversely, \MP\ has no variables of type |mp_vacuous| or
+|token_list|.
+
+@ Capsules are two-word nodes that have a similar meaning
+to |cur_type| and |cur_exp|. Such nodes have |name_type=capsule|,
+and their |type| field is one of the possibilities for |cur_type| listed above.
+Also |link<=void| in capsules that aren't part of a token list.
+
+The |value| field of a capsule is, in most cases, the value that
+corresponds to its |type|, as |cur_exp| corresponds to |cur_type|.
+However, when |cur_exp| would point to a capsule,
+no extra layer of indirection is present; the |value|
+field is what would have been called |value(cur_exp)| if it had not been
+encapsulated.  Furthermore, if the type is |dependent| or
+|mp_proto_dependent|, the |value| field of a capsule is replaced by
+|dep_list| and |prev_dep| fields, since dependency lists in capsules are
+always part of the general |dep_list| structure.
+
+The |get_x_next| routine is careful not to change the values of |cur_type|
+and |cur_exp| when it gets an expanded token. However, |get_x_next| might
+call a macro, which might parse an expression, which might execute lots of
+commands in a group; hence it's possible that |cur_type| might change
+from, say, |mp_unknown_boolean| to |mp_boolean_type|, or from |dependent| to
+|known| or |independent|, during the time |get_x_next| is called. The
+programs below are careful to stash sensitive intermediate results in
+capsules, so that \MP's generality doesn't cause trouble.
+
+Here's a procedure that illustrates these conventions. It takes
+the contents of $(|cur_type|\kern-.3pt,|cur_exp|\kern-.3pt)$
+and stashes them away in a
+capsule. It is not used when |cur_type=mp_token_list|.
+After the operation, |cur_type=mp_vacuous|; hence there is no need to
+copy path lists or to update reference counts, etc.
+
+The special link |mp_void| is put on the capsule returned by
+|stash_cur_exp|, because this procedure is used to store macro parameters
+that must be easily distinguishable from token lists.
+
+@<Declare the stashing/unstashing routines@>=
+pointer mp_stash_cur_exp (MP mp) {
+  pointer p; /* the capsule that will be returned */
+  switch (mp->cur_type) {
+  case unknown_types:
+  case mp_transform_type:
+  case mp_color_type:
+  case mp_pair_type:
+  case mp_dependent:
+  case mp_proto_dependent:
+  case mp_independent: 
+  case mp_cmykcolor_type:
+    p=mp->cur_exp;
+    break;
+  default: 
+    p=mp_get_node(mp, value_node_size); name_type(p)=mp_capsule;
+    type(p)=mp->cur_type; value(p)=mp->cur_exp;
+    break;
+  }
+  mp->cur_type=mp_vacuous; link(p)=mp_void; 
+  return p;
+}
+
+@ The inverse of |stash_cur_exp| is the following procedure, which
+deletes an unnecessary capsule and puts its contents into |cur_type|
+and |cur_exp|.
+
+The program steps of \MP\ can be divided into two categories: those in
+which |cur_type| and |cur_exp| are ``alive'' and those in which they are
+``dead,'' in the sense that |cur_type| and |cur_exp| contain relevant
+information or not. It's important not to ignore them when they're alive,
+and it's important not to pay attention to them when they're dead.
+
+There's also an intermediate category: If |cur_type=mp_vacuous|, then
+|cur_exp| is irrelevant, hence we can proceed without caring if |cur_type|
+and |cur_exp| are alive or dead. In such cases we say that |cur_type|
+and |cur_exp| are {\sl dormant}. It is permissible to call |get_x_next|
+only when they are alive or dormant.
+
+The \\{stash} procedure above assumes that |cur_type| and |cur_exp|
+are alive or dormant. The \\{unstash} procedure assumes that they are
+dead or dormant; it resuscitates them.
+
+@<Declare the stashing/unstashing...@>=
+void mp_unstash_cur_exp (MP mp,pointer p) ;
+
+@ @c
+void mp_unstash_cur_exp (MP mp,pointer p) { 
+  mp->cur_type=type(p);
+  switch (mp->cur_type) {
+  case unknown_types:
+  case mp_transform_type:
+  case mp_color_type:
+  case mp_pair_type:
+  case mp_dependent: 
+  case mp_proto_dependent:
+  case mp_independent:
+  case mp_cmykcolor_type: 
+    mp->cur_exp=p;
+    break;
+  default:
+    mp->cur_exp=value(p);
+    mp_free_node(mp, p,value_node_size);
+    break;
+  }
+}
+
+@ The following procedure prints the values of expressions in an
+abbreviated format. If its first parameter |p| is null, the value of
+|(cur_type,cur_exp)| is displayed; otherwise |p| should be a capsule
+containing the desired value. The second parameter controls the amount of
+output. If it is~0, dependency lists will be abbreviated to
+`\.{linearform}' unless they consist of a single term.  If it is greater
+than~1, complicated structures (pens, pictures, and paths) will be displayed
+in full.
+@.linearform@>
+
+@<Declare subroutines for printing expressions@>=
+@<Declare the procedure called |print_dp|@>
+@<Declare the stashing/unstashing routines@>
+void mp_print_exp (MP mp,pointer p, small_number verbosity) {
+  boolean restore_cur_exp; /* should |cur_exp| be restored? */
+  small_number t; /* the type of the expression */
+  pointer q; /* a big node being displayed */
+  integer v=0; /* the value of the expression */
+  if ( p!=null ) {
+    restore_cur_exp=false;
+  } else { 
+    p=mp_stash_cur_exp(mp); restore_cur_exp=true;
+  }
+  t=type(p);
+  if ( t<mp_dependent ) v=value(p); else if ( t<mp_independent ) v=dep_list(p);
+  @<Print an abbreviated value of |v| with format depending on |t|@>;
+  if ( restore_cur_exp ) mp_unstash_cur_exp(mp, p);
+}
+
+@ @<Print an abbreviated value of |v| with format depending on |t|@>=
+switch (t) {
+case mp_vacuous:mp_print(mp, "mp_vacuous"); break;
+case mp_boolean_type:
+  if ( v==true_code ) mp_print(mp, "true"); else mp_print(mp, "false");
+  break;
+case unknown_types: case mp_numeric_type:
+  @<Display a variable that's been declared but not defined@>;
+  break;
+case mp_string_type:
+  mp_print_char(mp, '"'); mp_print_str(mp, v); mp_print_char(mp, '"');
+  break;
+case mp_pen_type: case mp_path_type: case mp_picture_type:
+  @<Display a complex type@>;
+  break;
+case mp_transform_type: case mp_color_type: case mp_pair_type: case mp_cmykcolor_type:
+  if ( v==null ) mp_print_type(mp, t);
+  else @<Display a big node@>;
+  break;
+case mp_known:mp_print_scaled(mp, v); break;
+case mp_dependent: case mp_proto_dependent:
+  mp_print_dp(mp, t,v,verbosity);
+  break;
+case mp_independent:mp_print_variable_name(mp, p); break;
+default: mp_confusion(mp, "exp"); break;
+@:this can't happen exp}{\quad exp@>
+}
+
+@ @<Display a big node@>=
+{ 
+  mp_print_char(mp, '('); q=v+mp->big_node_size[t];
+  do {  
+    if ( type(v)==mp_known ) mp_print_scaled(mp, value(v));
+    else if ( type(v)==mp_independent ) mp_print_variable_name(mp, v);
+    else mp_print_dp(mp, type(v),dep_list(v),verbosity);
+    v=v+2;
+    if ( v!=q ) mp_print_char(mp, ',');
+  } while (v!=q);
+  mp_print_char(mp, ')');
+}
+
+@ Values of type \&{picture}, \&{path}, and \&{pen} are displayed verbosely
+in the log file only, unless the user has given a positive value to
+\\{tracingonline}.
+
+@<Display a complex type@>=
+if ( verbosity<=1 ) {
+  mp_print_type(mp, t);
+} else { 
+  if ( mp->selector==term_and_log )
+   if ( mp->internal[mp_tracing_online]<=0 ) {
+    mp->selector=term_only;
+    mp_print_type(mp, t); mp_print(mp, " (see the transcript file)");
+    mp->selector=term_and_log;
+  };
+  switch (t) {
+  case mp_pen_type:mp_print_pen(mp, v,"",false); break;
+  case mp_path_type:mp_print_path(mp, v,"",false); break;
+  case mp_picture_type:mp_print_edges(mp, v,"",false); break;
+  } /* there are no other cases */
+}
+
+@ @<Declare the procedure called |print_dp|@>=
+void mp_print_dp (MP mp,small_number t, pointer p, 
+                  small_number verbosity)  {
+  pointer q; /* the node following |p| */
+  q=link(p);
+  if ( (info(q)==null) || (verbosity>0) ) mp_print_dependency(mp, p,t);
+  else mp_print(mp, "linearform");
+}
+
+@ The displayed name of a variable in a ring will not be a capsule unless
+the ring consists entirely of capsules.
+
+@<Display a variable that's been declared but not defined@>=
+{ mp_print_type(mp, t);
+if ( v!=null )
+  { mp_print_char(mp, ' ');
+  while ( (name_type(v)==mp_capsule) && (v!=p) ) v=value(v);
+  mp_print_variable_name(mp, v);
+  };
+}
+
+@ When errors are detected during parsing, it is often helpful to
+display an expression just above the error message, using |exp_err|
+or |disp_err| instead of |print_err|.
+
+@d exp_err(A) mp_disp_err(mp, null,(A)) /* displays the current expression */
+
+@<Declare subroutines for printing expressions@>=
+void mp_disp_err (MP mp,pointer p, const char *s) { 
+  if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal;
+  mp_print_nl(mp, ">> ");
+@.>>@>
+  mp_print_exp(mp, p,1); /* ``medium verbose'' printing of the expression */
+  if (strlen(s)) { 
+    mp_print_nl(mp, "! "); mp_print(mp, s);
+@.!\relax@>
+  }
+}
+
+@ If |cur_type| and |cur_exp| contain relevant information that should
+be recycled, we will use the following procedure, which changes |cur_type|
+to |known| and stores a given value in |cur_exp|. We can think of |cur_type|
+and |cur_exp| as either alive or dormant after this has been done,
+because |cur_exp| will not contain a pointer value.
+
+@ @c void mp_flush_cur_exp (MP mp,scaled v) { 
+  switch (mp->cur_type) {
+  case unknown_types: case mp_transform_type: case mp_color_type: case mp_pair_type:
+  case mp_dependent: case mp_proto_dependent: case mp_independent: case mp_cmykcolor_type:
+    mp_recycle_value(mp, mp->cur_exp); 
+    mp_free_node(mp, mp->cur_exp,value_node_size);
+    break;
+  case mp_string_type:
+    delete_str_ref(mp->cur_exp); break;
+  case mp_pen_type: case mp_path_type: 
+    mp_toss_knot_list(mp, mp->cur_exp); break;
+  case mp_picture_type:
+    delete_edge_ref(mp->cur_exp); break;
+  default: 
+    break;
+  }
+  mp->cur_type=mp_known; mp->cur_exp=v;
+}
+
+@ There's a much more general procedure that is capable of releasing
+the storage associated with any two-word value packet.
+
+@<Declare the recycling subroutines@>=
+void mp_recycle_value (MP mp,pointer p) ;
+
+@ @c void mp_recycle_value (MP mp,pointer p) {
+  small_number t; /* a type code */
+  integer vv; /* another value */
+  pointer q,r,s,pp; /* link manipulation registers */
+  integer v=0; /* a value */
+  t=type(p);
+  if ( t<mp_dependent ) v=value(p);
+  switch (t) {
+  case undefined: case mp_vacuous: case mp_boolean_type: case mp_known:
+  case mp_numeric_type:
+    break;
+  case unknown_types:
+    mp_ring_delete(mp, p); break;
+  case mp_string_type:
+    delete_str_ref(v); break;
+  case mp_path_type: case mp_pen_type:
+    mp_toss_knot_list(mp, v); break;
+  case mp_picture_type:
+    delete_edge_ref(v); break;
+  case mp_cmykcolor_type: case mp_pair_type: case mp_color_type:
+  case mp_transform_type:
+    @<Recycle a big node@>; break; 
+  case mp_dependent: case mp_proto_dependent:
+    @<Recycle a dependency list@>; break;
+  case mp_independent:
+    @<Recycle an independent variable@>; break;
+  case mp_token_list: case mp_structured:
+    mp_confusion(mp, "recycle"); break;
+@:this can't happen recycle}{\quad recycle@>
+  case mp_unsuffixed_macro: case mp_suffixed_macro:
+    mp_delete_mac_ref(mp, value(p)); break;
+  } /* there are no other cases */
+  type(p)=undefined;
+}
+
+@ @<Recycle a big node@>=
+if ( v!=null ){ 
+  q=v+mp->big_node_size[t];
+  do {  
+    q=q-2; mp_recycle_value(mp, q);
+  } while (q!=v);
+  mp_free_node(mp, v,mp->big_node_size[t]);
+}
+
+@ @<Recycle a dependency list@>=
+{ 
+  q=dep_list(p);
+  while ( info(q)!=null ) q=link(q);
+  link(prev_dep(p))=link(q);
+  prev_dep(link(q))=prev_dep(p);
+  link(q)=null; mp_flush_node_list(mp, dep_list(p));
+}
+
+@ When an independent variable disappears, it simply fades away, unless
+something depends on it. In the latter case, a dependent variable whose
+coefficient of dependence is maximal will take its place.
+The relevant algorithm is due to Ignacio~A. Zabala, who implemented it
+as part of his Ph.D. thesis (Stanford University, December 1982).
+@^Zabala Salelles, Ignacio Andr\'es@>
+
+For example, suppose that variable $x$ is being recycled, and that the
+only variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case
+we want to make $y$ independent and $z=.5y-.5a+b$; no other variables
+will depend on~$y$. If $\\{tracingequations}>0$ in this situation,
+we will print `\.{\#\#\# -2x=-y+a}'.
+
+There's a slight complication, however: An independent variable $x$
+can occur both in dependency lists and in proto-dependency lists.
+This makes it necessary to be careful when deciding which coefficient
+is maximal.
+
+Furthermore, this complication is not so slight when
+a proto-dependent variable is chosen to become independent. For example,
+suppose that $y=2x+100a$ is proto-dependent while $z=x+b$ is dependent;
+then we must change $z=.5y-50a+b$ to a proto-dependency, because of the
+large coefficient `50'.
+
+In order to deal with these complications without wasting too much time,
+we shall link together the occurrences of~$x$ among all the linear
+dependencies, maintaining separate lists for the dependent and
+proto-dependent cases.
+
+@<Recycle an independent variable@>=
+{ 
+  mp->max_c[mp_dependent]=0; mp->max_c[mp_proto_dependent]=0;
+  mp->max_link[mp_dependent]=null; mp->max_link[mp_proto_dependent]=null;
+  q=link(dep_head);
+  while ( q!=dep_head ) { 
+    s=value_loc(q); /* now |link(s)=dep_list(q)| */
+    while (1) { 
+      r=link(s);
+      if ( info(r)==null ) break;
+      if ( info(r)!=p ) { 
+        s=r;
+      } else  { 
+        t=type(q); link(s)=link(r); info(r)=q;
+        if ( abs(value(r))>mp->max_c[t] ) {
+          @<Record a new maximum coefficient of type |t|@>;
+        } else { 
+          link(r)=mp->max_link[t]; mp->max_link[t]=r;
+        }
+      }
+    } 
+    q=link(r);
+  }
+  if ( (mp->max_c[mp_dependent]>0)||(mp->max_c[mp_proto_dependent]>0) ) {
+    @<Choose a dependent variable to take the place of the disappearing
+    independent variable, and change all remaining dependencies
+    accordingly@>;
+  }
+}
+
+@ The code for independency removal makes use of three two-word arrays.
+
+@<Glob...@>=
+integer max_c[mp_proto_dependent+1];  /* max coefficient magnitude */
+pointer max_ptr[mp_proto_dependent+1]; /* where |p| occurs with |max_c| */
+pointer max_link[mp_proto_dependent+1]; /* other occurrences of |p| */
+
+@ @<Record a new maximum coefficient...@>=
+{ 
+  if ( mp->max_c[t]>0 ) {
+    link(mp->max_ptr[t])=mp->max_link[t]; mp->max_link[t]=mp->max_ptr[t];
+  }
+  mp->max_c[t]=abs(value(r)); mp->max_ptr[t]=r;
+}
+
+@ @<Choose a dependent...@>=
+{ 
+  if ( (mp->max_c[mp_dependent] / 010000) >= mp->max_c[mp_proto_dependent] )
+    t=mp_dependent;
+  else 
+    t=mp_proto_dependent;
+  @<Determine the dependency list |s| to substitute for the independent
+    variable~|p|@>;
+  t=mp_dependent+mp_proto_dependent-t; /* complement |t| */
+  if ( mp->max_c[t]>0 ) { /* we need to pick up an unchosen dependency */ 
+    link(mp->max_ptr[t])=mp->max_link[t]; mp->max_link[t]=mp->max_ptr[t];
+  }
+  if ( t!=mp_dependent ) { @<Substitute new dependencies in place of |p|@>; }
+  else { @<Substitute new proto-dependencies in place of |p|@>;}
+  mp_flush_node_list(mp, s);
+  if ( mp->fix_needed ) mp_fix_dependencies(mp);
+  check_arith;
+}
+
+@ Let |s=max_ptr[t]|. At this point we have $|value|(s)=\pm|max_c|[t]$,
+and |info(s)| points to the dependent variable~|pp| of type~|t| from
+whose dependency list we have removed node~|s|. We must reinsert
+node~|s| into the dependency list, with coefficient $-1.0$, and with
+|pp| as the new independent variable. Since |pp| will have a larger serial
+number than any other variable, we can put node |s| at the head of the
+list.
+
+@<Determine the dep...@>=
+s=mp->max_ptr[t]; pp=info(s); v=value(s);
+if ( t==mp_dependent ) value(s)=-fraction_one; else value(s)=-unity;
+r=dep_list(pp); link(s)=r;
+while ( info(r)!=null ) r=link(r);
+q=link(r); link(r)=null;
+prev_dep(q)=prev_dep(pp); link(prev_dep(pp))=q;
+new_indep(pp);
+if ( mp->cur_exp==pp ) if ( mp->cur_type==t ) mp->cur_type=mp_independent;
+if ( mp->internal[mp_tracing_equations]>0 ) { 
+  @<Show the transformed dependency@>; 
+}
+
+@ Now $(-v)$ times the formerly independent variable~|p| is being replaced
+by the dependency list~|s|.
+
+@<Show the transformed...@>=
+if ( mp_interesting(mp, p) ) {
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "### ");
+@:]]]\#\#\#_}{\.{\#\#\#}@>
+  if ( v>0 ) mp_print_char(mp, '-');
+  if ( t==mp_dependent ) vv=mp_round_fraction(mp, mp->max_c[mp_dependent]);
+  else vv=mp->max_c[mp_proto_dependent];
+  if ( vv!=unity ) mp_print_scaled(mp, vv);
+  mp_print_variable_name(mp, p);
+  while ( value(p) % s_scale>0 ) {
+    mp_print(mp, "*4"); value(p)=value(p)-2;
+  }
+  if ( t==mp_dependent ) mp_print_char(mp, '='); else mp_print(mp, " = ");
+  mp_print_dependency(mp, s,t);
+  mp_end_diagnostic(mp, false);
+}
+
+@ Finally, there are dependent and proto-dependent variables whose
+dependency lists must be brought up to date.
+
+@<Substitute new dependencies...@>=
+for (t=mp_dependent;t<=mp_proto_dependent;t++){ 
+  r=mp->max_link[t];
+  while ( r!=null ) {
+    q=info(r);
+    dep_list(q)=mp_p_plus_fq(mp, dep_list(q),
+     mp_make_fraction(mp, value(r),-v),s,t,mp_dependent);
+    if ( dep_list(q)==mp->dep_final ) mp_make_known(mp, q,mp->dep_final);
+    q=r; r=link(r); mp_free_node(mp, q,dep_node_size);
+  }
+}
+
+@ @<Substitute new proto...@>=
+for (t=mp_dependent;t<=mp_proto_dependent;t++) {
+  r=mp->max_link[t];
+  while ( r!=null ) {
+    q=info(r);
+    if ( t==mp_dependent ) { /* for safety's sake, we change |q| to |mp_proto_dependent| */
+      if ( mp->cur_exp==q ) if ( mp->cur_type==mp_dependent )
+        mp->cur_type=mp_proto_dependent;
+      dep_list(q)=mp_p_over_v(mp, dep_list(q),unity,
+         mp_dependent,mp_proto_dependent);
+      type(q)=mp_proto_dependent; 
+      value(r)=mp_round_fraction(mp, value(r));
+    }
+    dep_list(q)=mp_p_plus_fq(mp, dep_list(q),
+       mp_make_scaled(mp, value(r),-v),s,
+       mp_proto_dependent,mp_proto_dependent);
+    if ( dep_list(q)==mp->dep_final ) 
+       mp_make_known(mp, q,mp->dep_final);
+    q=r; r=link(r); mp_free_node(mp, q,dep_node_size);
+  }
+}
+
+@ Here are some routines that provide handy combinations of actions
+that are often needed during error recovery. For example,
+`|flush_error|' flushes the current expression, replaces it by
+a given value, and calls |error|.
+
+Errors often are detected after an extra token has already been scanned.
+The `\\{put\_get}' routines put that token back before calling |error|;
+then they get it back again. (Or perhaps they get another token, if
+the user has changed things.)
+
+@<Declarations@>=
+void mp_flush_error (MP mp,scaled v);
+void mp_put_get_error (MP mp);
+void mp_put_get_flush_error (MP mp,scaled v) ;
+
+@ @c
+void mp_flush_error (MP mp,scaled v) { 
+  mp_error(mp); mp_flush_cur_exp(mp, v); 
+}
+void mp_put_get_error (MP mp) { 
+  mp_back_error(mp); mp_get_x_next(mp); 
+}
+void mp_put_get_flush_error (MP mp,scaled v) { 
+  mp_put_get_error(mp);
+  mp_flush_cur_exp(mp, v); 
+}
+
+@ A global variable |var_flag| is set to a special command code
+just before \MP\ calls |scan_expression|, if the expression should be
+treated as a variable when this command code immediately follows. For
+example, |var_flag| is set to |assignment| at the beginning of a
+statement, because we want to know the {\sl location\/} of a variable at
+the left of `\.{:=}', not the {\sl value\/} of that variable.
+
+The |scan_expression| subroutine calls |scan_tertiary|,
+which calls |scan_secondary|, which calls |scan_primary|, which sets
+|var_flag:=0|. In this way each of the scanning routines ``knows''
+when it has been called with a special |var_flag|, but |var_flag| is
+usually zero.
+
+A variable preceding a command that equals |var_flag| is converted to a
+token list rather than a value. Furthermore, an `\.{=}' sign following an
+expression with |var_flag=assignment| is not considered to be a relation
+that produces boolean expressions.
+
+
+@<Glob...@>=
+int var_flag; /* command that wants a variable */
+
+@ @<Set init...@>=
+mp->var_flag=0;
+
+@* \[37] Parsing primary expressions.
+The first parsing routine, |scan_primary|, is also the most complicated one,
+since it involves so many different cases. But each case---with one
+exception---is fairly simple by itself.
+
+When |scan_primary| begins, the first token of the primary to be scanned
+should already appear in |cur_cmd|, |cur_mod|, and |cur_sym|. The values
+of |cur_type| and |cur_exp| should be either dead or dormant, as explained
+earlier. If |cur_cmd| is not between |min_primary_command| and
+|max_primary_command|, inclusive, a syntax error will be signaled.
+
+@<Declare the basic parsing subroutines@>=
+void mp_scan_primary (MP mp) {
+  pointer p,q,r; /* for list manipulation */
+  quarterword c; /* a primitive operation code */
+  int my_var_flag; /* initial value of |my_var_flag| */
+  pointer l_delim,r_delim; /* hash addresses of a delimiter pair */
+  @<Other local variables for |scan_primary|@>;
+  my_var_flag=mp->var_flag; mp->var_flag=0;
+RESTART:
+  check_arith;
+  @<Supply diagnostic information, if requested@>;
+  switch (mp->cur_cmd) {
+  case left_delimiter:
+    @<Scan a delimited primary@>; break;
+  case begin_group:
+    @<Scan a grouped primary@>; break;
+  case string_token:
+    @<Scan a string constant@>; break;
+  case numeric_token:
+    @<Scan a primary that starts with a numeric token@>; break;
+  case nullary:
+    @<Scan a nullary operation@>; break;
+  case unary: case type_name: case cycle: case plus_or_minus:
+    @<Scan a unary operation@>; break;
+  case primary_binary:
+    @<Scan a binary operation with `\&{of}' between its operands@>; break;
+  case str_op:
+    @<Convert a suffix to a string@>; break;
+  case internal_quantity:
+    @<Scan an internal numeric quantity@>; break;
+  case capsule_token:
+    mp_make_exp_copy(mp, mp->cur_mod); break;
+  case tag_token:
+    @<Scan a variable primary; |goto restart| if it turns out to be a macro@>; break;
+  default: 
+    mp_bad_exp(mp, "A primary"); goto RESTART; break;
+@.A primary expression...@>
+  }
+  mp_get_x_next(mp); /* the routines |goto done| if they don't want this */
+DONE: 
+  if ( mp->cur_cmd==left_bracket ) {
+    if ( mp->cur_type>=mp_known ) {
+      @<Scan a mediation construction@>;
+    }
+  }
+}
+
+
+
+@ Errors at the beginning of expressions are flagged by |bad_exp|.
+
+@c void mp_bad_exp (MP mp, const char * s) {
+  int save_flag;
+  print_err(s); mp_print(mp, " expression can't begin with `");
+  mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod); 
+  mp_print_char(mp, '\'');
+  help4("I'm afraid I need some sort of value in order to continue,")
+    ("so I've tentatively inserted `0'. You may want to")
+    ("delete this zero and insert something else;")
+    ("see Chapter 27 of The METAFONTbook for an example.");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+  mp_back_input(mp); mp->cur_sym=0; mp->cur_cmd=numeric_token; 
+  mp->cur_mod=0; mp_ins_error(mp);
+  save_flag=mp->var_flag; mp->var_flag=0; mp_get_x_next(mp);
+  mp->var_flag=save_flag;
+}
+
+@ @<Supply diagnostic information, if requested@>=
+#ifdef DEBUG
+if ( mp->panicking ) mp_check_mem(mp, false);
+#endif
+if ( mp->interrupt!=0 ) if ( mp->OK_to_interrupt ) {
+  mp_back_input(mp); check_interrupt; mp_get_x_next(mp);
+}
+
+@ @<Scan a delimited primary@>=
+{ 
+  l_delim=mp->cur_sym; r_delim=mp->cur_mod; 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( (mp->cur_cmd==comma) && (mp->cur_type>=mp_known) ) {
+    @<Scan the rest of a delimited set of numerics@>;
+  } else {
+    mp_check_delimiter(mp, l_delim,r_delim);
+  }
+}
+
+@ The |stash_in| subroutine puts the current (numeric) expression into a field
+within a ``big node.''
+
+@c void mp_stash_in (MP mp,pointer p) {
+  pointer q; /* temporary register */
+  type(p)=mp->cur_type;
+  if ( mp->cur_type==mp_known ) {
+    value(p)=mp->cur_exp;
+  } else { 
+    if ( mp->cur_type==mp_independent ) {
+      @<Stash an independent |cur_exp| into a big node@>;
+    } else { 
+      mp->mem[value_loc(p)]=mp->mem[value_loc(mp->cur_exp)];
+      /* |dep_list(p):=dep_list(cur_exp)| and |prev_dep(p):=prev_dep(cur_exp)| */
+      link(prev_dep(p))=p;
+    }
+    mp_free_node(mp, mp->cur_exp,value_node_size);
+  }
+  mp->cur_type=mp_vacuous;
+}
+
+@ In rare cases the current expression can become |independent|. There
+may be many dependency lists pointing to such an independent capsule,
+so we can't simply move it into place within a big node. Instead,
+we copy it, then recycle it.
+
+@ @<Stash an independent |cur_exp|...@>=
+{ 
+  q=mp_single_dependency(mp, mp->cur_exp);
+  if ( q==mp->dep_final ){ 
+    type(p)=mp_known; value(p)=0; mp_free_node(mp, q,dep_node_size);
+  } else { 
+    type(p)=mp_dependent; mp_new_dep(mp, p,q);
+  }
+  mp_recycle_value(mp, mp->cur_exp);
+}
+
+@ This code uses the fact that |red_part_loc| and |green_part_loc|
+are synonymous with |x_part_loc| and |y_part_loc|.
+
+@<Scan the rest of a delimited set of numerics@>=
+{ 
+p=mp_stash_cur_exp(mp);
+mp_get_x_next(mp); mp_scan_expression(mp);
+@<Make sure the second part of a pair or color has a numeric type@>;
+q=mp_get_node(mp, value_node_size); name_type(q)=mp_capsule;
+if ( mp->cur_cmd==comma ) type(q)=mp_color_type;
+else type(q)=mp_pair_type;
+mp_init_big_node(mp, q); r=value(q);
+mp_stash_in(mp, y_part_loc(r));
+mp_unstash_cur_exp(mp, p);
+mp_stash_in(mp, x_part_loc(r));
+if ( mp->cur_cmd==comma ) {
+  @<Scan the last of a triplet of numerics@>;
+}
+if ( mp->cur_cmd==comma ) {
+  type(q)=mp_cmykcolor_type;
+  mp_init_big_node(mp, q); t=value(q);
+  mp->mem[cyan_part_loc(t)]=mp->mem[red_part_loc(r)];
+  value(cyan_part_loc(t))=value(red_part_loc(r));
+  mp->mem[magenta_part_loc(t)]=mp->mem[green_part_loc(r)];
+  value(magenta_part_loc(t))=value(green_part_loc(r));
+  mp->mem[yellow_part_loc(t)]=mp->mem[blue_part_loc(r)];
+  value(yellow_part_loc(t))=value(blue_part_loc(r));
+  mp_recycle_value(mp, r);
+  r=t;
+  @<Scan the last of a quartet of numerics@>;
+}
+mp_check_delimiter(mp, l_delim,r_delim);
+mp->cur_type=type(q);
+mp->cur_exp=q;
+}
+
+@ @<Make sure the second part of a pair or color has a numeric type@>=
+if ( mp->cur_type<mp_known ) {
+  exp_err("Nonnumeric ypart has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+  help4("I've started to scan a pair `(a,b)' or a color `(a,b,c)';")
+    ("but after finding a nice `a' I found a `b' that isn't")
+    ("of numeric type. So I've changed that part to zero.")
+    ("(The b that I didn't like appears above the error message.)");
+  mp_put_get_flush_error(mp, 0);
+}
+
+@ @<Scan the last of a triplet of numerics@>=
+{ 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type<mp_known ) {
+    exp_err("Nonnumeric third part has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+    help3("I've just scanned a color `(a,b,c)' or cmykcolor(a,b,c,d); but the `c'")
+      ("isn't of numeric type. So I've changed that part to zero.")
+      ("(The c that I didn't like appears above the error message.)");
+    mp_put_get_flush_error(mp, 0);
+  }
+  mp_stash_in(mp, blue_part_loc(r));
+}
+
+@ @<Scan the last of a quartet of numerics@>=
+{ 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type<mp_known ) {
+    exp_err("Nonnumeric blackpart has been replaced by 0");
+@.Nonnumeric...replaced by 0@>
+    help3("I've just scanned a cmykcolor `(c,m,y,k)'; but the `k' isn't")
+      ("of numeric type. So I've changed that part to zero.")
+      ("(The k that I didn't like appears above the error message.)");
+    mp_put_get_flush_error(mp, 0);
+  }
+  mp_stash_in(mp, black_part_loc(r));
+}
+
+@ The local variable |group_line| keeps track of the line
+where a \&{begingroup} command occurred; this will be useful
+in an error message if the group doesn't actually end.
+
+@<Other local variables for |scan_primary|@>=
+integer group_line; /* where a group began */
+
+@ @<Scan a grouped primary@>=
+{ 
+  group_line=mp_true_line(mp);
+  if ( mp->internal[mp_tracing_commands]>0 ) show_cur_cmd_mod;
+  save_boundary_item(p);
+  do {  
+    mp_do_statement(mp); /* ends with |cur_cmd>=semicolon| */
+  } while (mp->cur_cmd==semicolon);
+  if ( mp->cur_cmd!=end_group ) {
+    print_err("A group begun on line ");
+@.A group...never ended@>
+    mp_print_int(mp, group_line);
+    mp_print(mp, " never ended");
+    help2("I saw a `begingroup' back there that hasn't been matched")
+         ("by `endgroup'. So I've inserted `endgroup' now.");
+    mp_back_error(mp); mp->cur_cmd=end_group;
+  }
+  mp_unsave(mp); 
+    /* this might change |cur_type|, if independent variables are recycled */
+  if ( mp->internal[mp_tracing_commands]>0 ) show_cur_cmd_mod;
+}
+
+@ @<Scan a string constant@>=
+{ 
+  mp->cur_type=mp_string_type; mp->cur_exp=mp->cur_mod;
+}
+
+@ Later we'll come to procedures that perform actual operations like
+addition, square root, and so on; our purpose now is to do the parsing.
+But we might as well mention those future procedures now, so that the
+suspense won't be too bad:
+
+\smallskip
+|do_nullary(c)| does primitive operations that have no operands (e.g.,
+`\&{true}' or `\&{pencircle}');
+
+\smallskip
+|do_unary(c)| applies a primitive operation to the current expression;
+
+\smallskip
+|do_binary(p,c)| applies a primitive operation to the capsule~|p|
+and the current expression.
+
+@<Scan a nullary operation@>=mp_do_nullary(mp, mp->cur_mod)
+
+@ @<Scan a unary operation@>=
+{ 
+  c=mp->cur_mod; mp_get_x_next(mp); mp_scan_primary(mp); 
+  mp_do_unary(mp, c); goto DONE;
+}
+
+@ A numeric token might be a primary by itself, or it might be the
+numerator of a fraction composed solely of numeric tokens, or it might
+multiply the primary that follows (provided that the primary doesn't begin
+with a plus sign or a minus sign). The code here uses the facts that
+|max_primary_command=plus_or_minus| and
+|max_primary_command-1=numeric_token|. If a fraction is found that is less
+than unity, we try to retain higher precision when we use it in scalar
+multiplication.
+
+@<Other local variables for |scan_primary|@>=
+scaled num,denom; /* for primaries that are fractions, like `1/2' */
+
+@ @<Scan a primary that starts with a numeric token@>=
+{ 
+  mp->cur_exp=mp->cur_mod; mp->cur_type=mp_known; mp_get_x_next(mp);
+  if ( mp->cur_cmd!=slash ) { 
+    num=0; denom=0;
+  } else { 
+    mp_get_x_next(mp);
+    if ( mp->cur_cmd!=numeric_token ) { 
+      mp_back_input(mp);
+      mp->cur_cmd=slash; mp->cur_mod=over; mp->cur_sym=frozen_slash;
+      goto DONE;
+    }
+    num=mp->cur_exp; denom=mp->cur_mod;
+    if ( denom==0 ) { @<Protest division by zero@>; }
+    else { mp->cur_exp=mp_make_scaled(mp, num,denom); }
+    check_arith; mp_get_x_next(mp);
+  }
+  if ( mp->cur_cmd>=min_primary_command ) {
+   if ( mp->cur_cmd<numeric_token ) { /* in particular, |cur_cmd<>plus_or_minus| */
+     p=mp_stash_cur_exp(mp); mp_scan_primary(mp);
+     if ( (abs(num)>=abs(denom))||(mp->cur_type<mp_color_type) ) {
+       mp_do_binary(mp, p,times);
+     } else {
+       mp_frac_mult(mp, num,denom);
+       mp_free_node(mp, p,value_node_size);
+     }
+    }
+  }
+  goto DONE;
+}
+
+@ @<Protest division...@>=
+{ 
+  print_err("Division by zero");
+@.Division by zero@>
+  help1("I'll pretend that you meant to divide by 1."); mp_error(mp);
+}
+
+@ @<Scan a binary operation with `\&{of}' between its operands@>=
+{ 
+  c=mp->cur_mod; mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_cmd!=of_token ) {
+    mp_missing_err(mp, "of"); mp_print(mp, " for "); 
+    mp_print_cmd_mod(mp, primary_binary,c);
+@.Missing `of'@>
+    help1("I've got the first argument; will look now for the other.");
+    mp_back_error(mp);
+  }
+  p=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_primary(mp); 
+  mp_do_binary(mp, p,c); goto DONE;
+}
+
+@ @<Convert a suffix to a string@>=
+{ 
+  mp_get_x_next(mp); mp_scan_suffix(mp); 
+  mp->old_setting=mp->selector; mp->selector=new_string;
+  mp_show_token_list(mp, mp->cur_exp,null,100000,0); 
+  mp_flush_token_list(mp, mp->cur_exp);
+  mp->cur_exp=mp_make_string(mp); mp->selector=mp->old_setting; 
+  mp->cur_type=mp_string_type;
+  goto DONE;
+}
+
+@ If an internal quantity appears all by itself on the left of an
+assignment, we return a token list of length one, containing the address
+of the internal quantity plus |hash_end|. (This accords with the conventions
+of the save stack, as described earlier.)
+
+@<Scan an internal...@>=
+{ 
+  q=mp->cur_mod;
+  if ( my_var_flag==assignment ) {
+    mp_get_x_next(mp);
+    if ( mp->cur_cmd==assignment ) {
+      mp->cur_exp=mp_get_avail(mp);
+      info(mp->cur_exp)=q+hash_end; mp->cur_type=mp_token_list; 
+      goto DONE;
+    }
+    mp_back_input(mp);
+  }
+  mp->cur_type=mp_known; mp->cur_exp=mp->internal[q];
+}
+
+@ The most difficult part of |scan_primary| has been saved for last, since
+it was necessary to build up some confidence first. We can now face the task
+of scanning a variable.
+
+As we scan a variable, we build a token list containing the relevant
+names and subscript values, simultaneously following along in the
+``collective'' structure to see if we are actually dealing with a macro
+instead of a value.
+
+The local variables |pre_head| and |post_head| will point to the beginning
+of the prefix and suffix lists; |tail| will point to the end of the list
+that is currently growing.
+
+Another local variable, |tt|, contains partial information about the
+declared type of the variable-so-far. If |tt>=mp_unsuffixed_macro|, the
+relation |tt=type(q)| will always hold. If |tt=undefined|, the routine
+doesn't bother to update its information about type. And if
+|undefined<tt<mp_unsuffixed_macro|, the precise value of |tt| isn't critical.
+
+@ @<Other local variables for |scan_primary|@>=
+pointer pre_head,post_head,tail;
+  /* prefix and suffix list variables */
+small_number tt; /* approximation to the type of the variable-so-far */
+pointer t; /* a token */
+pointer macro_ref = 0; /* reference count for a suffixed macro */
+
+@ @<Scan a variable primary...@>=
+{ 
+  fast_get_avail(pre_head); tail=pre_head; post_head=null; tt=mp_vacuous;
+  while (1) { 
+    t=mp_cur_tok(mp); link(tail)=t;
+    if ( tt!=undefined ) {
+       @<Find the approximate type |tt| and corresponding~|q|@>;
+      if ( tt>=mp_unsuffixed_macro ) {
+        @<Either begin an unsuffixed macro call or
+          prepare for a suffixed one@>;
+      }
+    }
+    mp_get_x_next(mp); tail=t;
+    if ( mp->cur_cmd==left_bracket ) {
+      @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>;
+    }
+    if ( mp->cur_cmd>max_suffix_token ) break;
+    if ( mp->cur_cmd<min_suffix_token ) break;
+  } /* now |cur_cmd| is |internal_quantity|, |tag_token|, or |numeric_token| */
+  @<Handle unusual cases that masquerade as variables, and |goto restart|
+    or |goto done| if appropriate;
+    otherwise make a copy of the variable and |goto done|@>;
+}
+
+@ @<Either begin an unsuffixed macro call or...@>=
+{ 
+  link(tail)=null;
+  if ( tt>mp_unsuffixed_macro ) { /* |tt=mp_suffixed_macro| */
+    post_head=mp_get_avail(mp); tail=post_head; link(tail)=t;
+    tt=undefined; macro_ref=value(q); add_mac_ref(macro_ref);
+  } else {
+    @<Set up unsuffixed macro call and |goto restart|@>;
+  }
+}
+
+@ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>=
+{ 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_cmd!=right_bracket ) {
+    @<Put the left bracket and the expression back to be rescanned@>;
+  } else { 
+    if ( mp->cur_type!=mp_known ) mp_bad_subscript(mp);
+    mp->cur_cmd=numeric_token; mp->cur_mod=mp->cur_exp; mp->cur_sym=0;
+  }
+}
+
+@ The left bracket that we thought was introducing a subscript might have
+actually been the left bracket in a mediation construction like `\.{x[a,b]}'.
+So we don't issue an error message at this point; but we do want to back up
+so as to avoid any embarrassment about our incorrect assumption.
+
+@<Put the left bracket and the expression back to be rescanned@>=
+{ 
+  mp_back_input(mp); /* that was the token following the current expression */
+  mp_back_expr(mp); mp->cur_cmd=left_bracket; 
+  mp->cur_mod=0; mp->cur_sym=frozen_left_bracket;
+}
+
+@ Here's a routine that puts the current expression back to be read again.
+
+@c void mp_back_expr (MP mp) {
+  pointer p; /* capsule token */
+  p=mp_stash_cur_exp(mp); link(p)=null; back_list(p);
+}
+
+@ Unknown subscripts lead to the following error message.
+
+@c void mp_bad_subscript (MP mp) { 
+  exp_err("Improper subscript has been replaced by zero");
+@.Improper subscript...@>
+  help3("A bracketed subscript must have a known numeric value;")
+    ("unfortunately, what I found was the value that appears just")
+    ("above this error message. So I'll try a zero subscript.");
+  mp_flush_error(mp, 0);
+}
+
+@ Every time we call |get_x_next|, there's a chance that the variable we've
+been looking at will disappear. Thus, we cannot safely keep |q| pointing
+into the variable structure; we need to start searching from the root each time.
+
+@<Find the approximate type |tt| and corresponding~|q|@>=
+@^inner loop@>
+{ 
+  p=link(pre_head); q=info(p); tt=undefined;
+  if ( eq_type(q) % outer_tag==tag_token ) {
+    q=equiv(q);
+    if ( q==null ) goto DONE2;
+    while (1) { 
+      p=link(p);
+      if ( p==null ) {
+        tt=type(q); goto DONE2;
+      };
+      if ( type(q)!=mp_structured ) goto DONE2;
+      q=link(attr_head(q)); /* the |collective_subscript| attribute */
+      if ( p>=mp->hi_mem_min ) { /* it's not a subscript */
+        do {  q=link(q); } while (! (attr_loc(q)>=info(p)));
+        if ( attr_loc(q)>info(p) ) goto DONE2;
+      }
+    }
+  }
+DONE2:
+  ;
+}
+
+@ How do things stand now? Well, we have scanned an entire variable name,
+including possible subscripts and/or attributes; |cur_cmd|, |cur_mod|, and
+|cur_sym| represent the token that follows. If |post_head=null|, a
+token list for this variable name starts at |link(pre_head)|, with all
+subscripts evaluated. But if |post_head<>null|, the variable turned out
+to be a suffixed macro; |pre_head| is the head of the prefix list, while
+|post_head| is the head of a token list containing both `\.{\AT!}' and
+the suffix.
+
+Our immediate problem is to see if this variable still exists. (Variable
+structures can change drastically whenever we call |get_x_next|; users
+aren't supposed to do this, but the fact that it is possible means that
+we must be cautious.)
+
+The following procedure prints an error message when a variable
+unexpectedly disappears. Its help message isn't quite right for
+our present purposes, but we'll be able to fix that up.
+
+@c 
+void mp_obliterated (MP mp,pointer q) { 
+  print_err("Variable "); mp_show_token_list(mp, q,null,1000,0);
+  mp_print(mp, " has been obliterated");
+@.Variable...obliterated@>
+  help5("It seems you did a nasty thing---probably by accident,")
+    ("but nevertheless you nearly hornswoggled me...")
+    ("While I was evaluating the right-hand side of this")
+    ("command, something happened, and the left-hand side")
+    ("is no longer a variable! So I won't change anything.");
+}
+
+@ If the variable does exist, we also need to check
+for a few other special cases before deciding that a plain old ordinary
+variable has, indeed, been scanned.
+
+@<Handle unusual cases that masquerade as variables...@>=
+if ( post_head!=null ) {
+  @<Set up suffixed macro call and |goto restart|@>;
+}
+q=link(pre_head); free_avail(pre_head);
+if ( mp->cur_cmd==my_var_flag ) { 
+  mp->cur_type=mp_token_list; mp->cur_exp=q; goto DONE;
+}
+p=mp_find_variable(mp, q);
+if ( p!=null ) {
+  mp_make_exp_copy(mp, p);
+} else { 
+  mp_obliterated(mp, q);
+  mp->help_line[2]="While I was evaluating the suffix of this variable,";
+  mp->help_line[1]="something was redefined, and it's no longer a variable!";
+  mp->help_line[0]="In order to get back on my feet, I've inserted `0' instead.";
+  mp_put_get_flush_error(mp, 0);
+}
+mp_flush_node_list(mp, q); 
+goto DONE
+
+@ The only complication associated with macro calling is that the prefix
+and ``at'' parameters must be packaged in an appropriate list of lists.
+
+@<Set up unsuffixed macro call and |goto restart|@>=
+{ 
+  p=mp_get_avail(mp); info(pre_head)=link(pre_head); link(pre_head)=p;
+  info(p)=t; mp_macro_call(mp, value(q),pre_head,null);
+  mp_get_x_next(mp); 
+  goto RESTART;
+}
+
+@ If the ``variable'' that turned out to be a suffixed macro no longer exists,
+we don't care, because we have reserved a pointer (|macro_ref|) to its
+token list.
+
+@<Set up suffixed macro call and |goto restart|@>=
+{ 
+  mp_back_input(mp); p=mp_get_avail(mp); q=link(post_head);
+  info(pre_head)=link(pre_head); link(pre_head)=post_head;
+  info(post_head)=q; link(post_head)=p; info(p)=link(q); link(q)=null;
+  mp_macro_call(mp, macro_ref,pre_head,null); decr(ref_count(macro_ref));
+  mp_get_x_next(mp); goto RESTART;
+}
+
+@ Our remaining job is simply to make a copy of the value that has been
+found. Some cases are harder than others, but complexity arises solely
+because of the multiplicity of possible cases.
+
+@<Declare the procedure called |make_exp_copy|@>=
+@<Declare subroutines needed by |make_exp_copy|@>
+void mp_make_exp_copy (MP mp,pointer p) {
+  pointer q,r,t; /* registers for list manipulation */
+RESTART: 
+  mp->cur_type=type(p);
+  switch (mp->cur_type) {
+  case mp_vacuous: case mp_boolean_type: case mp_known:
+    mp->cur_exp=value(p); break;
+  case unknown_types:
+    mp->cur_exp=mp_new_ring_entry(mp, p);
+    break;
+  case mp_string_type: 
+    mp->cur_exp=value(p); add_str_ref(mp->cur_exp);
+    break;
+  case mp_picture_type:
+    mp->cur_exp=value(p);add_edge_ref(mp->cur_exp);
+    break;
+  case mp_pen_type:
+    mp->cur_exp=copy_pen(value(p));
+    break; 
+  case mp_path_type:
+    mp->cur_exp=mp_copy_path(mp, value(p));
+    break;
+  case mp_transform_type: case mp_color_type: 
+  case mp_cmykcolor_type: case mp_pair_type:
+    @<Copy the big node |p|@>;
+    break;
+  case mp_dependent: case mp_proto_dependent:
+    mp_encapsulate(mp, mp_copy_dep_list(mp, dep_list(p)));
+    break;
+  case mp_numeric_type: 
+    new_indep(p); goto RESTART;
+    break;
+  case mp_independent: 
+    q=mp_single_dependency(mp, p);
+    if ( q==mp->dep_final ){ 
+      mp->cur_type=mp_known; mp->cur_exp=0; mp_free_node(mp, q,dep_node_size);
+    } else { 
+      mp->cur_type=mp_dependent; mp_encapsulate(mp, q);
+    }
+    break;
+  default: 
+    mp_confusion(mp, "copy");
+@:this can't happen copy}{\quad copy@>
+    break;
+  }
+}
+
+@ The |encapsulate| subroutine assumes that |dep_final| is the
+tail of dependency list~|p|.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+void mp_encapsulate (MP mp,pointer p) { 
+  mp->cur_exp=mp_get_node(mp, value_node_size); type(mp->cur_exp)=mp->cur_type;
+  name_type(mp->cur_exp)=mp_capsule; mp_new_dep(mp, mp->cur_exp,p);
+}
+
+@ The most tedious case arises when the user refers to a
+\&{pair}, \&{color}, or \&{transform} variable; we must copy several fields,
+each of which can be |independent|, |dependent|, |mp_proto_dependent|,
+or |known|.
+
+@<Copy the big node |p|@>=
+{ 
+  if ( value(p)==null ) 
+    mp_init_big_node(mp, p);
+  t=mp_get_node(mp, value_node_size); name_type(t)=mp_capsule; type(t)=mp->cur_type;
+  mp_init_big_node(mp, t);
+  q=value(p)+mp->big_node_size[mp->cur_type]; 
+  r=value(t)+mp->big_node_size[mp->cur_type];
+  do {  
+    q=q-2; r=r-2; mp_install(mp, r,q);
+  } while (q!=value(p));
+  mp->cur_exp=t;
+}
+
+@ The |install| procedure copies a numeric field~|q| into field~|r| of
+a big node that will be part of a capsule.
+
+@<Declare subroutines needed by |make_exp_copy|@>=
+void mp_install (MP mp,pointer r, pointer q) {
+  pointer p; /* temporary register */
+  if ( type(q)==mp_known ){ 
+    value(r)=value(q); type(r)=mp_known;
+  } else  if ( type(q)==mp_independent ) {
+    p=mp_single_dependency(mp, q);
+    if ( p==mp->dep_final ) {
+      type(r)=mp_known; value(r)=0; mp_free_node(mp, p,dep_node_size);
+    } else  { 
+      type(r)=mp_dependent; mp_new_dep(mp, r,p);
+    }
+  } else {
+    type(r)=type(q); mp_new_dep(mp, r,mp_copy_dep_list(mp, dep_list(q)));
+  }
+}
+
+@ Expressions of the form `\.{a[b,c]}' are converted into
+`\.{b+a*(c-b)}', without checking the types of \.b~or~\.c,
+provided that \.a is numeric.
+
+@<Scan a mediation...@>=
+{ 
+  p=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_cmd!=comma ) {
+    @<Put the left bracket and the expression back...@>;
+    mp_unstash_cur_exp(mp, p);
+  } else { 
+    q=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_expression(mp);
+    if ( mp->cur_cmd!=right_bracket ) {
+      mp_missing_err(mp, "]");
+@.Missing `]'@>
+      help3("I've scanned an expression of the form `a[b,c',")
+      ("so a right bracket should have come next.")
+      ("I shall pretend that one was there.");
+      mp_back_error(mp);
+    }
+    r=mp_stash_cur_exp(mp); mp_make_exp_copy(mp, q);
+    mp_do_binary(mp, r,minus); mp_do_binary(mp, p,times); 
+    mp_do_binary(mp, q,plus); mp_get_x_next(mp);
+  }
+}
+
+@ Here is a comparatively simple routine that is used to scan the
+\&{suffix} parameters of a macro.
+
+@<Declare the basic parsing subroutines@>=
+void mp_scan_suffix (MP mp) {
+  pointer h,t; /* head and tail of the list being built */
+  pointer p; /* temporary register */
+  h=mp_get_avail(mp); t=h;
+  while (1) { 
+    if ( mp->cur_cmd==left_bracket ) {
+      @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>;
+    }
+    if ( mp->cur_cmd==numeric_token ) {
+      p=mp_new_num_tok(mp, mp->cur_mod);
+    } else if ((mp->cur_cmd==tag_token)||(mp->cur_cmd==internal_quantity) ) {
+       p=mp_get_avail(mp); info(p)=mp->cur_sym;
+    } else {
+      break;
+    }
+    link(t)=p; t=p; mp_get_x_next(mp);
+  }
+  mp->cur_exp=link(h); free_avail(h); mp->cur_type=mp_token_list;
+}
+
+@ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>=
+{ 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ) mp_bad_subscript(mp);
+  if ( mp->cur_cmd!=right_bracket ) {
+     mp_missing_err(mp, "]");
+@.Missing `]'@>
+    help3("I've seen a `[' and a subscript value, in a suffix,")
+      ("so a right bracket should have come next.")
+      ("I shall pretend that one was there.");
+    mp_back_error(mp);
+  }
+  mp->cur_cmd=numeric_token; mp->cur_mod=mp->cur_exp;
+}
+
+@* \[38] Parsing secondary and higher expressions.
+
+After the intricacies of |scan_primary|\kern-1pt,
+the |scan_secondary| routine is
+refreshingly simple. It's not trivial, but the operations are relatively
+straightforward; the main difficulty is, again, that expressions and data
+structures might change drastically every time we call |get_x_next|, so a
+cautious approach is mandatory. For example, a macro defined by
+\&{primarydef} might have disappeared by the time its second argument has
+been scanned; we solve this by increasing the reference count of its token
+list, so that the macro can be called even after it has been clobbered.
+
+@<Declare the basic parsing subroutines@>=
+void mp_scan_secondary (MP mp) {
+  pointer p; /* for list manipulation */
+  halfword c,d; /* operation codes or modifiers */
+  pointer mac_name; /* token defined with \&{primarydef} */
+RESTART:
+  if ((mp->cur_cmd<min_primary_command)||
+      (mp->cur_cmd>max_primary_command) )
+    mp_bad_exp(mp, "A secondary");
+@.A secondary expression...@>
+  mp_scan_primary(mp);
+CONTINUE: 
+  if ( mp->cur_cmd<=max_secondary_command &&
+       mp->cur_cmd>=min_secondary_command ) {
+    p=mp_stash_cur_exp(mp); 
+    c=mp->cur_mod; d=mp->cur_cmd;
+    if ( d==secondary_primary_macro ) { 
+      mac_name=mp->cur_sym; 
+      add_mac_ref(c);
+    }
+    mp_get_x_next(mp); 
+    mp_scan_primary(mp);
+    if ( d!=secondary_primary_macro ) {
+      mp_do_binary(mp, p,c);
+    } else { 
+      mp_back_input(mp); 
+      mp_binary_mac(mp, p,c,mac_name);
+      decr(ref_count(c)); 
+      mp_get_x_next(mp); 
+      goto RESTART;
+    }
+    goto CONTINUE;
+  }
+}
+
+@ The following procedure calls a macro that has two parameters,
+|p| and |cur_exp|.
+
+@c void mp_binary_mac (MP mp,pointer p, pointer c, pointer n) {
+  pointer q,r; /* nodes in the parameter list */
+  q=mp_get_avail(mp); r=mp_get_avail(mp); link(q)=r;
+  info(q)=p; info(r)=mp_stash_cur_exp(mp);
+  mp_macro_call(mp, c,q,n);
+}
+
+@ The next procedure, |scan_tertiary|, is pretty much the same deal.
+
+@<Declare the basic parsing subroutines@>=
+void mp_scan_tertiary (MP mp) {
+  pointer p; /* for list manipulation */
+  halfword c,d; /* operation codes or modifiers */
+  pointer mac_name; /* token defined with \&{secondarydef} */
+RESTART:
+  if ((mp->cur_cmd<min_primary_command)||
+      (mp->cur_cmd>max_primary_command) )
+    mp_bad_exp(mp, "A tertiary");
+@.A tertiary expression...@>
+  mp_scan_secondary(mp);
+CONTINUE: 
+  if ( mp->cur_cmd<=max_tertiary_command ) {
+    if ( mp->cur_cmd>=min_tertiary_command ) {
+      p=mp_stash_cur_exp(mp); c=mp->cur_mod; d=mp->cur_cmd;
+      if ( d==tertiary_secondary_macro ) { 
+        mac_name=mp->cur_sym; add_mac_ref(c);
+      };
+      mp_get_x_next(mp); mp_scan_secondary(mp);
+      if ( d!=tertiary_secondary_macro ) {
+        mp_do_binary(mp, p,c);
+      } else { 
+        mp_back_input(mp); mp_binary_mac(mp, p,c,mac_name);
+        decr(ref_count(c)); mp_get_x_next(mp); 
+        goto RESTART;
+      }
+      goto CONTINUE;
+    }
+  }
+}
+
+@ Finally we reach the deepest level in our quartet of parsing routines.
+This one is much like the others; but it has an extra complication from
+paths, which materialize here.
+
+@d continue_path 25 /* a label inside of |scan_expression| */
+@d finish_path 26 /* another */
+
+@<Declare the basic parsing subroutines@>=
+void mp_scan_expression (MP mp) {
+  pointer p,q,r,pp,qq; /* for list manipulation */
+  halfword c,d; /* operation codes or modifiers */
+  int my_var_flag; /* initial value of |var_flag| */
+  pointer mac_name; /* token defined with \&{tertiarydef} */
+  boolean cycle_hit; /* did a path expression just end with `\&{cycle}'? */
+  scaled x,y; /* explicit coordinates or tension at a path join */
+  int t; /* knot type following a path join */
+  t=0; y=0; x=0;
+  my_var_flag=mp->var_flag; mac_name=null;
+RESTART:
+  if ((mp->cur_cmd<min_primary_command)||
+      (mp->cur_cmd>max_primary_command) )
+    mp_bad_exp(mp, "An");
+@.An expression...@>
+  mp_scan_tertiary(mp);
+CONTINUE: 
+  if ( mp->cur_cmd<=max_expression_command )
+    if ( mp->cur_cmd>=min_expression_command ) {
+      if ( (mp->cur_cmd!=equals)||(my_var_flag!=assignment) ) {
+        p=mp_stash_cur_exp(mp); c=mp->cur_mod; d=mp->cur_cmd;
+        if ( d==expression_tertiary_macro ) {
+          mac_name=mp->cur_sym; add_mac_ref(c);
+        }
+        if ( (d<ampersand)||((d==ampersand)&&
+             ((type(p)==mp_pair_type)||(type(p)==mp_path_type))) ) {
+          @<Scan a path construction operation;
+            but |return| if |p| has the wrong type@>;
+        } else { 
+          mp_get_x_next(mp); mp_scan_tertiary(mp);
+          if ( d!=expression_tertiary_macro ) {
+            mp_do_binary(mp, p,c);
+          } else  { 
+            mp_back_input(mp); mp_binary_mac(mp, p,c,mac_name);
+            decr(ref_count(c)); mp_get_x_next(mp); 
+            goto RESTART;
+          }
+        }
+        goto CONTINUE;
+     }
+  }
+}
+
+@ The reader should review the data structure conventions for paths before
+hoping to understand the next part of this code.
+
+@<Scan a path construction operation...@>=
+{ 
+  cycle_hit=false;
+  @<Convert the left operand, |p|, into a partial path ending at~|q|;
+    but |return| if |p| doesn't have a suitable type@>;
+CONTINUE_PATH: 
+  @<Determine the path join parameters;
+    but |goto finish_path| if there's only a direction specifier@>;
+  if ( mp->cur_cmd==cycle ) {
+    @<Get ready to close a cycle@>;
+  } else { 
+    mp_scan_tertiary(mp);
+    @<Convert the right operand, |cur_exp|,
+      into a partial path from |pp| to~|qq|@>;
+  }
+  @<Join the partial paths and reset |p| and |q| to the head and tail
+    of the result@>;
+  if ( mp->cur_cmd>=min_expression_command )
+    if ( mp->cur_cmd<=ampersand ) if ( ! cycle_hit ) goto CONTINUE_PATH;
+FINISH_PATH:
+  @<Choose control points for the path and put the result into |cur_exp|@>;
+}
+
+@ @<Convert the left operand, |p|, into a partial path ending at~|q|...@>=
+{ 
+  mp_unstash_cur_exp(mp, p);
+  if ( mp->cur_type==mp_pair_type ) p=mp_new_knot(mp);
+  else if ( mp->cur_type==mp_path_type ) p=mp->cur_exp;
+  else return;
+  q=p;
+  while ( link(q)!=p ) q=link(q);
+  if ( left_type(p)!=mp_endpoint ) { /* open up a cycle */
+    r=mp_copy_knot(mp, p); link(q)=r; q=r;
+  }
+  left_type(p)=mp_open; right_type(q)=mp_open;
+}
+
+@ A pair of numeric values is changed into a knot node for a one-point path
+when \MP\ discovers that the pair is part of a path.
+
+@c @<Declare the procedure called |known_pair|@>
+pointer mp_new_knot (MP mp) { /* convert a pair to a knot with two endpoints */
+  pointer q; /* the new node */
+  q=mp_get_node(mp, knot_node_size); left_type(q)=mp_endpoint;
+  right_type(q)=mp_endpoint; originator(q)=mp_metapost_user; link(q)=q;
+  mp_known_pair(mp); x_coord(q)=mp->cur_x; y_coord(q)=mp->cur_y;
+  return q;
+}
+
+@ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components
+of the current expression, assuming that the current expression is a
+pair of known numerics. Unknown components are zeroed, and the
+current expression is flushed.
+
+@<Declare the procedure called |known_pair|@>=
+void mp_known_pair (MP mp) {
+  pointer p; /* the pair node */
+  if ( mp->cur_type!=mp_pair_type ) {
+    exp_err("Undefined coordinates have been replaced by (0,0)");
+@.Undefined coordinates...@>
+    help5("I need x and y numbers for this part of the path.")
+      ("The value I found (see above) was no good;")
+      ("so I'll try to keep going by using zero instead.")
+      ("(Chapter 27 of The METAFONTbook explains that")
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+      ("you might want to type `I ??" "?' now.)");
+    mp_put_get_flush_error(mp, 0); mp->cur_x=0; mp->cur_y=0;
+  } else { 
+    p=value(mp->cur_exp);
+     @<Make sure that both |x| and |y| parts of |p| are known;
+       copy them into |cur_x| and |cur_y|@>;
+    mp_flush_cur_exp(mp, 0);
+  }
+}
+
+@ @<Make sure that both |x| and |y| parts of |p| are known...@>=
+if ( type(x_part_loc(p))==mp_known ) {
+  mp->cur_x=value(x_part_loc(p));
+} else { 
+  mp_disp_err(mp, x_part_loc(p),
+    "Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+  help5("I need a `known' x value for this part of the path.")
+    ("The value I found (see above) was no good;")
+    ("so I'll try to keep going by using zero instead.")
+    ("(Chapter 27 of The METAFONTbook explains that")
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+    ("you might want to type `I ??" "?' now.)");
+  mp_put_get_error(mp); mp_recycle_value(mp, x_part_loc(p)); mp->cur_x=0;
+}
+if ( type(y_part_loc(p))==mp_known ) {
+  mp->cur_y=value(y_part_loc(p));
+} else { 
+  mp_disp_err(mp, y_part_loc(p),
+    "Undefined y coordinate has been replaced by 0");
+  help5("I need a `known' y value for this part of the path.")
+    ("The value I found (see above) was no good;")
+    ("so I'll try to keep going by using zero instead.")
+    ("(Chapter 27 of The METAFONTbook explains that")
+    ("you might want to type `I ??" "?' now.)");
+  mp_put_get_error(mp); mp_recycle_value(mp, y_part_loc(p)); mp->cur_y=0;
+}
+
+@ At this point |cur_cmd| is either |ampersand|, |left_brace|, or |path_join|.
+
+@<Determine the path join parameters...@>=
+if ( mp->cur_cmd==left_brace ) {
+  @<Put the pre-join direction information into node |q|@>;
+}
+d=mp->cur_cmd;
+if ( d==path_join ) {
+  @<Determine the tension and/or control points@>;
+} else if ( d!=ampersand ) {
+  goto FINISH_PATH;
+}
+mp_get_x_next(mp);
+if ( mp->cur_cmd==left_brace ) {
+  @<Put the post-join direction information into |x| and |t|@>;
+} else if ( right_type(q)!=mp_explicit ) {
+  t=mp_open; x=0;
+}
+
+@ The |scan_direction| subroutine looks at the directional information
+that is enclosed in braces, and also scans ahead to the following character.
+A type code is returned, either |open| (if the direction was $(0,0)$),
+or |curl| (if the direction was a curl of known value |cur_exp|), or
+|given| (if the direction is given by the |angle| value that now
+appears in |cur_exp|).
+
+There's nothing difficult about this subroutine, but the program is rather
+lengthy because a variety of potential errors need to be nipped in the bud.
+
+@c small_number mp_scan_direction (MP mp) {
+  int t; /* the type of information found */
+  scaled x; /* an |x| coordinate */
+  mp_get_x_next(mp);
+  if ( mp->cur_cmd==curl_command ) {
+     @<Scan a curl specification@>;
+  } else {
+    @<Scan a given direction@>;
+  }
+  if ( mp->cur_cmd!=right_brace ) {
+    mp_missing_err(mp, "}");
+@.Missing `\char`\}'@>
+    help3("I've scanned a direction spec for part of a path,")
+      ("so a right brace should have come next.")
+      ("I shall pretend that one was there.");
+    mp_back_error(mp);
+  }
+  mp_get_x_next(mp); 
+  return t;
+}
+
+@ @<Scan a curl specification@>=
+{ mp_get_x_next(mp); mp_scan_expression(mp);
+if ( (mp->cur_type!=mp_known)||(mp->cur_exp<0) ){ 
+  exp_err("Improper curl has been replaced by 1");
+@.Improper curl@>
+  help1("A curl must be a known, nonnegative number.");
+  mp_put_get_flush_error(mp, unity);
+}
+t=mp_curl;
+}
+
+@ @<Scan a given direction@>=
+{ mp_scan_expression(mp);
+  if ( mp->cur_type>mp_pair_type ) {
+    @<Get given directions separated by commas@>;
+  } else {
+    mp_known_pair(mp);
+  }
+  if ( (mp->cur_x==0)&&(mp->cur_y==0) )  t=mp_open;
+  else  { t=mp_given; mp->cur_exp=mp_n_arg(mp, mp->cur_x,mp->cur_y);}
+}
+
+@ @<Get given directions separated by commas@>=
+{ 
+  if ( mp->cur_type!=mp_known ) {
+    exp_err("Undefined x coordinate has been replaced by 0");
+@.Undefined coordinates...@>
+    help5("I need a `known' x value for this part of the path.")
+      ("The value I found (see above) was no good;")
+      ("so I'll try to keep going by using zero instead.")
+      ("(Chapter 27 of The METAFONTbook explains that")
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+      ("you might want to type `I ??" "?' now.)");
+    mp_put_get_flush_error(mp, 0);
+  }
+  x=mp->cur_exp;
+  if ( mp->cur_cmd!=comma ) {
+    mp_missing_err(mp, ",");
+@.Missing `,'@>
+    help2("I've got the x coordinate of a path direction;")
+      ("will look for the y coordinate next.");
+    mp_back_error(mp);
+  }
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ) {
+     exp_err("Undefined y coordinate has been replaced by 0");
+    help5("I need a `known' y value for this part of the path.")
+      ("The value I found (see above) was no good;")
+      ("so I'll try to keep going by using zero instead.")
+      ("(Chapter 27 of The METAFONTbook explains that")
+      ("you might want to type `I ??" "?' now.)");
+    mp_put_get_flush_error(mp, 0);
+  }
+  mp->cur_y=mp->cur_exp; mp->cur_x=x;
+}
+
+@ At this point |right_type(q)| is usually |open|, but it may have been
+set to some other value by a previous operation. We must maintain
+the value of |right_type(q)| in cases such as
+`\.{..\{curl2\}z\{0,0\}..}'.
+
+@<Put the pre-join...@>=
+{ 
+  t=mp_scan_direction(mp);
+  if ( t!=mp_open ) {
+    right_type(q)=t; right_given(q)=mp->cur_exp;
+    if ( left_type(q)==mp_open ) {
+      left_type(q)=t; left_given(q)=mp->cur_exp;
+    } /* note that |left_given(q)=left_curl(q)| */
+  }
+}
+
+@ Since |left_tension| and |left_y| share the same position in knot nodes,
+and since |left_given| is similarly equivalent to |left_x|, we use
+|x| and |y| to hold the given direction and tension information when
+there are no explicit control points.
+
+@<Put the post-join...@>=
+{ 
+  t=mp_scan_direction(mp);
+  if ( right_type(q)!=mp_explicit ) x=mp->cur_exp;
+  else t=mp_explicit; /* the direction information is superfluous */
+}
+
+@ @<Determine the tension and/or...@>=
+{ 
+  mp_get_x_next(mp);
+  if ( mp->cur_cmd==tension ) {
+    @<Set explicit tensions@>;
+  } else if ( mp->cur_cmd==controls ) {
+    @<Set explicit control points@>;
+  } else  { 
+    right_tension(q)=unity; y=unity; mp_back_input(mp); /* default tension */
+    goto DONE;
+  };
+  if ( mp->cur_cmd!=path_join ) {
+     mp_missing_err(mp, "..");
+@.Missing `..'@>
+    help1("A path join command should end with two dots.");
+    mp_back_error(mp);
+  }
+DONE:
+  ;
+}
+
+@ @<Set explicit tensions@>=
+{ 
+  mp_get_x_next(mp); y=mp->cur_cmd;
+  if ( mp->cur_cmd==at_least ) mp_get_x_next(mp);
+  mp_scan_primary(mp);
+  @<Make sure that the current expression is a valid tension setting@>;
+  if ( y==at_least ) negate(mp->cur_exp);
+  right_tension(q)=mp->cur_exp;
+  if ( mp->cur_cmd==and_command ) {
+    mp_get_x_next(mp); y=mp->cur_cmd;
+    if ( mp->cur_cmd==at_least ) mp_get_x_next(mp);
+    mp_scan_primary(mp);
+    @<Make sure that the current expression is a valid tension setting@>;
+    if ( y==at_least ) negate(mp->cur_exp);
+  }
+  y=mp->cur_exp;
+}
+
+@ @d min_tension three_quarter_unit
+
+@<Make sure that the current expression is a valid tension setting@>=
+if ( (mp->cur_type!=mp_known)||(mp->cur_exp<min_tension) ) {
+  exp_err("Improper tension has been set to 1");
+@.Improper tension@>
+  help1("The expression above should have been a number >=3/4.");
+  mp_put_get_flush_error(mp, unity);
+}
+
+@ @<Set explicit control points@>=
+{ 
+  right_type(q)=mp_explicit; t=mp_explicit; mp_get_x_next(mp); mp_scan_primary(mp);
+  mp_known_pair(mp); right_x(q)=mp->cur_x; right_y(q)=mp->cur_y;
+  if ( mp->cur_cmd!=and_command ) {
+    x=right_x(q); y=right_y(q);
+  } else { 
+    mp_get_x_next(mp); mp_scan_primary(mp);
+    mp_known_pair(mp); x=mp->cur_x; y=mp->cur_y;
+  }
+}
+
+@ @<Convert the right operand, |cur_exp|, into a partial path...@>=
+{ 
+  if ( mp->cur_type!=mp_path_type ) pp=mp_new_knot(mp);
+  else pp=mp->cur_exp;
+  qq=pp;
+  while ( link(qq)!=pp ) qq=link(qq);
+  if ( left_type(pp)!=mp_endpoint ) { /* open up a cycle */
+    r=mp_copy_knot(mp, pp); link(qq)=r; qq=r;
+  }
+  left_type(pp)=mp_open; right_type(qq)=mp_open;
+}
+
+@ If a person tries to define an entire path by saying `\.{(x,y)\&cycle}',
+we silently change the specification to `\.{(x,y)..cycle}', since a cycle
+shouldn't have length zero.
+
+@<Get ready to close a cycle@>=
+{ 
+  cycle_hit=true; mp_get_x_next(mp); pp=p; qq=p;
+  if ( d==ampersand ) if ( p==q ) {
+    d=path_join; right_tension(q)=unity; y=unity;
+  }
+}
+
+@ @<Join the partial paths and reset |p| and |q|...@>=
+{ 
+if ( d==ampersand ) {
+  if ( (x_coord(q)!=x_coord(pp))||(y_coord(q)!=y_coord(pp)) ) {
+    print_err("Paths don't touch; `&' will be changed to `..'");
+@.Paths don't touch@>
+    help3("When you join paths `p&q', the ending point of p")
+      ("must be exactly equal to the starting point of q.")
+      ("So I'm going to pretend that you said `p..q' instead.");
+    mp_put_get_error(mp); d=path_join; right_tension(q)=unity; y=unity;
+  }
+}
+@<Plug an opening in |right_type(pp)|, if possible@>;
+if ( d==ampersand ) {
+  @<Splice independent paths together@>;
+} else  { 
+  @<Plug an opening in |right_type(q)|, if possible@>;
+  link(q)=pp; left_y(pp)=y;
+  if ( t!=mp_open ) { left_x(pp)=x; left_type(pp)=t;  };
+}
+q=qq;
+}
+
+@ @<Plug an opening in |right_type(q)|...@>=
+if ( right_type(q)==mp_open ) {
+  if ( (left_type(q)==mp_curl)||(left_type(q)==mp_given) ) {
+    right_type(q)=left_type(q); right_given(q)=left_given(q);
+  }
+}
+
+@ @<Plug an opening in |right_type(pp)|...@>=
+if ( right_type(pp)==mp_open ) {
+  if ( (t==mp_curl)||(t==mp_given) ) {
+    right_type(pp)=t; right_given(pp)=x;
+  }
+}
+
+@ @<Splice independent paths together@>=
+{ 
+  if ( left_type(q)==mp_open ) if ( right_type(q)==mp_open ) {
+    left_type(q)=mp_curl; left_curl(q)=unity;
+  }
+  if ( right_type(pp)==mp_open ) if ( t==mp_open ) {
+    right_type(pp)=mp_curl; right_curl(pp)=unity;
+  }
+  right_type(q)=right_type(pp); link(q)=link(pp);
+  right_x(q)=right_x(pp); right_y(q)=right_y(pp);
+  mp_free_node(mp, pp,knot_node_size);
+  if ( qq==pp ) qq=q;
+}
+
+@ @<Choose control points for the path...@>=
+if ( cycle_hit ) { 
+  if ( d==ampersand ) p=q;
+} else  { 
+  left_type(p)=mp_endpoint;
+  if ( right_type(p)==mp_open ) { 
+    right_type(p)=mp_curl; right_curl(p)=unity;
+  }
+  right_type(q)=mp_endpoint;
+  if ( left_type(q)==mp_open ) { 
+    left_type(q)=mp_curl; left_curl(q)=unity;
+  }
+  link(q)=p;
+}
+mp_make_choices(mp, p);
+mp->cur_type=mp_path_type; mp->cur_exp=p
+
+@ Finally, we sometimes need to scan an expression whose value is
+supposed to be either |true_code| or |false_code|.
+
+@<Declare the basic parsing subroutines@>=
+void mp_get_boolean (MP mp) { 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_boolean_type ) {
+    exp_err("Undefined condition will be treated as `false'");
+@.Undefined condition...@>
+    help2("The expression shown above should have had a definite")
+      ("true-or-false value. I'm changing it to `false'.");
+    mp_put_get_flush_error(mp, false_code); mp->cur_type=mp_boolean_type;
+  }
+}
+
+@* \[39] Doing the operations.
+The purpose of parsing is primarily to permit people to avoid piles of
+parentheses. But the real work is done after the structure of an expression
+has been recognized; that's when new expressions are generated. We
+turn now to the guts of \MP, which handles individual operators that
+have come through the parsing mechanism.
+
+We'll start with the easy ones that take no operands, then work our way
+up to operators with one and ultimately two arguments. In other words,
+we will write the three procedures |do_nullary|, |do_unary|, and |do_binary|
+that are invoked periodically by the expression scanners.
+
+First let's make sure that all of the primitive operators are in the
+hash table. Although |scan_primary| and its relatives made use of the
+\\{cmd} code for these operators, the \\{do} routines base everything
+on the \\{mod} code. For example, |do_binary| doesn't care whether the
+operation it performs is a |primary_binary| or |secondary_binary|, etc.
+
+@<Put each...@>=
+mp_primitive(mp, "true",nullary,true_code);
+@:true_}{\&{true} primitive@>
+mp_primitive(mp, "false",nullary,false_code);
+@:false_}{\&{false} primitive@>
+mp_primitive(mp, "nullpicture",nullary,null_picture_code);
+@:null_picture_}{\&{nullpicture} primitive@>
+mp_primitive(mp, "nullpen",nullary,null_pen_code);
+@:null_pen_}{\&{nullpen} primitive@>
+mp_primitive(mp, "jobname",nullary,job_name_op);
+@:job_name_}{\&{jobname} primitive@>
+mp_primitive(mp, "readstring",nullary,read_string_op);
+@:read_string_}{\&{readstring} primitive@>
+mp_primitive(mp, "pencircle",nullary,pen_circle);
+@:pen_circle_}{\&{pencircle} primitive@>
+mp_primitive(mp, "normaldeviate",nullary,normal_deviate);
+@:normal_deviate_}{\&{normaldeviate} primitive@>
+mp_primitive(mp, "readfrom",unary,read_from_op);
+@:read_from_}{\&{readfrom} primitive@>
+mp_primitive(mp, "closefrom",unary,close_from_op);
+@:close_from_}{\&{closefrom} primitive@>
+mp_primitive(mp, "odd",unary,odd_op);
+@:odd_}{\&{odd} primitive@>
+mp_primitive(mp, "known",unary,known_op);
+@:known_}{\&{known} primitive@>
+mp_primitive(mp, "unknown",unary,unknown_op);
+@:unknown_}{\&{unknown} primitive@>
+mp_primitive(mp, "not",unary,not_op);
+@:not_}{\&{not} primitive@>
+mp_primitive(mp, "decimal",unary,decimal);
+@:decimal_}{\&{decimal} primitive@>
+mp_primitive(mp, "reverse",unary,reverse);
+@:reverse_}{\&{reverse} primitive@>
+mp_primitive(mp, "makepath",unary,make_path_op);
+@:make_path_}{\&{makepath} primitive@>
+mp_primitive(mp, "makepen",unary,make_pen_op);
+@:make_pen_}{\&{makepen} primitive@>
+mp_primitive(mp, "oct",unary,oct_op);
+@:oct_}{\&{oct} primitive@>
+mp_primitive(mp, "hex",unary,hex_op);
+@:hex_}{\&{hex} primitive@>
+mp_primitive(mp, "ASCII",unary,ASCII_op);
+@:ASCII_}{\&{ASCII} primitive@>
+mp_primitive(mp, "char",unary,char_op);
+@:char_}{\&{char} primitive@>
+mp_primitive(mp, "length",unary,length_op);
+@:length_}{\&{length} primitive@>
+mp_primitive(mp, "turningnumber",unary,turning_op);
+@:turning_number_}{\&{turningnumber} primitive@>
+mp_primitive(mp, "xpart",unary,x_part);
+@:x_part_}{\&{xpart} primitive@>
+mp_primitive(mp, "ypart",unary,y_part);
+@:y_part_}{\&{ypart} primitive@>
+mp_primitive(mp, "xxpart",unary,xx_part);
+@:xx_part_}{\&{xxpart} primitive@>
+mp_primitive(mp, "xypart",unary,xy_part);
+@:xy_part_}{\&{xypart} primitive@>
+mp_primitive(mp, "yxpart",unary,yx_part);
+@:yx_part_}{\&{yxpart} primitive@>
+mp_primitive(mp, "yypart",unary,yy_part);
+@:yy_part_}{\&{yypart} primitive@>
+mp_primitive(mp, "redpart",unary,red_part);
+@:red_part_}{\&{redpart} primitive@>
+mp_primitive(mp, "greenpart",unary,green_part);
+@:green_part_}{\&{greenpart} primitive@>
+mp_primitive(mp, "bluepart",unary,blue_part);
+@:blue_part_}{\&{bluepart} primitive@>
+mp_primitive(mp, "cyanpart",unary,cyan_part);
+@:cyan_part_}{\&{cyanpart} primitive@>
+mp_primitive(mp, "magentapart",unary,magenta_part);
+@:magenta_part_}{\&{magentapart} primitive@>
+mp_primitive(mp, "yellowpart",unary,yellow_part);
+@:yellow_part_}{\&{yellowpart} primitive@>
+mp_primitive(mp, "blackpart",unary,black_part);
+@:black_part_}{\&{blackpart} primitive@>
+mp_primitive(mp, "greypart",unary,grey_part);
+@:grey_part_}{\&{greypart} primitive@>
+mp_primitive(mp, "colormodel",unary,color_model_part);
+@:color_model_part_}{\&{colormodel} primitive@>
+mp_primitive(mp, "fontpart",unary,font_part);
+@:font_part_}{\&{fontpart} primitive@>
+mp_primitive(mp, "textpart",unary,text_part);
+@:text_part_}{\&{textpart} primitive@>
+mp_primitive(mp, "pathpart",unary,path_part);
+@:path_part_}{\&{pathpart} primitive@>
+mp_primitive(mp, "penpart",unary,pen_part);
+@:pen_part_}{\&{penpart} primitive@>
+mp_primitive(mp, "dashpart",unary,dash_part);
+@:dash_part_}{\&{dashpart} primitive@>
+mp_primitive(mp, "sqrt",unary,sqrt_op);
+@:sqrt_}{\&{sqrt} primitive@>
+mp_primitive(mp, "mexp",unary,m_exp_op);
+@:m_exp_}{\&{mexp} primitive@>
+mp_primitive(mp, "mlog",unary,m_log_op);
+@:m_log_}{\&{mlog} primitive@>
+mp_primitive(mp, "sind",unary,sin_d_op);
+@:sin_d_}{\&{sind} primitive@>
+mp_primitive(mp, "cosd",unary,cos_d_op);
+@:cos_d_}{\&{cosd} primitive@>
+mp_primitive(mp, "floor",unary,floor_op);
+@:floor_}{\&{floor} primitive@>
+mp_primitive(mp, "uniformdeviate",unary,uniform_deviate);
+@:uniform_deviate_}{\&{uniformdeviate} primitive@>
+mp_primitive(mp, "charexists",unary,char_exists_op);
+@:char_exists_}{\&{charexists} primitive@>
+mp_primitive(mp, "fontsize",unary,font_size);
+@:font_size_}{\&{fontsize} primitive@>
+mp_primitive(mp, "llcorner",unary,ll_corner_op);
+@:ll_corner_}{\&{llcorner} primitive@>
+mp_primitive(mp, "lrcorner",unary,lr_corner_op);
+@:lr_corner_}{\&{lrcorner} primitive@>
+mp_primitive(mp, "ulcorner",unary,ul_corner_op);
+@:ul_corner_}{\&{ulcorner} primitive@>
+mp_primitive(mp, "urcorner",unary,ur_corner_op);
+@:ur_corner_}{\&{urcorner} primitive@>
+mp_primitive(mp, "arclength",unary,arc_length);
+@:arc_length_}{\&{arclength} primitive@>
+mp_primitive(mp, "angle",unary,angle_op);
+@:angle_}{\&{angle} primitive@>
+mp_primitive(mp, "cycle",cycle,cycle_op);
+@:cycle_}{\&{cycle} primitive@>
+mp_primitive(mp, "stroked",unary,stroked_op);
+@:stroked_}{\&{stroked} primitive@>
+mp_primitive(mp, "filled",unary,filled_op);
+@:filled_}{\&{filled} primitive@>
+mp_primitive(mp, "textual",unary,textual_op);
+@:textual_}{\&{textual} primitive@>
+mp_primitive(mp, "clipped",unary,clipped_op);
+@:clipped_}{\&{clipped} primitive@>
+mp_primitive(mp, "bounded",unary,bounded_op);
+@:bounded_}{\&{bounded} primitive@>
+mp_primitive(mp, "+",plus_or_minus,plus);
+@:+ }{\.{+} primitive@>
+mp_primitive(mp, "-",plus_or_minus,minus);
+@:- }{\.{-} primitive@>
+mp_primitive(mp, "*",secondary_binary,times);
+@:* }{\.{*} primitive@>
+mp_primitive(mp, "/",slash,over); mp->eqtb[frozen_slash]=mp->eqtb[mp->cur_sym];
+@:/ }{\.{/} primitive@>
+mp_primitive(mp, "++",tertiary_binary,pythag_add);
+@:++_}{\.{++} primitive@>
+mp_primitive(mp, "+-+",tertiary_binary,pythag_sub);
+@:+-+_}{\.{+-+} primitive@>
+mp_primitive(mp, "or",tertiary_binary,or_op);
+@:or_}{\&{or} primitive@>
+mp_primitive(mp, "and",and_command,and_op);
+@:and_}{\&{and} primitive@>
+mp_primitive(mp, "<",expression_binary,less_than);
+@:< }{\.{<} primitive@>
+mp_primitive(mp, "<=",expression_binary,less_or_equal);
+@:<=_}{\.{<=} primitive@>
+mp_primitive(mp, ">",expression_binary,greater_than);
+@:> }{\.{>} primitive@>
+mp_primitive(mp, ">=",expression_binary,greater_or_equal);
+@:>=_}{\.{>=} primitive@>
+mp_primitive(mp, "=",equals,equal_to);
+@:= }{\.{=} primitive@>
+mp_primitive(mp, "<>",expression_binary,unequal_to);
+@:<>_}{\.{<>} primitive@>
+mp_primitive(mp, "substring",primary_binary,substring_of);
+@:substring_}{\&{substring} primitive@>
+mp_primitive(mp, "subpath",primary_binary,subpath_of);
+@:subpath_}{\&{subpath} primitive@>
+mp_primitive(mp, "directiontime",primary_binary,direction_time_of);
+@:direction_time_}{\&{directiontime} primitive@>
+mp_primitive(mp, "point",primary_binary,point_of);
+@:point_}{\&{point} primitive@>
+mp_primitive(mp, "precontrol",primary_binary,precontrol_of);
+@:precontrol_}{\&{precontrol} primitive@>
+mp_primitive(mp, "postcontrol",primary_binary,postcontrol_of);
+@:postcontrol_}{\&{postcontrol} primitive@>
+mp_primitive(mp, "penoffset",primary_binary,pen_offset_of);
+@:pen_offset_}{\&{penoffset} primitive@>
+mp_primitive(mp, "arctime",primary_binary,arc_time_of);
+@:arc_time_of_}{\&{arctime} primitive@>
+mp_primitive(mp, "mpversion",nullary,mp_version);
+@:mp_verison_}{\&{mpversion} primitive@>
+mp_primitive(mp, "&",ampersand,concatenate);
+@:!!!}{\.{\&} primitive@>
+mp_primitive(mp, "rotated",secondary_binary,rotated_by);
+@:rotated_}{\&{rotated} primitive@>
+mp_primitive(mp, "slanted",secondary_binary,slanted_by);
+@:slanted_}{\&{slanted} primitive@>
+mp_primitive(mp, "scaled",secondary_binary,scaled_by);
+@:scaled_}{\&{scaled} primitive@>
+mp_primitive(mp, "shifted",secondary_binary,shifted_by);
+@:shifted_}{\&{shifted} primitive@>
+mp_primitive(mp, "transformed",secondary_binary,transformed_by);
+@:transformed_}{\&{transformed} primitive@>
+mp_primitive(mp, "xscaled",secondary_binary,x_scaled);
+@:x_scaled_}{\&{xscaled} primitive@>
+mp_primitive(mp, "yscaled",secondary_binary,y_scaled);
+@:y_scaled_}{\&{yscaled} primitive@>
+mp_primitive(mp, "zscaled",secondary_binary,z_scaled);
+@:z_scaled_}{\&{zscaled} primitive@>
+mp_primitive(mp, "infont",secondary_binary,in_font);
+@:in_font_}{\&{infont} primitive@>
+mp_primitive(mp, "intersectiontimes",tertiary_binary,intersect);
+@:intersection_times_}{\&{intersectiontimes} primitive@>
+mp_primitive(mp, "envelope",primary_binary,envelope_of);
+@:envelope_}{\&{envelope} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case nullary:
+case unary:
+case primary_binary:
+case secondary_binary:
+case tertiary_binary:
+case expression_binary:
+case cycle:
+case plus_or_minus:
+case slash:
+case ampersand:
+case equals:
+case and_command:
+  mp_print_op(mp, m);
+  break;
+
+@ OK, let's look at the simplest \\{do} procedure first.
+
+@c @<Declare nullary action procedure@>
+void mp_do_nullary (MP mp,quarterword c) { 
+  check_arith;
+  if ( mp->internal[mp_tracing_commands]>two )
+    mp_show_cmd_mod(mp, nullary,c);
+  switch (c) {
+  case true_code: case false_code: 
+    mp->cur_type=mp_boolean_type; mp->cur_exp=c;
+    break;
+  case null_picture_code: 
+    mp->cur_type=mp_picture_type;
+    mp->cur_exp=mp_get_node(mp, edge_header_size); 
+    mp_init_edges(mp, mp->cur_exp);
+    break;
+  case null_pen_code: 
+    mp->cur_type=mp_pen_type; mp->cur_exp=mp_get_pen_circle(mp, 0);
+    break;
+  case normal_deviate: 
+    mp->cur_type=mp_known; mp->cur_exp=mp_norm_rand(mp);
+    break;
+  case pen_circle: 
+    mp->cur_type=mp_pen_type; mp->cur_exp=mp_get_pen_circle(mp, unity);
+    break;
+  case job_name_op:  
+    if ( mp->job_name==NULL ) mp_open_log_file(mp);
+    mp->cur_type=mp_string_type; mp->cur_exp=rts(mp->job_name);
+    break;
+  case mp_version: 
+    mp->cur_type=mp_string_type; 
+    mp->cur_exp=intern(metapost_version) ;
+    break;
+  case read_string_op:
+    @<Read a string from the terminal@>;
+    break;
+  } /* there are no other cases */
+  check_arith;
+}
+
+@ @<Read a string...@>=
+{ 
+  if ( mp->interaction<=mp_nonstop_mode )
+    mp_fatal_error(mp, "*** (cannot readstring in nonstop modes)");
+  mp_begin_file_reading(mp); name=is_read;
+  limit=start; prompt_input("");
+  mp_finish_read(mp);
+}
+
+@ @<Declare nullary action procedure@>=
+void mp_finish_read (MP mp) { /* copy |buffer| line to |cur_exp| */
+  size_t k;
+  str_room((int)mp->last-start);
+  for (k=start;k<=mp->last-1;k++) {
+   append_char(mp->buffer[k]);
+  }
+  mp_end_file_reading(mp); mp->cur_type=mp_string_type; 
+  mp->cur_exp=mp_make_string(mp);
+}
+
+@ Things get a bit more interesting when there's an operand. The
+operand to |do_unary| appears in |cur_type| and |cur_exp|.
+
+@c @<Declare unary action procedures@>
+void mp_do_unary (MP mp,quarterword c) {
+  pointer p,q,r; /* for list manipulation */
+  integer x; /* a temporary register */
+  check_arith;
+  if ( mp->internal[mp_tracing_commands]>two )
+    @<Trace the current unary operation@>;
+  switch (c) {
+  case plus:
+    if ( mp->cur_type<mp_color_type ) mp_bad_unary(mp, plus);
+    break;
+  case minus:
+    @<Negate the current expression@>;
+    break;
+  @<Additional cases of unary operators@>;
+  } /* there are no other cases */
+  check_arith;
+}
+
+@ The |nice_pair| function returns |true| if both components of a pair
+are known.
+
+@<Declare unary action procedures@>=
+boolean mp_nice_pair (MP mp,integer p, quarterword t) { 
+  if ( t==mp_pair_type ) {
+    p=value(p);
+    if ( type(x_part_loc(p))==mp_known )
+      if ( type(y_part_loc(p))==mp_known )
+        return true;
+  }
+  return false;
+}
+
+@ The |nice_color_or_pair| function is analogous except that it also accepts
+fully known colors.
+
+@<Declare unary action procedures@>=
+boolean mp_nice_color_or_pair (MP mp,integer p, quarterword t) {
+  pointer q,r; /* for scanning the big node */
+  if ( (t!=mp_pair_type)&&(t!=mp_color_type)&&(t!=mp_cmykcolor_type) ) {
+    return false;
+  } else { 
+    q=value(p);
+    r=q+mp->big_node_size[type(p)];
+    do {  
+      r=r-2;
+      if ( type(r)!=mp_known )
+        return false;
+    } while (r!=q);
+    return true;
+  }
+}
+
+@ @<Declare unary action...@>=
+void mp_print_known_or_unknown_type (MP mp,small_number t, integer v) { 
+  mp_print_char(mp, '(');
+  if ( t>mp_known ) mp_print(mp, "unknown numeric");
+  else { if ( (t==mp_pair_type)||(t==mp_color_type)||(t==mp_cmykcolor_type) )
+    if ( ! mp_nice_color_or_pair(mp, v,t) ) mp_print(mp, "unknown ");
+    mp_print_type(mp, t);
+  }
+  mp_print_char(mp, ')');
+}
+
+@ @<Declare unary action...@>=
+void mp_bad_unary (MP mp,quarterword c) { 
+  exp_err("Not implemented: "); mp_print_op(mp, c);
+@.Not implemented...@>
+  mp_print_known_or_unknown_type(mp, mp->cur_type,mp->cur_exp);
+  help3("I'm afraid I don't know how to apply that operation to that")
+    ("particular type. Continue, and I'll simply return the")
+    ("argument (shown above) as the result of the operation.");
+  mp_put_get_error(mp);
+}
+
+@ @<Trace the current unary operation@>=
+{ 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{"); 
+  mp_print_op(mp, c); mp_print_char(mp, '(');
+  mp_print_exp(mp, null,0); /* show the operand, but not verbosely */
+  mp_print(mp, ")}"); mp_end_diagnostic(mp, false);
+}
+
+@ Negation is easy except when the current expression
+is of type |independent|, or when it is a pair with one or more
+|independent| components.
+
+It is tempting to argue that the negative of an independent variable
+is an independent variable, hence we don't have to do anything when
+negating it. The fallacy is that other dependent variables pointing
+to the current expression must change the sign of their
+coefficients if we make no change to the current expression.
+
+Instead, we work around the problem by copying the current expression
+and recycling it afterwards (cf.~the |stash_in| routine).
+
+@<Negate the current expression@>=
+switch (mp->cur_type) {
+case mp_color_type:
+case mp_cmykcolor_type:
+case mp_pair_type:
+case mp_independent: 
+  q=mp->cur_exp; mp_make_exp_copy(mp, q);
+  if ( mp->cur_type==mp_dependent ) {
+    mp_negate_dep_list(mp, dep_list(mp->cur_exp));
+  } else if ( mp->cur_type<=mp_pair_type ) { /* |mp_color_type| or |mp_pair_type| */
+    p=value(mp->cur_exp);
+    r=p+mp->big_node_size[mp->cur_type];
+    do {  
+      r=r-2;
+      if ( type(r)==mp_known ) negate(value(r));
+      else mp_negate_dep_list(mp, dep_list(r));
+    } while (r!=p);
+  } /* if |cur_type=mp_known| then |cur_exp=0| */
+  mp_recycle_value(mp, q); mp_free_node(mp, q,value_node_size);
+  break;
+case mp_dependent:
+case mp_proto_dependent:
+  mp_negate_dep_list(mp, dep_list(mp->cur_exp));
+  break;
+case mp_known:
+  negate(mp->cur_exp);
+  break;
+default:
+  mp_bad_unary(mp, minus);
+  break;
+}
+
+@ @<Declare unary action...@>=
+void mp_negate_dep_list (MP mp,pointer p) { 
+  while (1) { 
+    negate(value(p));
+    if ( info(p)==null ) return;
+    p=link(p);
+  }
+}
+
+@ @<Additional cases of unary operators@>=
+case not_op: 
+  if ( mp->cur_type!=mp_boolean_type ) mp_bad_unary(mp, not_op);
+  else mp->cur_exp=true_code+false_code-mp->cur_exp;
+  break;
+
+@ @d three_sixty_units 23592960 /* that's |360*unity| */
+@d boolean_reset(A) if ( (A) ) mp->cur_exp=true_code; else mp->cur_exp=false_code
+
+@<Additional cases of unary operators@>=
+case sqrt_op:
+case m_exp_op:
+case m_log_op:
+case sin_d_op:
+case cos_d_op:
+case floor_op:
+case  uniform_deviate:
+case odd_op:
+case char_exists_op:
+  if ( mp->cur_type!=mp_known ) {
+    mp_bad_unary(mp, c);
+  } else {
+    switch (c) {
+    case sqrt_op:mp->cur_exp=mp_square_rt(mp, mp->cur_exp);break;
+    case m_exp_op:mp->cur_exp=mp_m_exp(mp, mp->cur_exp);break;
+    case m_log_op:mp->cur_exp=mp_m_log(mp, mp->cur_exp);break;
+    case sin_d_op:
+    case cos_d_op:
+      mp_n_sin_cos(mp, (mp->cur_exp % three_sixty_units)*16);
+      if ( c==sin_d_op ) mp->cur_exp=mp_round_fraction(mp, mp->n_sin);
+      else mp->cur_exp=mp_round_fraction(mp, mp->n_cos);
+      break;
+    case floor_op:mp->cur_exp=mp_floor_scaled(mp, mp->cur_exp);break;
+    case uniform_deviate:mp->cur_exp=mp_unif_rand(mp, mp->cur_exp);break;
+    case odd_op: 
+      boolean_reset(odd(mp_round_unscaled(mp, mp->cur_exp)));
+      mp->cur_type=mp_boolean_type;
+      break;
+    case char_exists_op:
+      @<Determine if a character has been shipped out@>;
+      break;
+    } /* there are no other cases */
+  }
+  break;
+
+@ @<Additional cases of unary operators@>=
+case angle_op:
+  if ( mp_nice_pair(mp, mp->cur_exp,mp->cur_type) ) {
+    p=value(mp->cur_exp);
+    x=mp_n_arg(mp, value(x_part_loc(p)),value(y_part_loc(p)));
+    if ( x>=0 ) mp_flush_cur_exp(mp, (x+8)/ 16);
+    else mp_flush_cur_exp(mp, -((-x+8)/ 16));
+  } else {
+    mp_bad_unary(mp, angle_op);
+  }
+  break;
+
+@ If the current expression is a pair, but the context wants it to
+be a path, we call |pair_to_path|.
+
+@<Declare unary action...@>=
+void mp_pair_to_path (MP mp) { 
+  mp->cur_exp=mp_new_knot(mp); 
+  mp->cur_type=mp_path_type;
+}
+
+@ 
+@d pict_color_type(A) ((link(dummy_loc(mp->cur_exp))!=null) &&
+                       (has_color(link(dummy_loc(mp->cur_exp)))) &&
+                       (color_model(link(dummy_loc(mp->cur_exp)))==A))
+
+@<Additional cases of unary operators@>=
+case x_part:
+case y_part:
+  if ( (mp->cur_type==mp_pair_type)||(mp->cur_type==mp_transform_type) )
+    mp_take_part(mp, c);
+  else if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c);
+  else mp_bad_unary(mp, c);
+  break;
+case xx_part:
+case xy_part:
+case yx_part:
+case yy_part: 
+  if ( mp->cur_type==mp_transform_type ) mp_take_part(mp, c);
+  else if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c);
+  else mp_bad_unary(mp, c);
+  break;
+case red_part:
+case green_part:
+case blue_part: 
+  if ( mp->cur_type==mp_color_type ) mp_take_part(mp, c);
+  else if ( mp->cur_type==mp_picture_type ) {
+    if pict_color_type(mp_rgb_model) mp_take_pict_part(mp, c);
+    else mp_bad_color_part(mp, c);
+  }
+  else mp_bad_unary(mp, c);
+  break;
+case cyan_part:
+case magenta_part:
+case yellow_part:
+case black_part: 
+  if ( mp->cur_type==mp_cmykcolor_type) mp_take_part(mp, c); 
+  else if ( mp->cur_type==mp_picture_type ) {
+    if pict_color_type(mp_cmyk_model) mp_take_pict_part(mp, c);
+    else mp_bad_color_part(mp, c);
+  }
+  else mp_bad_unary(mp, c);
+  break;
+case grey_part: 
+  if ( mp->cur_type==mp_known ) mp->cur_exp=value(c);
+  else if ( mp->cur_type==mp_picture_type ) {
+    if pict_color_type(mp_grey_model) mp_take_pict_part(mp, c);
+    else mp_bad_color_part(mp, c);
+  }
+  else mp_bad_unary(mp, c);
+  break;
+case color_model_part: 
+  if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c);
+  else mp_bad_unary(mp, c);
+  break;
+
+@ @<Declarations@>=
+void mp_bad_color_part(MP mp, quarterword c);
+
+@ @c
+void mp_bad_color_part(MP mp, quarterword c) {
+  pointer p; /* the big node */
+  p=link(dummy_loc(mp->cur_exp));
+  exp_err("Wrong picture color model: "); mp_print_op(mp, c);
+@.Wrong picture color model...@>
+  if (color_model(p)==mp_grey_model)
+    mp_print(mp, " of grey object");
+  else if (color_model(p)==mp_cmyk_model)
+    mp_print(mp, " of cmyk object");
+  else if (color_model(p)==mp_rgb_model)
+    mp_print(mp, " of rgb object");
+  else if (color_model(p)==mp_no_model) 
+    mp_print(mp, " of marking object");
+  else 
+    mp_print(mp," of defaulted object");
+  help3("You can only ask for the redpart, greenpart, bluepart of a rgb object,")
+    ("the cyanpart, magentapart, yellowpart or blackpart of a cmyk object, ")
+    ("or the greypart of a grey object. No mixing and matching, please.");
+  mp_error(mp);
+  if (c==black_part)
+    mp_flush_cur_exp(mp,unity);
+  else
+    mp_flush_cur_exp(mp,0);
+}
+
+@ In the following procedure, |cur_exp| points to a capsule, which points to
+a big node. We want to delete all but one part of the big node.
+
+@<Declare unary action...@>=
+void mp_take_part (MP mp,quarterword c) {
+  pointer p; /* the big node */
+  p=value(mp->cur_exp); value(temp_val)=p; type(temp_val)=mp->cur_type;
+  link(p)=temp_val; mp_free_node(mp, mp->cur_exp,value_node_size);
+  mp_make_exp_copy(mp, p+mp->sector_offset[c+mp_x_part_sector-x_part]);
+  mp_recycle_value(mp, temp_val);
+}
+
+@ @<Initialize table entries...@>=
+name_type(temp_val)=mp_capsule;
+
+@ @<Additional cases of unary operators@>=
+case font_part:
+case text_part:
+case path_part:
+case pen_part:
+case dash_part:
+  if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c);
+  else mp_bad_unary(mp, c);
+  break;
+
+@ @<Declarations@>=
+void mp_scale_edges (MP mp);
+
+@ @<Declare unary action...@>=
+void mp_take_pict_part (MP mp,quarterword c) {
+  pointer p; /* first graphical object in |cur_exp| */
+  p=link(dummy_loc(mp->cur_exp));
+  if ( p!=null ) {
+    switch (c) {
+    case x_part: case y_part: case xx_part:
+    case xy_part: case yx_part: case yy_part:
+      if ( type(p)==mp_text_code ) mp_flush_cur_exp(mp, text_trans_part(p+c));
+      else goto NOT_FOUND;
+      break;
+    case red_part: case green_part: case blue_part:
+      if ( has_color(p) ) mp_flush_cur_exp(mp, obj_color_part(p+c));
+      else goto NOT_FOUND;
+      break;
+    case cyan_part: case magenta_part: case yellow_part:
+    case black_part:
+      if ( has_color(p) ) {
+        if ( color_model(p)==mp_uninitialized_model )
+          mp_flush_cur_exp(mp, unity);
+        else
+          mp_flush_cur_exp(mp, obj_color_part(p+c+(red_part-cyan_part)));
+      } else goto NOT_FOUND;
+      break;
+    case grey_part:
+      if ( has_color(p) )
+          mp_flush_cur_exp(mp, obj_color_part(p+c+(red_part-grey_part)));
+      else goto NOT_FOUND;
+      break;
+    case color_model_part:
+      if ( has_color(p) ) {
+        if ( color_model(p)==mp_uninitialized_model )
+          mp_flush_cur_exp(mp, mp->internal[mp_default_color_model]);
+        else
+          mp_flush_cur_exp(mp, color_model(p)*unity);
+      } else goto NOT_FOUND;
+      break;
+    @<Handle other cases in |take_pict_part| or |goto not_found|@>;
+    } /* all cases have been enumerated */
+    return;
+  };
+NOT_FOUND:
+  @<Convert the current expression to a null value appropriate
+    for |c|@>;
+}
+
+@ @<Handle other cases in |take_pict_part| or |goto not_found|@>=
+case text_part: 
+  if ( type(p)!=mp_text_code ) goto NOT_FOUND;
+  else { 
+    mp_flush_cur_exp(mp, text_p(p));
+    add_str_ref(mp->cur_exp);
+    mp->cur_type=mp_string_type;
+    };
+  break;
+case font_part: 
+  if ( type(p)!=mp_text_code ) goto NOT_FOUND;
+  else { 
+    mp_flush_cur_exp(mp, rts(mp->font_name[font_n(p)])); 
+    add_str_ref(mp->cur_exp);
+    mp->cur_type=mp_string_type;
+  };
+  break;
+case path_part:
+  if ( type(p)==mp_text_code ) goto NOT_FOUND;
+  else if ( is_stop(p) ) mp_confusion(mp, "pict");
+@:this can't happen pict}{\quad pict@>
+  else { 
+    mp_flush_cur_exp(mp, mp_copy_path(mp, path_p(p)));
+    mp->cur_type=mp_path_type;
+  }
+  break;
+case pen_part: 
+  if ( ! has_pen(p) ) goto NOT_FOUND;
+  else {
+    if ( pen_p(p)==null ) goto NOT_FOUND;
+    else { mp_flush_cur_exp(mp, copy_pen(pen_p(p)));
+      mp->cur_type=mp_pen_type;
+    };
+  }
+  break;
+case dash_part: 
+  if ( type(p)!=mp_stroked_code ) goto NOT_FOUND;
+  else { if ( dash_p(p)==null ) goto NOT_FOUND;
+    else { add_edge_ref(dash_p(p));
+    mp->se_sf=dash_scale(p);
+    mp->se_pic=dash_p(p);
+    mp_scale_edges(mp);
+    mp_flush_cur_exp(mp, mp->se_pic);
+    mp->cur_type=mp_picture_type;
+    };
+  }
+  break;
+
+@ Since |scale_edges| had to be declared |forward|, it had to be declared as a
+parameterless procedure even though it really takes two arguments and updates
+one of them.  Hence the following globals are needed.
+
+@<Global...@>=
+pointer se_pic;  /* edge header used and updated by |scale_edges| */
+scaled se_sf;  /* the scale factor argument to |scale_edges| */
+
+@ @<Convert the current expression to a null value appropriate...@>=
+switch (c) {
+case text_part: case font_part: 
+  mp_flush_cur_exp(mp, rts(""));
+  mp->cur_type=mp_string_type;
+  break;
+case path_part: 
+  mp_flush_cur_exp(mp, mp_get_node(mp, knot_node_size));
+  left_type(mp->cur_exp)=mp_endpoint;
+  right_type(mp->cur_exp)=mp_endpoint;
+  link(mp->cur_exp)=mp->cur_exp;
+  x_coord(mp->cur_exp)=0;
+  y_coord(mp->cur_exp)=0;
+  originator(mp->cur_exp)=mp_metapost_user;
+  mp->cur_type=mp_path_type;
+  break;
+case pen_part: 
+  mp_flush_cur_exp(mp, mp_get_pen_circle(mp, 0));
+  mp->cur_type=mp_pen_type;
+  break;
+case dash_part: 
+  mp_flush_cur_exp(mp, mp_get_node(mp, edge_header_size));
+  mp_init_edges(mp, mp->cur_exp);
+  mp->cur_type=mp_picture_type;
+  break;
+default: 
+   mp_flush_cur_exp(mp, 0);
+  break;
+}
+
+@ @<Additional cases of unary...@>=
+case char_op: 
+  if ( mp->cur_type!=mp_known ) { 
+    mp_bad_unary(mp, char_op);
+  } else { 
+    mp->cur_exp=mp_round_unscaled(mp, mp->cur_exp) % 256; 
+    mp->cur_type=mp_string_type;
+    if ( mp->cur_exp<0 ) mp->cur_exp=mp->cur_exp+256;
+  }
+  break;
+case decimal: 
+  if ( mp->cur_type!=mp_known ) {
+     mp_bad_unary(mp, decimal);
+  } else { 
+    mp->old_setting=mp->selector; mp->selector=new_string;
+    mp_print_scaled(mp, mp->cur_exp); mp->cur_exp=mp_make_string(mp);
+    mp->selector=mp->old_setting; mp->cur_type=mp_string_type;
+  }
+  break;
+case oct_op:
+case hex_op:
+case ASCII_op: 
+  if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, c);
+  else mp_str_to_num(mp, c);
+  break;
+case font_size: 
+  if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, font_size);
+  else @<Find the design size of the font whose name is |cur_exp|@>;
+  break;
+
+@ @<Declare unary action...@>=
+void mp_str_to_num (MP mp,quarterword c) { /* converts a string to a number */
+  integer n; /* accumulator */
+  ASCII_code m; /* current character */
+  pool_pointer k; /* index into |str_pool| */
+  int b; /* radix of conversion */
+  boolean bad_char; /* did the string contain an invalid digit? */
+  if ( c==ASCII_op ) {
+    if ( length(mp->cur_exp)==0 ) n=-1;
+    else n=mp->str_pool[mp->str_start[mp->cur_exp]];
+  } else { 
+    if ( c==oct_op ) b=8; else b=16;
+    n=0; bad_char=false;
+    for (k=mp->str_start[mp->cur_exp];k<=str_stop(mp->cur_exp)-1;k++) {
+      m=mp->str_pool[k];
+      if ( (m>='0')&&(m<='9') ) m=m-'0';
+      else if ( (m>='A')&&(m<='F') ) m=m-'A'+10;
+      else if ( (m>='a')&&(m<='f') ) m=m-'a'+10;
+      else  { bad_char=true; m=0; };
+      if ( m>=b ) { bad_char=true; m=0; };
+      if ( n<32768 / b ) n=n*b+m; else n=32767;
+    }
+    @<Give error messages if |bad_char| or |n>=4096|@>;
+  }
+  mp_flush_cur_exp(mp, n*unity);
+}
+
+@ @<Give error messages if |bad_char|...@>=
+if ( bad_char ) { 
+  exp_err("String contains illegal digits");
+@.String contains illegal digits@>
+  if ( c==oct_op ) {
+    help1("I zeroed out characters that weren't in the range 0..7.");
+  } else  {
+    help1("I zeroed out characters that weren't hex digits.");
+  }
+  mp_put_get_error(mp);
+}
+if ( (n>4095) ) {
+  if ( mp->internal[mp_warning_check]>0 ) {
+    print_err("Number too large ("); 
+    mp_print_int(mp, n); mp_print_char(mp, ')');
+@.Number too large@>
+    help2("I have trouble with numbers greater than 4095; watch out.")
+      ("(Set warningcheck:=0 to suppress this message.)");
+    mp_put_get_error(mp);
+  }
+}
+
+@ The length operation is somewhat unusual in that it applies to a variety
+of different types of operands.
+
+@<Additional cases of unary...@>=
+case length_op: 
+  switch (mp->cur_type) {
+  case mp_string_type: mp_flush_cur_exp(mp, length(mp->cur_exp)*unity); break;
+  case mp_path_type: mp_flush_cur_exp(mp, mp_path_length(mp)); break;
+  case mp_known: mp->cur_exp=abs(mp->cur_exp); break;
+  case mp_picture_type: mp_flush_cur_exp(mp, mp_pict_length(mp)); break;
+  default: 
+    if ( mp_nice_pair(mp, mp->cur_exp,mp->cur_type) )
+      mp_flush_cur_exp(mp, mp_pyth_add(mp, 
+        value(x_part_loc(value(mp->cur_exp))),
+        value(y_part_loc(value(mp->cur_exp)))));
+    else mp_bad_unary(mp, c);
+    break;
+  }
+  break;
+
+@ @<Declare unary action...@>=
+scaled mp_path_length (MP mp) { /* computes the length of the current path */
+  scaled n; /* the path length so far */
+  pointer p; /* traverser */
+  p=mp->cur_exp;
+  if ( left_type(p)==mp_endpoint ) n=-unity; else n=0;
+  do {  p=link(p); n=n+unity; } while (p!=mp->cur_exp);
+  return n;
+}
+
+@ @<Declare unary action...@>=
+scaled mp_pict_length (MP mp) { 
+  /* counts interior components in picture |cur_exp| */
+  scaled n; /* the count so far */
+  pointer p; /* traverser */
+  n=0;
+  p=link(dummy_loc(mp->cur_exp));
+  if ( p!=null ) {
+    if ( is_start_or_stop(p) )
+      if ( mp_skip_1component(mp, p)==null ) p=link(p);
+    while ( p!=null )  { 
+      skip_component(p) return n; 
+      n=n+unity;   
+    }
+  }
+  return n;
+}
+
+@ Implement |turningnumber|
+
+@<Additional cases of unary...@>=
+case turning_op:
+  if ( mp->cur_type==mp_pair_type ) mp_flush_cur_exp(mp, 0);
+  else if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, turning_op);
+  else if ( left_type(mp->cur_exp)==mp_endpoint )
+     mp_flush_cur_exp(mp, 0); /* not a cyclic path */
+  else
+    mp_flush_cur_exp(mp, mp_turn_cycles_wrapper(mp, mp->cur_exp));
+  break;
+
+@ The function |an_angle| returns the value of the |angle| primitive, or $0$ if the
+argument is |origin|.
+
+@<Declare unary action...@>=
+angle mp_an_angle (MP mp,scaled xpar, scaled ypar) {
+  if ( (! ((xpar==0) && (ypar==0))) )
+    return mp_n_arg(mp, xpar,ypar);
+  return 0;
+}
+
+
+@ The actual turning number is (for the moment) computed in a C function
+that receives eight integers corresponding to the four controlling points,
+and returns a single angle.  Besides those, we have to account for discrete
+moves at the actual points.
+
+@d floor(a) (a>=0 ? a : -(int)(-a))
+@d bezier_error (720<<20)+1
+@d sign(v) ((v)>0 ? 1 : ((v)<0 ? -1 : 0 ))
+@d print_roots(a) 
+@d out ((double)(xo>>20))
+@d mid ((double)(xm>>20))
+@d in  ((double)(xi>>20))
+@d divisor (256*256)
+@d double2angle(a) (int)floor(a*256.0*256.0*16.0)
+
+@<Declare unary action...@>=
+angle mp_bezier_slope(MP mp, integer AX,integer AY,integer BX,integer BY,
+            integer CX,integer CY,integer DX,integer DY);
+
+@ @c 
+angle mp_bezier_slope(MP mp, integer AX,integer AY,integer BX,integer BY,
+            integer CX,integer CY,integer DX,integer DY) {
+  double a, b, c;
+  integer deltax,deltay;
+  double ax,ay,bx,by,cx,cy,dx,dy;
+  angle xi = 0, xo = 0, xm = 0;
+  double res = 0;
+  ax=AX/divisor;  ay=AY/divisor;
+  bx=BX/divisor;  by=BY/divisor;
+  cx=CX/divisor;  cy=CY/divisor;
+  dx=DX/divisor;  dy=DY/divisor;
+
+  deltax = (BX-AX); deltay = (BY-AY);
+  if (deltax==0 && deltay == 0) { deltax=(CX-AX); deltay=(CY-AY); }
+  if (deltax==0 && deltay == 0) { deltax=(DX-AX); deltay=(DY-AY); }
+  xi = mp_an_angle(mp,deltax,deltay);
+
+  deltax = (CX-BX); deltay = (CY-BY);
+  xm = mp_an_angle(mp,deltax,deltay);
+
+  deltax = (DX-CX); deltay = (DY-CY);
+  if (deltax==0 && deltay == 0) { deltax=(DX-BX); deltay=(DY-BY); }
+  if (deltax==0 && deltay == 0) { deltax=(DX-AX); deltay=(DY-AY); }
+  xo = mp_an_angle(mp,deltax,deltay);
+
+  a = (bx-ax)*(cy-by) - (cx-bx)*(by-ay); /* a = (bp-ap)x(cp-bp); */
+  b = (bx-ax)*(dy-cy) - (by-ay)*(dx-cx);; /* b = (bp-ap)x(dp-cp);*/
+  c = (cx-bx)*(dy-cy) - (dx-cx)*(cy-by); /* c = (cp-bp)x(dp-cp);*/
+
+  if ((a==0)&&(c==0)) {
+    res = (b==0 ?  0 :  (out-in)); 
+    print_roots("no roots (a)");
+  } else if ((a==0)||(c==0)) {
+    if ((sign(b) == sign(a)) || (sign(b) == sign(c))) {
+      res = out-in; /* ? */
+      if (res<-180.0) 
+	res += 360.0;
+      else if (res>180.0)
+	res -= 360.0;
+      print_roots("no roots (b)");
+    } else {
+      res = out-in; /* ? */
+      print_roots("one root (a)");
+    }
+  } else if ((sign(a)*sign(c))<0) {
+    res = out-in; /* ? */
+      if (res<-180.0) 
+	res += 360.0;
+      else if (res>180.0)
+	res -= 360.0;
+    print_roots("one root (b)");
+  } else {
+    if (sign(a) == sign(b)) {
+      res = out-in; /* ? */
+      if (res<-180.0) 
+	res += 360.0;
+      else if (res>180.0)
+	res -= 360.0;
+      print_roots("no roots (d)");
+    } else {
+      if ((b*b) == (4*a*c)) {
+	res = bezier_error;
+	print_roots("double root"); /* cusp */
+      } else if ((b*b) < (4*a*c)) {
+	res = out-in; /* ? */
+	if (res<=0.0 &&res>-180.0) 
+	  res += 360.0;
+        else if (res>=0.0 && res<180.0)
+	  res -= 360.0;
+	print_roots("no roots (e)");
+      } else {
+	res = out-in;
+	if (res<-180.0) 
+	  res += 360.0;
+        else if (res>180.0)
+	  res -= 360.0;
+	print_roots("two roots"); /* two inflections */
+      }
+    }
+  }
+  return double2angle(res);
+}
+
+@
+@d p_nextnext link(link(p))
+@d p_next link(p)
+@d seven_twenty_deg 05500000000 /* $720\cdot2^{20}$, represents $720^\circ$ */
+
+@<Declare unary action...@>=
+scaled mp_new_turn_cycles (MP mp,pointer c) {
+  angle res,ang; /*  the angles of intermediate results  */
+  scaled turns;  /*  the turn counter  */
+  pointer p;     /*  for running around the path  */
+  integer xp,yp;   /*  coordinates of next point  */
+  integer x,y;   /*  helper coordinates  */
+  angle in_angle,out_angle;     /*  helper angles */
+  int old_setting; /* saved |selector| setting */
+  res=0;
+  turns= 0;
+  p=c;
+  old_setting = mp->selector; mp->selector=term_only;
+  if ( mp->internal[mp_tracing_commands]>unity ) {
+    mp_begin_diagnostic(mp);
+    mp_print_nl(mp, "");
+    mp_end_diagnostic(mp, false);
+  }
+  do { 
+    xp = x_coord(p_next); yp = y_coord(p_next);
+    ang  = mp_bezier_slope(mp,x_coord(p), y_coord(p), right_x(p), right_y(p),
+             left_x(p_next), left_y(p_next), xp, yp);
+    if ( ang>seven_twenty_deg ) {
+      print_err("Strange path");
+      mp_error(mp);
+      mp->selector=old_setting;
+      return 0;
+    }
+    res  = res + ang;
+    if ( res > one_eighty_deg ) {
+      res = res - three_sixty_deg;
+      turns = turns + unity;
+    }
+    if ( res <= -one_eighty_deg ) {
+      res = res + three_sixty_deg;
+      turns = turns - unity;
+    }
+    /*  incoming angle at next point  */
+    x = left_x(p_next);  y = left_y(p_next);
+    if ( (xp==x)&&(yp==y) ) { x = right_x(p);  y = right_y(p);  };
+    if ( (xp==x)&&(yp==y) ) { x = x_coord(p);  y = y_coord(p);  };
+    in_angle = mp_an_angle(mp, xp - x, yp - y);
+    /*  outgoing angle at next point  */
+    x = right_x(p_next);  y = right_y(p_next);
+    if ( (xp==x)&&(yp==y) ) { x = left_x(p_nextnext);  y = left_y(p_nextnext);  };
+    if ( (xp==x)&&(yp==y) ) { x = x_coord(p_nextnext); y = y_coord(p_nextnext); };
+    out_angle = mp_an_angle(mp, x - xp, y- yp);
+    ang  = (out_angle - in_angle);
+    reduce_angle(ang);
+    if ( ang!=0 ) {
+      res  = res + ang;
+      if ( res >= one_eighty_deg ) {
+        res = res - three_sixty_deg;
+        turns = turns + unity;
+      };
+      if ( res <= -one_eighty_deg ) {
+        res = res + three_sixty_deg;
+        turns = turns - unity;
+      };
+    };
+    p = link(p);
+  } while (p!=c);
+  mp->selector=old_setting;
+  return turns;
+}
+
+
+@ This code is based on Bogus\l{}av Jackowski's
+|emergency_turningnumber| macro, with some minor changes by Taco
+Hoekwater. The macro code looked more like this:
+{\obeylines
+vardef turning\_number primary p =
+~~save res, ang, turns;
+~~res := 0;
+~~if length p <= 2:
+~~~~if Angle ((point 0 of p) - (postcontrol 0 of p)) >= 0:  1  else: -1 fi
+~~else:
+~~~~for t = 0 upto length p-1 :
+~~~~~~angc := Angle ((point t+1 of p)  - (point t of p))
+~~~~~~~~- Angle ((point t of p) - (point t-1 of p));
+~~~~~~if angc > 180: angc := angc - 360; fi;
+~~~~~~if angc < -180: angc := angc + 360; fi;
+~~~~~~res  := res + angc;
+~~~~endfor;
+~~res/360
+~~fi
+enddef;}
+The general idea is to calculate only the sum of the angles of
+straight lines between the points, of a path, not worrying about cusps
+or self-intersections in the segments at all. If the segment is not
+well-behaved, the result is not necesarily correct. But the old code
+was not always correct either, and worse, it sometimes failed for
+well-behaved paths as well. All known bugs that were triggered by the
+original code no longer occur with this code, and it runs roughly 3
+times as fast because the algorithm is much simpler.
+
+@ It is possible to overflow the return value of the |turn_cycles|
+function when the path is sufficiently long and winding, but I am not
+going to bother testing for that. In any case, it would only return
+the looped result value, which is not a big problem.
+
+The macro code for the repeat loop was a bit nicer to look
+at than the pascal code, because it could use |point -1 of p|. In
+pascal, the fastest way to loop around the path is not to look
+backward once, but forward twice. These defines help hide the trick.
+
+@d p_to link(link(p))
+@d p_here link(p)
+@d p_from p
+
+@<Declare unary action...@>=
+scaled mp_turn_cycles (MP mp,pointer c) {
+  angle res,ang; /*  the angles of intermediate results  */
+  scaled turns;  /*  the turn counter  */
+  pointer p;     /*  for running around the path  */
+  res=0;  turns= 0; p=c;
+  do { 
+    ang  = mp_an_angle (mp, x_coord(p_to) - x_coord(p_here), 
+                            y_coord(p_to) - y_coord(p_here))
+    	- mp_an_angle (mp, x_coord(p_here) - x_coord(p_from), 
+                           y_coord(p_here) - y_coord(p_from));
+    reduce_angle(ang);
+    res  = res + ang;
+    if ( res >= three_sixty_deg )  {
+      res = res - three_sixty_deg;
+      turns = turns + unity;
+    };
+    if ( res <= -three_sixty_deg ) {
+      res = res + three_sixty_deg;
+      turns = turns - unity;
+    };
+    p = link(p);
+  } while (p!=c);
+  return turns;
+}
+
+@ @<Declare unary action...@>=
+scaled mp_turn_cycles_wrapper (MP mp,pointer c) {
+  scaled nval,oval;
+  scaled saved_t_o; /* tracing\_online saved  */
+  if ( (link(c)==c)||(link(link(c))==c) ) {
+    if ( mp_an_angle (mp, x_coord(c) - right_x(c),  y_coord(c) - right_y(c)) > 0 )
+      return unity;
+    else
+      return -unity;
+  } else {
+    nval = mp_new_turn_cycles(mp, c);
+    oval = mp_turn_cycles(mp, c);
+    if ( nval!=oval ) {
+      saved_t_o=mp->internal[mp_tracing_online];
+      mp->internal[mp_tracing_online]=unity;
+      mp_begin_diagnostic(mp);
+      mp_print_nl (mp, "Warning: the turningnumber algorithms do not agree."
+                       " The current computed value is ");
+      mp_print_scaled(mp, nval);
+      mp_print(mp, ", but the 'connect-the-dots' algorithm returned ");
+      mp_print_scaled(mp, oval);
+      mp_end_diagnostic(mp, false);
+      mp->internal[mp_tracing_online]=saved_t_o;
+    }
+    return nval;
+  }
+}
+
+@ @<Declare unary action...@>=
+scaled mp_count_turns (MP mp,pointer c) {
+  pointer p; /* a knot in envelope spec |c| */
+  integer t; /* total pen offset changes counted */
+  t=0; p=c;
+  do {  
+    t=t+info(p)-zero_off;
+    p=link(p);
+  } while (p!=c);
+  return ((t / 3)*unity);
+}
+
+@ @d type_range(A,B) { 
+  if ( (mp->cur_type>=(A)) && (mp->cur_type<=(B)) ) 
+    mp_flush_cur_exp(mp, true_code);
+  else mp_flush_cur_exp(mp, false_code);
+  mp->cur_type=mp_boolean_type;
+  }
+@d type_test(A) { 
+  if ( mp->cur_type==(A) ) mp_flush_cur_exp(mp, true_code);
+  else mp_flush_cur_exp(mp, false_code);
+  mp->cur_type=mp_boolean_type;
+  }
+
+@<Additional cases of unary operators@>=
+case mp_boolean_type: 
+  type_range(mp_boolean_type,mp_unknown_boolean); break;
+case mp_string_type: 
+  type_range(mp_string_type,mp_unknown_string); break;
+case mp_pen_type: 
+  type_range(mp_pen_type,mp_unknown_pen); break;
+case mp_path_type: 
+  type_range(mp_path_type,mp_unknown_path); break;
+case mp_picture_type: 
+  type_range(mp_picture_type,mp_unknown_picture); break;
+case mp_transform_type: case mp_color_type: case mp_cmykcolor_type:
+case mp_pair_type: 
+  type_test(c); break;
+case mp_numeric_type: 
+  type_range(mp_known,mp_independent); break;
+case known_op: case unknown_op: 
+  mp_test_known(mp, c); break;
+
+@ @<Declare unary action procedures@>=
+void mp_test_known (MP mp,quarterword c) {
+  int b; /* is the current expression known? */
+  pointer p,q; /* locations in a big node */
+  b=false_code;
+  switch (mp->cur_type) {
+  case mp_vacuous: case mp_boolean_type: case mp_string_type:
+  case mp_pen_type: case mp_path_type: case mp_picture_type:
+  case mp_known: 
+    b=true_code;
+    break;
+  case mp_transform_type:
+  case mp_color_type: case mp_cmykcolor_type: case mp_pair_type: 
+    p=value(mp->cur_exp);
+    q=p+mp->big_node_size[mp->cur_type];
+    do {  
+      q=q-2;
+      if ( type(q)!=mp_known ) 
+       goto DONE;
+    } while (q!=p);
+    b=true_code;
+  DONE:  
+    break;
+  default: 
+    break;
+  }
+  if ( c==known_op ) mp_flush_cur_exp(mp, b);
+  else mp_flush_cur_exp(mp, true_code+false_code-b);
+  mp->cur_type=mp_boolean_type;
+}
+
+@ @<Additional cases of unary operators@>=
+case cycle_op: 
+  if ( mp->cur_type!=mp_path_type ) mp_flush_cur_exp(mp, false_code);
+  else if ( left_type(mp->cur_exp)!=mp_endpoint ) mp_flush_cur_exp(mp, true_code);
+  else mp_flush_cur_exp(mp, false_code);
+  mp->cur_type=mp_boolean_type;
+  break;
+
+@ @<Additional cases of unary operators@>=
+case arc_length: 
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, arc_length);
+  else mp_flush_cur_exp(mp, mp_get_arc_length(mp, mp->cur_exp));
+  break;
+
+@ Here we use the fact that |c-filled_op+fill_code| is the desired graphical
+object |type|.
+@^data structure assumptions@>
+
+@<Additional cases of unary operators@>=
+case filled_op:
+case stroked_op:
+case textual_op:
+case clipped_op:
+case bounded_op:
+  if ( mp->cur_type!=mp_picture_type ) mp_flush_cur_exp(mp, false_code);
+  else if ( link(dummy_loc(mp->cur_exp))==null ) mp_flush_cur_exp(mp, false_code);
+  else if ( type(link(dummy_loc(mp->cur_exp)))==c+mp_fill_code-filled_op )
+    mp_flush_cur_exp(mp, true_code);
+  else mp_flush_cur_exp(mp, false_code);
+  mp->cur_type=mp_boolean_type;
+  break;
+
+@ @<Additional cases of unary operators@>=
+case make_pen_op: 
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, make_pen_op);
+  else { 
+    mp->cur_type=mp_pen_type;
+    mp->cur_exp=mp_make_pen(mp, mp->cur_exp,true);
+  };
+  break;
+case make_path_op: 
+  if ( mp->cur_type!=mp_pen_type ) mp_bad_unary(mp, make_path_op);
+  else  { 
+    mp->cur_type=mp_path_type;
+    mp_make_path(mp, mp->cur_exp);
+  };
+  break;
+case reverse: 
+  if ( mp->cur_type==mp_path_type ) {
+    p=mp_htap_ypoc(mp, mp->cur_exp);
+    if ( right_type(p)==mp_endpoint ) p=link(p);
+    mp_toss_knot_list(mp, mp->cur_exp); mp->cur_exp=p;
+  } else if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  else mp_bad_unary(mp, reverse);
+  break;
+
+@ The |pair_value| routine changes the current expression to a
+given ordered pair of values.
+
+@<Declare unary action procedures@>=
+void mp_pair_value (MP mp,scaled x, scaled y) {
+  pointer p; /* a pair node */
+  p=mp_get_node(mp, value_node_size); 
+  mp_flush_cur_exp(mp, p); mp->cur_type=mp_pair_type;
+  type(p)=mp_pair_type; name_type(p)=mp_capsule; mp_init_big_node(mp, p);
+  p=value(p);
+  type(x_part_loc(p))=mp_known; value(x_part_loc(p))=x;
+  type(y_part_loc(p))=mp_known; value(y_part_loc(p))=y;
+}
+
+@ @<Additional cases of unary operators@>=
+case ll_corner_op: 
+  if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ll_corner_op);
+  else mp_pair_value(mp, minx,miny);
+  break;
+case lr_corner_op: 
+  if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, lr_corner_op);
+  else mp_pair_value(mp, maxx,miny);
+  break;
+case ul_corner_op: 
+  if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ul_corner_op);
+  else mp_pair_value(mp, minx,maxy);
+  break;
+case ur_corner_op: 
+  if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ur_corner_op);
+  else mp_pair_value(mp, maxx,maxy);
+  break;
+
+@ Here is a function that sets |minx|, |maxx|, |miny|, |maxy| to the bounding
+box of the current expression.  The boolean result is |false| if the expression
+has the wrong type.
+
+@<Declare unary action procedures@>=
+boolean mp_get_cur_bbox (MP mp) { 
+  switch (mp->cur_type) {
+  case mp_picture_type: 
+    mp_set_bbox(mp, mp->cur_exp,true);
+    if ( minx_val(mp->cur_exp)>maxx_val(mp->cur_exp) ) {
+      minx=0; maxx=0; miny=0; maxy=0;
+    } else { 
+      minx=minx_val(mp->cur_exp);
+      maxx=maxx_val(mp->cur_exp);
+      miny=miny_val(mp->cur_exp);
+      maxy=maxy_val(mp->cur_exp);
+    }
+    break;
+  case mp_path_type: 
+    mp_path_bbox(mp, mp->cur_exp);
+    break;
+  case mp_pen_type: 
+    mp_pen_bbox(mp, mp->cur_exp);
+    break;
+  default: 
+    return false;
+  }
+  return true;
+}
+
+@ @<Additional cases of unary operators@>=
+case read_from_op:
+case close_from_op: 
+  if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, c);
+  else mp_do_read_or_close(mp,c);
+  break;
+
+@ Here is a routine that interprets |cur_exp| as a file name and tries to read
+a line from the file or to close the file.
+
+@<Declare unary action procedures@>=
+void mp_do_read_or_close (MP mp,quarterword c) {
+  readf_index n,n0; /* indices for searching |rd_fname| */
+  @<Find the |n| where |rd_fname[n]=cur_exp|; if |cur_exp| must be inserted,
+    call |start_read_input| and |goto found| or |not_found|@>;
+  mp_begin_file_reading(mp);
+  name=is_read;
+  if ( mp_input_ln(mp, mp->rd_file[n] ) ) 
+    goto FOUND;
+  mp_end_file_reading(mp);
+NOT_FOUND:
+  @<Record the end of file and set |cur_exp| to a dummy value@>;
+  return;
+CLOSE_FILE:
+  mp_flush_cur_exp(mp, 0); mp->cur_type=mp_vacuous; 
+  return;
+FOUND:
+  mp_flush_cur_exp(mp, 0);
+  mp_finish_read(mp);
+}
+
+@ Free slots in the |rd_file| and |rd_fname| arrays are marked with NULL's in
+|rd_fname|.
+
+@<Find the |n| where |rd_fname[n]=cur_exp|...@>=
+{   
+  char *fn;
+  n=mp->read_files;
+  n0=mp->read_files;
+  fn = str(mp->cur_exp);
+  while (mp_xstrcmp(fn,mp->rd_fname[n])!=0) { 
+    if ( n>0 ) {
+      decr(n);
+    } else if ( c==close_from_op ) {
+      goto CLOSE_FILE;
+    } else {
+      if ( n0==mp->read_files ) {
+        if ( mp->read_files<mp->max_read_files ) {
+          incr(mp->read_files);
+        } else {
+          void **rd_file;
+          char **rd_fname;
+	      readf_index l,k;
+          l = mp->max_read_files + (mp->max_read_files>>2);
+          rd_file = xmalloc((l+1), sizeof(void *));
+          rd_fname = xmalloc((l+1), sizeof(char *));
+	      for (k=0;k<=l;k++) {
+            if (k<=mp->max_read_files) {
+   	          rd_file[k]=mp->rd_file[k]; 
+              rd_fname[k]=mp->rd_fname[k];
+            } else {
+ 	      rd_file[k]=0; 
+              rd_fname[k]=NULL;
+            }
+          }
+	      xfree(mp->rd_file); xfree(mp->rd_fname);
+          mp->max_read_files = l;
+          mp->rd_file = rd_file;
+          mp->rd_fname = rd_fname;
+        }
+      }
+      n=n0;
+      if ( mp_start_read_input(mp,fn,n) ) 
+        goto FOUND;
+      else 
+        goto NOT_FOUND;
+    }
+    if ( mp->rd_fname[n]==NULL ) { n0=n; }
+  } 
+  if ( c==close_from_op ) { 
+    (mp->close_file)(mp,mp->rd_file[n]); 
+    goto NOT_FOUND; 
+  }
+}
+
+@ @<Record the end of file and set |cur_exp| to a dummy value@>=
+xfree(mp->rd_fname[n]);
+mp->rd_fname[n]=NULL;
+if ( n==mp->read_files-1 ) mp->read_files=n;
+if ( c==close_from_op ) 
+  goto CLOSE_FILE;
+mp_flush_cur_exp(mp, mp->eof_line);
+mp->cur_type=mp_string_type
+
+@ The string denoting end-of-file is a one-byte string at position zero, by definition
+
+@<Glob...@>=
+str_number eof_line;
+
+@ @<Set init...@>=
+mp->eof_line=0;
+
+@ Finally, we have the operations that combine a capsule~|p|
+with the current expression.
+
+@d binary_return  { mp_finish_binary(mp, old_p, old_exp); return; }
+
+@c @<Declare binary action procedures@>
+void mp_finish_binary (MP mp, pointer old_p, pointer old_exp ){
+  check_arith; 
+  @<Recycle any sidestepped |independent| capsules@>;
+}
+void mp_do_binary (MP mp,pointer p, quarterword c) {
+  pointer q,r,rr; /* for list manipulation */
+  pointer old_p,old_exp; /* capsules to recycle */
+  integer v; /* for numeric manipulation */
+  check_arith;
+  if ( mp->internal[mp_tracing_commands]>two ) {
+    @<Trace the current binary operation@>;
+  }
+  @<Sidestep |independent| cases in capsule |p|@>;
+  @<Sidestep |independent| cases in the current expression@>;
+  switch (c) {
+  case plus: case minus:
+    @<Add or subtract the current expression from |p|@>;
+    break;
+  @<Additional cases of binary operators@>;
+  }; /* there are no other cases */
+  mp_recycle_value(mp, p); 
+  mp_free_node(mp, p,value_node_size); /* |return| to avoid this */
+  mp_finish_binary(mp, old_p, old_exp);
+}
+
+@ @<Declare binary action...@>=
+void mp_bad_binary (MP mp,pointer p, quarterword c) { 
+  mp_disp_err(mp, p,"");
+  exp_err("Not implemented: ");
+@.Not implemented...@>
+  if ( c>=min_of ) mp_print_op(mp, c);
+  mp_print_known_or_unknown_type(mp, type(p),p);
+  if ( c>=min_of ) mp_print(mp, "of"); else mp_print_op(mp, c);
+  mp_print_known_or_unknown_type(mp, mp->cur_type,mp->cur_exp);
+  help3("I'm afraid I don't know how to apply that operation to that")
+       ("combination of types. Continue, and I'll return the second")
+      ("argument (see above) as the result of the operation.");
+  mp_put_get_error(mp);
+}
+void mp_bad_envelope_pen (MP mp) {
+  mp_disp_err(mp, null,"");
+  exp_err("Not implemented: envelope(elliptical pen)of(path)");
+@.Not implemented...@>
+  help3("I'm afraid I don't know how to apply that operation to that")
+       ("combination of types. Continue, and I'll return the second")
+      ("argument (see above) as the result of the operation.");
+  mp_put_get_error(mp);
+}
+
+@ @<Trace the current binary operation@>=
+{ 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{(");
+  mp_print_exp(mp,p,0); /* show the operand, but not verbosely */
+  mp_print_char(mp,')'); mp_print_op(mp,c); mp_print_char(mp,'(');
+  mp_print_exp(mp,null,0); mp_print(mp,")}"); 
+  mp_end_diagnostic(mp, false);
+}
+
+@ Several of the binary operations are potentially complicated by the
+fact that |independent| values can sneak into capsules. For example,
+we've seen an instance of this difficulty in the unary operation
+of negation. In order to reduce the number of cases that need to be
+handled, we first change the two operands (if necessary)
+to rid them of |independent| components. The original operands are
+put into capsules called |old_p| and |old_exp|, which will be
+recycled after the binary operation has been safely carried out.
+
+@<Recycle any sidestepped |independent| capsules@>=
+if ( old_p!=null ) { 
+  mp_recycle_value(mp, old_p); mp_free_node(mp, old_p,value_node_size);
+}
+if ( old_exp!=null ) {
+  mp_recycle_value(mp, old_exp); mp_free_node(mp, old_exp,value_node_size);
+}
+
+@ A big node is considered to be ``tarnished'' if it contains at least one
+independent component. We will define a simple function called `|tarnished|'
+that returns |null| if and only if its argument is not tarnished.
+
+@<Sidestep |independent| cases in capsule |p|@>=
+switch (type(p)) {
+case mp_transform_type:
+case mp_color_type:
+case mp_cmykcolor_type:
+case mp_pair_type: 
+  old_p=mp_tarnished(mp, p);
+  break;
+case mp_independent: old_p=mp_void; break;
+default: old_p=null; break;
+}
+if ( old_p!=null ) {
+  q=mp_stash_cur_exp(mp); old_p=p; mp_make_exp_copy(mp, old_p);
+  p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q);
+}
+
+@ @<Sidestep |independent| cases in the current expression@>=
+switch (mp->cur_type) {
+case mp_transform_type:
+case mp_color_type:
+case mp_cmykcolor_type:
+case mp_pair_type: 
+  old_exp=mp_tarnished(mp, mp->cur_exp);
+  break;
+case mp_independent:old_exp=mp_void; break;
+default: old_exp=null; break;
+}
+if ( old_exp!=null ) {
+  old_exp=mp->cur_exp; mp_make_exp_copy(mp, old_exp);
+}
+
+@ @<Declare binary action...@>=
+pointer mp_tarnished (MP mp,pointer p) {
+  pointer q; /* beginning of the big node */
+  pointer r; /* current position in the big node */
+  q=value(p); r=q+mp->big_node_size[type(p)];
+  do {  
+   r=r-2;
+   if ( type(r)==mp_independent ) return mp_void; 
+  } while (r!=q);
+  return null;
+}
+
+@ @<Add or subtract the current expression from |p|@>=
+if ( (mp->cur_type<mp_color_type)||(type(p)<mp_color_type) ) {
+  mp_bad_binary(mp, p,c);
+} else  {
+  if ((mp->cur_type>mp_pair_type)&&(type(p)>mp_pair_type) ) {
+    mp_add_or_subtract(mp, p,null,c);
+  } else {
+    if ( mp->cur_type!=type(p) )  {
+      mp_bad_binary(mp, p,c);
+    } else { 
+      q=value(p); r=value(mp->cur_exp);
+      rr=r+mp->big_node_size[mp->cur_type];
+      while ( r<rr ) { 
+        mp_add_or_subtract(mp, q,r,c);
+        q=q+2; r=r+2;
+      }
+    }
+  }
+}
+
+@ The first argument to |add_or_subtract| is the location of a value node
+in a capsule or pair node that will soon be recycled. The second argument
+is either a location within a pair or transform node of |cur_exp|,
+or it is null (which means that |cur_exp| itself should be the second
+argument).  The third argument is either |plus| or |minus|.
+
+The sum or difference of the numeric quantities will replace the second
+operand.  Arithmetic overflow may go undetected; users aren't supposed to
+be monkeying around with really big values.
+@^overflow in arithmetic@>
+
+@<Declare binary action...@>=
+@<Declare the procedure called |dep_finish|@>
+void mp_add_or_subtract (MP mp,pointer p, pointer q, quarterword c) {
+  small_number s,t; /* operand types */
+  pointer r; /* list traverser */
+  integer v; /* second operand value */
+  if ( q==null ) { 
+    t=mp->cur_type;
+    if ( t<mp_dependent ) v=mp->cur_exp; else v=dep_list(mp->cur_exp);
+  } else { 
+    t=type(q);
+    if ( t<mp_dependent ) v=value(q); else v=dep_list(q);
+  }
+  if ( t==mp_known ) {
+    if ( c==minus ) negate(v);
+    if ( type(p)==mp_known ) {
+      v=mp_slow_add(mp, value(p),v);
+      if ( q==null ) mp->cur_exp=v; else value(q)=v;
+      return;
+    }
+    @<Add a known value to the constant term of |dep_list(p)|@>;
+  } else  { 
+    if ( c==minus ) mp_negate_dep_list(mp, v);
+    @<Add operand |p| to the dependency list |v|@>;
+  }
+}
+
+@ @<Add a known value to the constant term of |dep_list(p)|@>=
+r=dep_list(p);
+while ( info(r)!=null ) r=link(r);
+value(r)=mp_slow_add(mp, value(r),v);
+if ( q==null ) {
+  q=mp_get_node(mp, value_node_size); mp->cur_exp=q; mp->cur_type=type(p);
+  name_type(q)=mp_capsule;
+}
+dep_list(q)=dep_list(p); type(q)=type(p);
+prev_dep(q)=prev_dep(p); link(prev_dep(p))=q;
+type(p)=mp_known; /* this will keep the recycler from collecting non-garbage */
+
+@ We prefer |dependent| lists to |mp_proto_dependent| ones, because it is
+nice to retain the extra accuracy of |fraction| coefficients.
+But we have to handle both kinds, and mixtures too.
+
+@<Add operand |p| to the dependency list |v|@>=
+if ( type(p)==mp_known ) {
+  @<Add the known |value(p)| to the constant term of |v|@>;
+} else { 
+  s=type(p); r=dep_list(p);
+  if ( t==mp_dependent ) {
+    if ( s==mp_dependent ) {
+      if ( mp_max_coef(mp, r)+mp_max_coef(mp, v)<coef_bound )
+        v=mp_p_plus_q(mp, v,r,mp_dependent); goto DONE;
+      } /* |fix_needed| will necessarily be false */
+      t=mp_proto_dependent; 
+      v=mp_p_over_v(mp, v,unity,mp_dependent,mp_proto_dependent);
+    }
+    if ( s==mp_proto_dependent ) v=mp_p_plus_q(mp, v,r,mp_proto_dependent);
+    else v=mp_p_plus_fq(mp, v,unity,r,mp_proto_dependent,mp_dependent);
+ DONE:  
+    @<Output the answer, |v| (which might have become |known|)@>;
+  }
+
+@ @<Add the known |value(p)| to the constant term of |v|@>=
+{ 
+  while ( info(v)!=null ) v=link(v);
+  value(v)=mp_slow_add(mp, value(p),value(v));
+}
+
+@ @<Output the answer, |v| (which might have become |known|)@>=
+if ( q!=null ) mp_dep_finish(mp, v,q,t);
+else  { mp->cur_type=t; mp_dep_finish(mp, v,null,t); }
+
+@ Here's the current situation: The dependency list |v| of type |t|
+should either be put into the current expression (if |q=null|) or
+into location |q| within a pair node (otherwise). The destination (|cur_exp|
+or |q|) formerly held a dependency list with the same
+final pointer as the list |v|.
+
+@<Declare the procedure called |dep_finish|@>=
+void mp_dep_finish (MP mp, pointer v, pointer q, small_number t) {
+  pointer p; /* the destination */
+  scaled vv; /* the value, if it is |known| */
+  if ( q==null ) p=mp->cur_exp; else p=q;
+  dep_list(p)=v; type(p)=t;
+  if ( info(v)==null ) { 
+    vv=value(v);
+    if ( q==null ) { 
+      mp_flush_cur_exp(mp, vv);
+    } else  { 
+      mp_recycle_value(mp, p); type(q)=mp_known; value(q)=vv; 
+    }
+  } else if ( q==null ) {
+    mp->cur_type=t;
+  }
+  if ( mp->fix_needed ) mp_fix_dependencies(mp);
+}
+
+@ Let's turn now to the six basic relations of comparison.
+
+@<Additional cases of binary operators@>=
+case less_than: case less_or_equal: case greater_than:
+case greater_or_equal: case equal_to: case unequal_to:
+  check_arith; /* at this point |arith_error| should be |false|? */
+  if ( (mp->cur_type>mp_pair_type)&&(type(p)>mp_pair_type) ) {
+    mp_add_or_subtract(mp, p,null,minus); /* |cur_exp:=(p)-cur_exp| */
+  } else if ( mp->cur_type!=type(p) ) {
+    mp_bad_binary(mp, p,c); goto DONE; 
+  } else if ( mp->cur_type==mp_string_type ) {
+    mp_flush_cur_exp(mp, mp_str_vs_str(mp, value(p),mp->cur_exp));
+  } else if ((mp->cur_type==mp_unknown_string)||
+           (mp->cur_type==mp_unknown_boolean) ) {
+    @<Check if unknowns have been equated@>;
+  } else if ( (mp->cur_type<=mp_pair_type)&&(mp->cur_type>=mp_transform_type)) {
+    @<Reduce comparison of big nodes to comparison of scalars@>;
+  } else if ( mp->cur_type==mp_boolean_type ) {
+    mp_flush_cur_exp(mp, mp->cur_exp-value(p));
+  } else { 
+    mp_bad_binary(mp, p,c); goto DONE;
+  }
+  @<Compare the current expression with zero@>;
+DONE:  
+  mp->arith_error=false; /* ignore overflow in comparisons */
+  break;
+
+@ @<Compare the current expression with zero@>=
+if ( mp->cur_type!=mp_known ) {
+  if ( mp->cur_type<mp_known ) {
+    mp_disp_err(mp, p,"");
+    help1("The quantities shown above have not been equated.")
+  } else  {
+    help2("Oh dear. I can\'t decide if the expression above is positive,")
+     ("negative, or zero. So this comparison test won't be `true'.");
+  }
+  exp_err("Unknown relation will be considered false");
+@.Unknown relation...@>
+  mp_put_get_flush_error(mp, false_code);
+} else {
+  switch (c) {
+  case less_than: boolean_reset(mp->cur_exp<0); break;
+  case less_or_equal: boolean_reset(mp->cur_exp<=0); break;
+  case greater_than: boolean_reset(mp->cur_exp>0); break;
+  case greater_or_equal: boolean_reset(mp->cur_exp>=0); break;
+  case equal_to: boolean_reset(mp->cur_exp==0); break;
+  case unequal_to: boolean_reset(mp->cur_exp!=0); break;
+  }; /* there are no other cases */
+}
+mp->cur_type=mp_boolean_type
+
+@ When two unknown strings are in the same ring, we know that they are
+equal. Otherwise, we don't know whether they are equal or not, so we
+make no change.
+
+@<Check if unknowns have been equated@>=
+{ 
+  q=value(mp->cur_exp);
+  while ( (q!=mp->cur_exp)&&(q!=p) ) q=value(q);
+  if ( q==p ) mp_flush_cur_exp(mp, 0);
+}
+
+@ @<Reduce comparison of big nodes to comparison of scalars@>=
+{ 
+  q=value(p); r=value(mp->cur_exp);
+  rr=r+mp->big_node_size[mp->cur_type]-2;
+  while (1) { mp_add_or_subtract(mp, q,r,minus);
+    if ( type(r)!=mp_known ) break;
+    if ( value(r)!=0 ) break;
+    if ( r==rr ) break;
+    q=q+2; r=r+2;
+  }
+  mp_take_part(mp, name_type(r)+x_part-mp_x_part_sector);
+}
+
+@ Here we use the sneaky fact that |and_op-false_code=or_op-true_code|.
+
+@<Additional cases of binary operators@>=
+case and_op:
+case or_op: 
+  if ( (type(p)!=mp_boolean_type)||(mp->cur_type!=mp_boolean_type) )
+    mp_bad_binary(mp, p,c);
+  else if ( value(p)==c+false_code-and_op ) mp->cur_exp=value(p);
+  break;
+
+@ @<Additional cases of binary operators@>=
+case times: 
+  if ( (mp->cur_type<mp_color_type)||(type(p)<mp_color_type) ) {
+   mp_bad_binary(mp, p,times);
+  } else if ( (mp->cur_type==mp_known)||(type(p)==mp_known) ) {
+    @<Multiply when at least one operand is known@>;
+  } else if ( (mp_nice_color_or_pair(mp, p,type(p))&&(mp->cur_type>mp_pair_type))
+      ||(mp_nice_color_or_pair(mp, mp->cur_exp,mp->cur_type)&&
+          (type(p)>mp_pair_type)) ) {
+    mp_hard_times(mp, p); 
+    binary_return;
+  } else {
+    mp_bad_binary(mp, p,times);
+  }
+  break;
+
+@ @<Multiply when at least one operand is known@>=
+{ 
+  if ( type(p)==mp_known ) {
+    v=value(p); mp_free_node(mp, p,value_node_size); 
+  } else {
+    v=mp->cur_exp; mp_unstash_cur_exp(mp, p);
+  }
+  if ( mp->cur_type==mp_known ) {
+    mp->cur_exp=mp_take_scaled(mp, mp->cur_exp,v);
+  } else if ( (mp->cur_type==mp_pair_type)||
+              (mp->cur_type==mp_color_type)||
+              (mp->cur_type==mp_cmykcolor_type) ) {
+    p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type];
+    do {  
+       p=p-2; mp_dep_mult(mp, p,v,true);
+    } while (p!=value(mp->cur_exp));
+  } else {
+    mp_dep_mult(mp, null,v,true);
+  }
+  binary_return;
+}
+
+@ @<Declare binary action...@>=
+void mp_dep_mult (MP mp,pointer p, integer v, boolean v_is_scaled) {
+  pointer q; /* the dependency list being multiplied by |v| */
+  small_number s,t; /* its type, before and after */
+  if ( p==null ) {
+    q=mp->cur_exp;
+  } else if ( type(p)!=mp_known ) {
+    q=p;
+  } else { 
+    if ( v_is_scaled ) value(p)=mp_take_scaled(mp, value(p),v);
+    else value(p)=mp_take_fraction(mp, value(p),v);
+    return;
+  };
+  t=type(q); q=dep_list(q); s=t;
+  if ( t==mp_dependent ) if ( v_is_scaled )
+    if (mp_ab_vs_cd(mp, mp_max_coef(mp,q),abs(v),coef_bound-1,unity)>=0 ) 
+      t=mp_proto_dependent;
+  q=mp_p_times_v(mp, q,v,s,t,v_is_scaled); 
+  mp_dep_finish(mp, q,p,t);
+}
+
+@ Here is a routine that is similar to |times|; but it is invoked only
+internally, when |v| is a |fraction| whose magnitude is at most~1,
+and when |cur_type>=mp_color_type|.
+
+@c void mp_frac_mult (MP mp,scaled n, scaled d) {
+  /* multiplies |cur_exp| by |n/d| */
+  pointer p; /* a pair node */
+  pointer old_exp; /* a capsule to recycle */
+  fraction v; /* |n/d| */
+  if ( mp->internal[mp_tracing_commands]>two ) {
+    @<Trace the fraction multiplication@>;
+  }
+  switch (mp->cur_type) {
+  case mp_transform_type:
+  case mp_color_type:
+  case mp_cmykcolor_type:
+  case mp_pair_type:
+   old_exp=mp_tarnished(mp, mp->cur_exp);
+   break;
+  case mp_independent: old_exp=mp_void; break;
+  default: old_exp=null; break;
+  }
+  if ( old_exp!=null ) { 
+     old_exp=mp->cur_exp; mp_make_exp_copy(mp, old_exp);
+  }
+  v=mp_make_fraction(mp, n,d);
+  if ( mp->cur_type==mp_known ) {
+    mp->cur_exp=mp_take_fraction(mp, mp->cur_exp,v);
+  } else if ( mp->cur_type<=mp_pair_type ) { 
+    p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type];
+    do {  
+      p=p-2;
+      mp_dep_mult(mp, p,v,false);
+    } while (p!=value(mp->cur_exp));
+  } else {
+    mp_dep_mult(mp, null,v,false);
+  }
+  if ( old_exp!=null ) {
+    mp_recycle_value(mp, old_exp); 
+    mp_free_node(mp, old_exp,value_node_size);
+  }
+}
+
+@ @<Trace the fraction multiplication@>=
+{ 
+  mp_begin_diagnostic(mp); 
+  mp_print_nl(mp, "{("); mp_print_scaled(mp,n); mp_print_char(mp,'/');
+  mp_print_scaled(mp,d); mp_print(mp,")*("); mp_print_exp(mp,null,0); 
+  mp_print(mp,")}");
+  mp_end_diagnostic(mp, false);
+}
+
+@ The |hard_times| routine multiplies a nice color or pair by a dependency list.
+
+@<Declare binary action procedures@>=
+void mp_hard_times (MP mp,pointer p) {
+  pointer q; /* a copy of the dependent variable |p| */
+  pointer r; /* a component of the big node for the nice color or pair */
+  scaled v; /* the known value for |r| */
+  if ( type(p)<=mp_pair_type ) { 
+     q=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, p); p=q;
+  }; /* now |cur_type=mp_pair_type| or |cur_type=mp_color_type| */
+  r=value(mp->cur_exp)+mp->big_node_size[mp->cur_type];
+  while (1) { 
+    r=r-2;
+    v=value(r);
+    type(r)=type(p);
+    if ( r==value(mp->cur_exp) ) 
+      break;
+    mp_new_dep(mp, r,mp_copy_dep_list(mp, dep_list(p)));
+    mp_dep_mult(mp, r,v,true);
+  }
+  mp->mem[value_loc(r)]=mp->mem[value_loc(p)];
+  link(prev_dep(p))=r;
+  mp_free_node(mp, p,value_node_size);
+  mp_dep_mult(mp, r,v,true);
+}
+
+@ @<Additional cases of binary operators@>=
+case over: 
+  if ( (mp->cur_type!=mp_known)||(type(p)<mp_color_type) ) {
+    mp_bad_binary(mp, p,over);
+  } else { 
+    v=mp->cur_exp; mp_unstash_cur_exp(mp, p);
+    if ( v==0 ) {
+      @<Squeal about division by zero@>;
+    } else { 
+      if ( mp->cur_type==mp_known ) {
+        mp->cur_exp=mp_make_scaled(mp, mp->cur_exp,v);
+      } else if ( mp->cur_type<=mp_pair_type ) { 
+        p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type];
+        do {  
+          p=p-2;  mp_dep_div(mp, p,v);
+        } while (p!=value(mp->cur_exp));
+      } else {
+        mp_dep_div(mp, null,v);
+      }
+    }
+    binary_return;
+  }
+  break;
+
+@ @<Declare binary action...@>=
+void mp_dep_div (MP mp,pointer p, scaled v) {
+  pointer q; /* the dependency list being divided by |v| */
+  small_number s,t; /* its type, before and after */
+  if ( p==null ) q=mp->cur_exp;
+  else if ( type(p)!=mp_known ) q=p;
+  else { value(p)=mp_make_scaled(mp, value(p),v); return; };
+  t=type(q); q=dep_list(q); s=t;
+  if ( t==mp_dependent )
+    if ( mp_ab_vs_cd(mp, mp_max_coef(mp,q),unity,coef_bound-1,abs(v))>=0 ) 
+      t=mp_proto_dependent;
+  q=mp_p_over_v(mp, q,v,s,t); 
+  mp_dep_finish(mp, q,p,t);
+}
+
+@ @<Squeal about division by zero@>=
+{ 
+  exp_err("Division by zero");
+@.Division by zero@>
+  help2("You're trying to divide the quantity shown above the error")
+    ("message by zero. I'm going to divide it by one instead.");
+  mp_put_get_error(mp);
+}
+
+@ @<Additional cases of binary operators@>=
+case pythag_add:
+case pythag_sub: 
+   if ( (mp->cur_type==mp_known)&&(type(p)==mp_known) ) {
+     if ( c==pythag_add ) mp->cur_exp=mp_pyth_add(mp, value(p),mp->cur_exp);
+     else mp->cur_exp=mp_pyth_sub(mp, value(p),mp->cur_exp);
+   } else mp_bad_binary(mp, p,c);
+   break;
+
+@ The next few sections of the program deal with affine transformations
+of coordinate data.
+
+@<Additional cases of binary operators@>=
+case rotated_by: case slanted_by:
+case scaled_by: case shifted_by: case transformed_by:
+case x_scaled: case y_scaled: case z_scaled:
+  if ( type(p)==mp_path_type ) { 
+    path_trans(c,p); binary_return;
+  } else if ( type(p)==mp_pen_type ) { 
+    pen_trans(c,p);
+    mp->cur_exp=mp_convex_hull(mp, mp->cur_exp); 
+      /* rounding error could destroy convexity */
+    binary_return;
+  } else if ( (type(p)==mp_pair_type)||(type(p)==mp_transform_type) ) {
+    mp_big_trans(mp, p,c);
+  } else if ( type(p)==mp_picture_type ) {
+    mp_do_edges_trans(mp, p,c); binary_return;
+  } else {
+    mp_bad_binary(mp, p,c);
+  }
+  break;
+
+@ Let |c| be one of the eight transform operators. The procedure call
+|set_up_trans(c)| first changes |cur_exp| to a transform that corresponds to
+|c| and the original value of |cur_exp|. (In particular, |cur_exp| doesn't
+change at all if |c=transformed_by|.)
+
+Then, if all components of the resulting transform are |known|, they are
+moved to the global variables |txx|, |txy|, |tyx|, |tyy|, |tx|, |ty|;
+and |cur_exp| is changed to the known value zero.
+
+@<Declare binary action...@>=
+void mp_set_up_trans (MP mp,quarterword c) {
+  pointer p,q,r; /* list manipulation registers */
+  if ( (c!=transformed_by)||(mp->cur_type!=mp_transform_type) ) {
+    @<Put the current transform into |cur_exp|@>;
+  }
+  @<If the current transform is entirely known, stash it in global variables;
+    otherwise |return|@>;
+}
+
+@ @<Glob...@>=
+scaled txx;
+scaled txy;
+scaled tyx;
+scaled tyy;
+scaled tx;
+scaled ty; /* current transform coefficients */
+
+@ @<Put the current transform...@>=
+{ 
+  p=mp_stash_cur_exp(mp); 
+  mp->cur_exp=mp_id_transform(mp); 
+  mp->cur_type=mp_transform_type;
+  q=value(mp->cur_exp);
+  switch (c) {
+  @<For each of the eight cases, change the relevant fields of |cur_exp|
+    and |goto done|;
+    but do nothing if capsule |p| doesn't have the appropriate type@>;
+  }; /* there are no other cases */
+  mp_disp_err(mp, p,"Improper transformation argument");
+@.Improper transformation argument@>
+  help3("The expression shown above has the wrong type,")
+       ("so I can\'t transform anything using it.")
+       ("Proceed, and I'll omit the transformation.");
+  mp_put_get_error(mp);
+DONE: 
+  mp_recycle_value(mp, p); 
+  mp_free_node(mp, p,value_node_size);
+}
+
+@ @<If the current transform is entirely known, ...@>=
+q=value(mp->cur_exp); r=q+transform_node_size;
+do {  
+  r=r-2;
+  if ( type(r)!=mp_known ) return;
+} while (r!=q);
+mp->txx=value(xx_part_loc(q));
+mp->txy=value(xy_part_loc(q));
+mp->tyx=value(yx_part_loc(q));
+mp->tyy=value(yy_part_loc(q));
+mp->tx=value(x_part_loc(q));
+mp->ty=value(y_part_loc(q));
+mp_flush_cur_exp(mp, 0)
+
+@ @<For each of the eight cases...@>=
+case rotated_by:
+  if ( type(p)==mp_known )
+    @<Install sines and cosines, then |goto done|@>;
+  break;
+case slanted_by:
+  if ( type(p)>mp_pair_type ) { 
+   mp_install(mp, xy_part_loc(q),p); goto DONE;
+  };
+  break;
+case scaled_by:
+  if ( type(p)>mp_pair_type ) { 
+    mp_install(mp, xx_part_loc(q),p); mp_install(mp, yy_part_loc(q),p); 
+    goto DONE;
+  };
+  break;
+case shifted_by:
+  if ( type(p)==mp_pair_type ) {
+    r=value(p); mp_install(mp, x_part_loc(q),x_part_loc(r));
+    mp_install(mp, y_part_loc(q),y_part_loc(r)); goto DONE;
+  };
+  break;
+case x_scaled:
+  if ( type(p)>mp_pair_type ) {
+    mp_install(mp, xx_part_loc(q),p); goto DONE;
+  };
+  break;
+case y_scaled:
+  if ( type(p)>mp_pair_type ) {
+    mp_install(mp, yy_part_loc(q),p); goto DONE;
+  };
+  break;
+case z_scaled:
+  if ( type(p)==mp_pair_type )
+    @<Install a complex multiplier, then |goto done|@>;
+  break;
+case transformed_by:
+  break;
+  
+
+@ @<Install sines and cosines, then |goto done|@>=
+{ mp_n_sin_cos(mp, (value(p) % three_sixty_units)*16);
+  value(xx_part_loc(q))=mp_round_fraction(mp, mp->n_cos);
+  value(yx_part_loc(q))=mp_round_fraction(mp, mp->n_sin);
+  value(xy_part_loc(q))=-value(yx_part_loc(q));
+  value(yy_part_loc(q))=value(xx_part_loc(q));
+  goto DONE;
+}
+
+@ @<Install a complex multiplier, then |goto done|@>=
+{ 
+  r=value(p);
+  mp_install(mp, xx_part_loc(q),x_part_loc(r));
+  mp_install(mp, yy_part_loc(q),x_part_loc(r));
+  mp_install(mp, yx_part_loc(q),y_part_loc(r));
+  if ( type(y_part_loc(r))==mp_known ) negate(value(y_part_loc(r)));
+  else mp_negate_dep_list(mp, dep_list(y_part_loc(r)));
+  mp_install(mp, xy_part_loc(q),y_part_loc(r));
+  goto DONE;
+}
+
+@ Procedure |set_up_known_trans| is like |set_up_trans|, but it
+insists that the transformation be entirely known.
+
+@<Declare binary action...@>=
+void mp_set_up_known_trans (MP mp,quarterword c) { 
+  mp_set_up_trans(mp, c);
+  if ( mp->cur_type!=mp_known ) {
+    exp_err("Transform components aren't all known");
+@.Transform components...@>
+    help3("I'm unable to apply a partially specified transformation")
+      ("except to a fully known pair or transform.")
+      ("Proceed, and I'll omit the transformation.");
+    mp_put_get_flush_error(mp, 0);
+    mp->txx=unity; mp->txy=0; mp->tyx=0; mp->tyy=unity; 
+    mp->tx=0; mp->ty=0;
+  }
+}
+
+@ Here's a procedure that applies the transform |txx..ty| to a pair of
+coordinates in locations |p| and~|q|.
+
+@<Declare binary action...@>= 
+void mp_trans (MP mp,pointer p, pointer q) {
+  scaled v; /* the new |x| value */
+  v=mp_take_scaled(mp, mp->mem[p].sc,mp->txx)+
+  mp_take_scaled(mp, mp->mem[q].sc,mp->txy)+mp->tx;
+  mp->mem[q].sc=mp_take_scaled(mp, mp->mem[p].sc,mp->tyx)+
+  mp_take_scaled(mp, mp->mem[q].sc,mp->tyy)+mp->ty;
+  mp->mem[p].sc=v;
+}
+
+@ The simplest transformation procedure applies a transform to all
+coordinates of a path.  The |path_trans(c)(p)| macro applies
+a transformation defined by |cur_exp| and the transform operator |c|
+to the path~|p|.
+
+@d path_trans(A,B) { mp_set_up_known_trans(mp, (A)); 
+                     mp_unstash_cur_exp(mp, (B)); 
+                     mp_do_path_trans(mp, mp->cur_exp); }
+
+@<Declare binary action...@>=
+void mp_do_path_trans (MP mp,pointer p) {
+  pointer q; /* list traverser */
+  q=p;
+  do { 
+    if ( left_type(q)!=mp_endpoint ) 
+      mp_trans(mp, q+3,q+4); /* that's |left_x| and |left_y| */
+    mp_trans(mp, q+1,q+2); /* that's |x_coord| and |y_coord| */
+    if ( right_type(q)!=mp_endpoint ) 
+      mp_trans(mp, q+5,q+6); /* that's |right_x| and |right_y| */
+@^data structure assumptions@>
+    q=link(q);
+  } while (q!=p);
+}
+
+@ Transforming a pen is very similar, except that there are no |left_type|
+and |right_type| fields.
+
+@d pen_trans(A,B) { mp_set_up_known_trans(mp, (A)); 
+                    mp_unstash_cur_exp(mp, (B)); 
+                    mp_do_pen_trans(mp, mp->cur_exp); }
+
+@<Declare binary action...@>=
+void mp_do_pen_trans (MP mp,pointer p) {
+  pointer q; /* list traverser */
+  if ( pen_is_elliptical(p) ) {
+    mp_trans(mp, p+3,p+4); /* that's |left_x| and |left_y| */
+    mp_trans(mp, p+5,p+6); /* that's |right_x| and |right_y| */
+  };
+  q=p;
+  do { 
+    mp_trans(mp, q+1,q+2); /* that's |x_coord| and |y_coord| */
+@^data structure assumptions@>
+    q=link(q);
+  } while (q!=p);
+}
+
+@ The next transformation procedure applies to edge structures. It will do
+any transformation, but the results may be substandard if the picture contains
+text that uses downloaded bitmap fonts.  The binary action procedure is
+|do_edges_trans|, but we also need a function that just scales a picture.
+That routine is |scale_edges|.  Both it and the underlying routine |edges_trans|
+should be thought of as procedures that update an edge structure |h|, except
+that they have to return a (possibly new) structure because of the need to call
+|private_edges|.
+
+@<Declare binary action...@>=
+pointer mp_edges_trans (MP mp, pointer h) {
+  pointer q; /* the object being transformed */
+  pointer r,s; /* for list manipulation */
+  scaled sx,sy; /* saved transformation parameters */
+  scaled sqdet; /* square root of determinant for |dash_scale| */
+  integer sgndet; /* sign of the determinant */
+  scaled v; /* a temporary value */
+  h=mp_private_edges(mp, h);
+  sqdet=mp_sqrt_det(mp, mp->txx,mp->txy,mp->tyx,mp->tyy);
+  sgndet=mp_ab_vs_cd(mp, mp->txx,mp->tyy,mp->txy,mp->tyx);
+  if ( dash_list(h)!=null_dash ) {
+    @<Try to transform the dash list of |h|@>;
+  }
+  @<Make the bounding box of |h| unknown if it can't be updated properly
+    without scanning the whole structure@>;  
+  q=link(dummy_loc(h));
+  while ( q!=null ) { 
+    @<Transform graphical object |q|@>;
+    q=link(q);
+  }
+  return h;
+}
+void mp_do_edges_trans (MP mp,pointer p, quarterword c) { 
+  mp_set_up_known_trans(mp, c);
+  value(p)=mp_edges_trans(mp, value(p));
+  mp_unstash_cur_exp(mp, p);
+}
+void mp_scale_edges (MP mp) { 
+  mp->txx=mp->se_sf; mp->tyy=mp->se_sf;
+  mp->txy=0; mp->tyx=0; mp->tx=0; mp->ty=0;
+  mp->se_pic=mp_edges_trans(mp, mp->se_pic);
+}
+
+@ @<Try to transform the dash list of |h|@>=
+if ( (mp->txy!=0)||(mp->tyx!=0)||
+     (mp->ty!=0)||(abs(mp->txx)!=abs(mp->tyy))) {
+  mp_flush_dash_list(mp, h);
+} else { 
+  if ( mp->txx<0 ) { @<Reverse the dash list of |h|@>; } 
+  @<Scale the dash list by |txx| and shift it by |tx|@>;
+  dash_y(h)=mp_take_scaled(mp, dash_y(h),abs(mp->tyy));
+}
+
+@ @<Reverse the dash list of |h|@>=
+{ 
+  r=dash_list(h);
+  dash_list(h)=null_dash;
+  while ( r!=null_dash ) {
+    s=r; r=link(r);
+    v=start_x(s); start_x(s)=stop_x(s); stop_x(s)=v;
+    link(s)=dash_list(h);
+    dash_list(h)=s;
+  }
+}
+
+@ @<Scale the dash list by |txx| and shift it by |tx|@>=
+r=dash_list(h);
+while ( r!=null_dash ) {
+  start_x(r)=mp_take_scaled(mp, start_x(r),mp->txx)+mp->tx;
+  stop_x(r)=mp_take_scaled(mp, stop_x(r),mp->txx)+mp->tx;
+  r=link(r);
+}
+
+@ @<Make the bounding box of |h| unknown if it can't be updated properly...@>=
+if ( (mp->txx==0)&&(mp->tyy==0) ) {
+  @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>;
+} else if ( (mp->txy!=0)||(mp->tyx!=0) ) {
+  mp_init_bbox(mp, h);
+  goto DONE1;
+}
+if ( minx_val(h)<=maxx_val(h) ) {
+  @<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift by
+   |(tx,ty)|@>;
+}
+DONE1:
+
+
+
+@ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>=
+{ 
+  v=minx_val(h); minx_val(h)=miny_val(h); miny_val(h)=v;
+  v=maxx_val(h); maxx_val(h)=maxy_val(h); maxy_val(h)=v;
+}
+
+@ The sum ``|txx+txy|'' is whichever of |txx| or |txy| is nonzero.  The other
+sum is similar.
+
+@<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift...@>=
+{ 
+  minx_val(h)=mp_take_scaled(mp, minx_val(h),mp->txx+mp->txy)+mp->tx;
+  maxx_val(h)=mp_take_scaled(mp, maxx_val(h),mp->txx+mp->txy)+mp->tx;
+  miny_val(h)=mp_take_scaled(mp, miny_val(h),mp->tyx+mp->tyy)+mp->ty;
+  maxy_val(h)=mp_take_scaled(mp, maxy_val(h),mp->tyx+mp->tyy)+mp->ty;
+  if ( mp->txx+mp->txy<0 ) {
+    v=minx_val(h); minx_val(h)=maxx_val(h); maxx_val(h)=v;
+  }
+  if ( mp->tyx+mp->tyy<0 ) {
+    v=miny_val(h); miny_val(h)=maxy_val(h); maxy_val(h)=v;
+  }
+}
+
+@ Now we ready for the main task of transforming the graphical objects in edge
+structure~|h|.
+
+@<Transform graphical object |q|@>=
+switch (type(q)) {
+case mp_fill_code: case mp_stroked_code: 
+  mp_do_path_trans(mp, path_p(q));
+  @<Transform |pen_p(q)|, making sure polygonal pens stay counter-clockwise@>;
+  break;
+case mp_start_clip_code: case mp_start_bounds_code: 
+  mp_do_path_trans(mp, path_p(q));
+  break;
+case mp_text_code: 
+  r=text_tx_loc(q);
+  @<Transform the compact transformation starting at |r|@>;
+  break;
+case mp_stop_clip_code: case mp_stop_bounds_code: 
+  break;
+} /* there are no other cases */
+
+@ Note that the shift parameters |(tx,ty)| apply only to the path being stroked.
+The |dash_scale| has to be adjusted  to scale the dash lengths in |dash_p(q)|
+since the \ps\ output procedures will try to compensate for the transformation
+we are applying to |pen_p(q)|.  Since this compensation is based on the square
+root of the determinant, |sqdet| is the appropriate factor.
+
+@<Transform |pen_p(q)|, making sure...@>=
+if ( pen_p(q)!=null ) {
+  sx=mp->tx; sy=mp->ty;
+  mp->tx=0; mp->ty=0;
+  mp_do_pen_trans(mp, pen_p(q));
+  if ( ((type(q)==mp_stroked_code)&&(dash_p(q)!=null)) )
+    dash_scale(q)=mp_take_scaled(mp, dash_scale(q),sqdet);
+  if ( ! pen_is_elliptical(pen_p(q)) )
+    if ( sgndet<0 )
+      pen_p(q)=mp_make_pen(mp, mp_copy_path(mp, pen_p(q)),true); 
+         /* this unreverses the pen */
+  mp->tx=sx; mp->ty=sy;
+}
+
+@ This uses the fact that transformations are stored in the order
+|(tx,ty,txx,txy,tyx,tyy)|.
+@^data structure assumptions@>
+
+@<Transform the compact transformation starting at |r|@>=
+mp_trans(mp, r,r+1);
+sx=mp->tx; sy=mp->ty;
+mp->tx=0; mp->ty=0;
+mp_trans(mp, r+2,r+4);
+mp_trans(mp, r+3,r+5);
+mp->tx=sx; mp->ty=sy
+
+@ The hard cases of transformation occur when big nodes are involved,
+and when some of their components are unknown.
+
+@<Declare binary action...@>=
+@<Declare subroutines needed by |big_trans|@>
+void mp_big_trans (MP mp,pointer p, quarterword c) {
+  pointer q,r,pp,qq; /* list manipulation registers */
+  small_number s; /* size of a big node */
+  s=mp->big_node_size[type(p)]; q=value(p); r=q+s;
+  do {  
+    r=r-2;
+    if ( type(r)!=mp_known ) {
+      @<Transform an unknown big node and |return|@>;
+    }
+  } while (r!=q);
+  @<Transform a known big node@>;
+} /* node |p| will now be recycled by |do_binary| */
+
+@ @<Transform an unknown big node and |return|@>=
+{ 
+  mp_set_up_known_trans(mp, c); mp_make_exp_copy(mp, p); 
+  r=value(mp->cur_exp);
+  if ( mp->cur_type==mp_transform_type ) {
+    mp_bilin1(mp, yy_part_loc(r),mp->tyy,xy_part_loc(q),mp->tyx,0);
+    mp_bilin1(mp, yx_part_loc(r),mp->tyy,xx_part_loc(q),mp->tyx,0);
+    mp_bilin1(mp, xy_part_loc(r),mp->txx,yy_part_loc(q),mp->txy,0);
+    mp_bilin1(mp, xx_part_loc(r),mp->txx,yx_part_loc(q),mp->txy,0);
+  }
+  mp_bilin1(mp, y_part_loc(r),mp->tyy,x_part_loc(q),mp->tyx,mp->ty);
+  mp_bilin1(mp, x_part_loc(r),mp->txx,y_part_loc(q),mp->txy,mp->tx);
+  return;
+}
+
+@ Let |p| point to a two-word value field inside a big node of |cur_exp|,
+and let |q| point to a another value field. The |bilin1| procedure
+replaces |p| by $p\cdot t+q\cdot u+\delta$.
+
+@<Declare subroutines needed by |big_trans|@>=
+void mp_bilin1 (MP mp, pointer p, scaled t, pointer q, 
+                scaled u, scaled delta) {
+  pointer r; /* list traverser */
+  if ( t!=unity ) mp_dep_mult(mp, p,t,true);
+  if ( u!=0 ) {
+    if ( type(q)==mp_known ) {
+      delta+=mp_take_scaled(mp, value(q),u);
+    } else { 
+      @<Ensure that |type(p)=mp_proto_dependent|@>;
+      dep_list(p)=mp_p_plus_fq(mp, dep_list(p),u,dep_list(q),
+                               mp_proto_dependent,type(q));
+    }
+  }
+  if ( type(p)==mp_known ) {
+    value(p)+=delta;
+  } else {
+    r=dep_list(p);
+    while ( info(r)!=null ) r=link(r);
+    delta+=value(r);
+    if ( r!=dep_list(p) ) value(r)=delta;
+    else { mp_recycle_value(mp, p); type(p)=mp_known; value(p)=delta; };
+  }
+  if ( mp->fix_needed ) mp_fix_dependencies(mp);
+}
+
+@ @<Ensure that |type(p)=mp_proto_dependent|@>=
+if ( type(p)!=mp_proto_dependent ) {
+  if ( type(p)==mp_known ) 
+    mp_new_dep(mp, p,mp_const_dependency(mp, value(p)));
+  else 
+    dep_list(p)=mp_p_times_v(mp, dep_list(p),unity,mp_dependent,
+                             mp_proto_dependent,true);
+  type(p)=mp_proto_dependent;
+}
+
+@ @<Transform a known big node@>=
+mp_set_up_trans(mp, c);
+if ( mp->cur_type==mp_known ) {
+  @<Transform known by known@>;
+} else { 
+  pp=mp_stash_cur_exp(mp); qq=value(pp);
+  mp_make_exp_copy(mp, p); r=value(mp->cur_exp);
+  if ( mp->cur_type==mp_transform_type ) {
+    mp_bilin2(mp, yy_part_loc(r),yy_part_loc(qq),
+      value(xy_part_loc(q)),yx_part_loc(qq),null);
+    mp_bilin2(mp, yx_part_loc(r),yy_part_loc(qq),
+      value(xx_part_loc(q)),yx_part_loc(qq),null);
+    mp_bilin2(mp, xy_part_loc(r),xx_part_loc(qq),
+      value(yy_part_loc(q)),xy_part_loc(qq),null);
+    mp_bilin2(mp, xx_part_loc(r),xx_part_loc(qq),
+      value(yx_part_loc(q)),xy_part_loc(qq),null);
+  };
+  mp_bilin2(mp, y_part_loc(r),yy_part_loc(qq),
+    value(x_part_loc(q)),yx_part_loc(qq),y_part_loc(qq));
+  mp_bilin2(mp, x_part_loc(r),xx_part_loc(qq),
+    value(y_part_loc(q)),xy_part_loc(qq),x_part_loc(qq));
+  mp_recycle_value(mp, pp); mp_free_node(mp, pp,value_node_size);
+}
+
+@ Let |p| be a |mp_proto_dependent| value whose dependency list ends
+at |dep_final|. The following procedure adds |v| times another
+numeric quantity to~|p|.
+
+@<Declare subroutines needed by |big_trans|@>=
+void mp_add_mult_dep (MP mp,pointer p, scaled v, pointer r) { 
+  if ( type(r)==mp_known ) {
+    value(mp->dep_final)+=mp_take_scaled(mp, value(r),v);
+  } else  { 
+    dep_list(p)=mp_p_plus_fq(mp, dep_list(p),v,dep_list(r),
+							 mp_proto_dependent,type(r));
+    if ( mp->fix_needed ) mp_fix_dependencies(mp);
+  }
+}
+
+@ The |bilin2| procedure is something like |bilin1|, but with known
+and unknown quantities reversed. Parameter |p| points to a value field
+within the big node for |cur_exp|; and |type(p)=mp_known|. Parameters
+|t| and~|u| point to value fields elsewhere; so does parameter~|q|,
+unless it is |null| (which stands for zero). Location~|p| will be
+replaced by $p\cdot t+v\cdot u+q$.
+
+@<Declare subroutines needed by |big_trans|@>=
+void mp_bilin2 (MP mp,pointer p, pointer t, scaled v, 
+                pointer u, pointer q) {
+  scaled vv; /* temporary storage for |value(p)| */
+  vv=value(p); type(p)=mp_proto_dependent;
+  mp_new_dep(mp, p,mp_const_dependency(mp, 0)); /* this sets |dep_final| */
+  if ( vv!=0 ) 
+    mp_add_mult_dep(mp, p,vv,t); /* |dep_final| doesn't change */
+  if ( v!=0 ) mp_add_mult_dep(mp, p,v,u);
+  if ( q!=null ) mp_add_mult_dep(mp, p,unity,q);
+  if ( dep_list(p)==mp->dep_final ) {
+    vv=value(mp->dep_final); mp_recycle_value(mp, p);
+    type(p)=mp_known; value(p)=vv;
+  }
+}
+
+@ @<Transform known by known@>=
+{ 
+  mp_make_exp_copy(mp, p); r=value(mp->cur_exp);
+  if ( mp->cur_type==mp_transform_type ) {
+    mp_bilin3(mp, yy_part_loc(r),mp->tyy,value(xy_part_loc(q)),mp->tyx,0);
+    mp_bilin3(mp, yx_part_loc(r),mp->tyy,value(xx_part_loc(q)),mp->tyx,0);
+    mp_bilin3(mp, xy_part_loc(r),mp->txx,value(yy_part_loc(q)),mp->txy,0);
+    mp_bilin3(mp, xx_part_loc(r),mp->txx,value(yx_part_loc(q)),mp->txy,0);
+  }
+  mp_bilin3(mp, y_part_loc(r),mp->tyy,value(x_part_loc(q)),mp->tyx,mp->ty);
+  mp_bilin3(mp, x_part_loc(r),mp->txx,value(y_part_loc(q)),mp->txy,mp->tx);
+}
+
+@ Finally, in |bilin3| everything is |known|.
+
+@<Declare subroutines needed by |big_trans|@>=
+void mp_bilin3 (MP mp,pointer p, scaled t, 
+               scaled v, scaled u, scaled delta) { 
+  if ( t!=unity )
+    delta+=mp_take_scaled(mp, value(p),t);
+  else 
+    delta+=value(p);
+  if ( u!=0 ) value(p)=delta+mp_take_scaled(mp, v,u);
+  else value(p)=delta;
+}
+
+@ @<Additional cases of binary operators@>=
+case concatenate: 
+  if ( (mp->cur_type==mp_string_type)&&(type(p)==mp_string_type) ) mp_cat(mp, p);
+  else mp_bad_binary(mp, p,concatenate);
+  break;
+case substring_of: 
+  if ( mp_nice_pair(mp, p,type(p))&&(mp->cur_type==mp_string_type) )
+    mp_chop_string(mp, value(p));
+  else mp_bad_binary(mp, p,substring_of);
+  break;
+case subpath_of: 
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( mp_nice_pair(mp, p,type(p))&&(mp->cur_type==mp_path_type) )
+    mp_chop_path(mp, value(p));
+  else mp_bad_binary(mp, p,subpath_of);
+  break;
+
+@ @<Declare binary action...@>=
+void mp_cat (MP mp,pointer p) {
+  str_number a,b; /* the strings being concatenated */
+  pool_pointer k; /* index into |str_pool| */
+  a=value(p); b=mp->cur_exp; str_room(length(a)+length(b));
+  for (k=mp->str_start[a];k<=str_stop(a)-1;k++) {
+    append_char(mp->str_pool[k]);
+  }
+  for (k=mp->str_start[b];k<=str_stop(b)-1;k++) {
+    append_char(mp->str_pool[k]);
+  }
+  mp->cur_exp=mp_make_string(mp); delete_str_ref(b);
+}
+
+@ @<Declare binary action...@>=
+void mp_chop_string (MP mp,pointer p) {
+  integer a, b; /* start and stop points */
+  integer l; /* length of the original string */
+  integer k; /* runs from |a| to |b| */
+  str_number s; /* the original string */
+  boolean reversed; /* was |a>b|? */
+  a=mp_round_unscaled(mp, value(x_part_loc(p)));
+  b=mp_round_unscaled(mp, value(y_part_loc(p)));
+  if ( a<=b ) reversed=false;
+  else  { reversed=true; k=a; a=b; b=k; };
+  s=mp->cur_exp; l=length(s);
+  if ( a<0 ) { 
+    a=0;
+    if ( b<0 ) b=0;
+  }
+  if ( b>l ) { 
+    b=l;
+    if ( a>l ) a=l;
+  }
+  str_room(b-a);
+  if ( reversed ) {
+    for (k=mp->str_start[s]+b-1;k>=mp->str_start[s]+a;k--)  {
+      append_char(mp->str_pool[k]);
+    }
+  } else  {
+    for (k=mp->str_start[s]+a;k<=mp->str_start[s]+b-1;k++)  {
+      append_char(mp->str_pool[k]);
+    }
+  }
+  mp->cur_exp=mp_make_string(mp); delete_str_ref(s);
+}
+
+@ @<Declare binary action...@>=
+void mp_chop_path (MP mp,pointer p) {
+  pointer q; /* a knot in the original path */
+  pointer pp,qq,rr,ss; /* link variables for copies of path nodes */
+  scaled a,b,k,l; /* indices for chopping */
+  boolean reversed; /* was |a>b|? */
+  l=mp_path_length(mp); a=value(x_part_loc(p)); b=value(y_part_loc(p));
+  if ( a<=b ) reversed=false;
+  else  { reversed=true; k=a; a=b; b=k; };
+  @<Dispense with the cases |a<0| and/or |b>l|@>;
+  q=mp->cur_exp;
+  while ( a>=unity ) {
+    q=link(q); a=a-unity; b=b-unity;
+  }
+  if ( b==a ) {
+    @<Construct a path from |pp| to |qq| of length zero@>; 
+  } else { 
+    @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>; 
+  }
+  left_type(pp)=mp_endpoint; right_type(qq)=mp_endpoint; link(qq)=pp;
+  mp_toss_knot_list(mp, mp->cur_exp);
+  if ( reversed ) {
+    mp->cur_exp=link(mp_htap_ypoc(mp, pp)); mp_toss_knot_list(mp, pp);
+  } else {
+    mp->cur_exp=pp;
+  }
+}
+
+@ @<Dispense with the cases |a<0| and/or |b>l|@>=
+if ( a<0 ) {
+  if ( left_type(mp->cur_exp)==mp_endpoint ) {
+    a=0; if ( b<0 ) b=0;
+  } else  {
+    do {  a=a+l; b=b+l; } while (a<0); /* a cycle always has length |l>0| */
+  }
+}
+if ( b>l ) {
+  if ( left_type(mp->cur_exp)==mp_endpoint ) {
+    b=l; if ( a>l ) a=l;
+  } else {
+    while ( a>=l ) { 
+      a=a-l; b=b-l;
+    }
+  }
+}
+
+@ @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>=
+{ 
+  pp=mp_copy_knot(mp, q); qq=pp;
+  do {  
+    q=link(q); rr=qq; qq=mp_copy_knot(mp, q); link(rr)=qq; b=b-unity;
+  } while (b>0);
+  if ( a>0 ) {
+    ss=pp; pp=link(pp);
+    mp_split_cubic(mp, ss,a*010000); pp=link(ss);
+    mp_free_node(mp, ss,knot_node_size);
+    if ( rr==ss ) {
+      b=mp_make_scaled(mp, b,unity-a); rr=pp;
+    }
+  }
+  if ( b<0 ) {
+    mp_split_cubic(mp, rr,(b+unity)*010000);
+    mp_free_node(mp, qq,knot_node_size);
+    qq=link(rr);
+  }
+}
+
+@ @<Construct a path from |pp| to |qq| of length zero@>=
+{ 
+  if ( a>0 ) { mp_split_cubic(mp, q,a*010000); q=link(q); };
+  pp=mp_copy_knot(mp, q); qq=pp;
+}
+
+@ @<Additional cases of binary operators@>=
+case point_of: case precontrol_of: case postcontrol_of: 
+  if ( mp->cur_type==mp_pair_type )
+     mp_pair_to_path(mp);
+  if ( (mp->cur_type==mp_path_type)&&(type(p)==mp_known) )
+    mp_find_point(mp, value(p),c);
+  else 
+    mp_bad_binary(mp, p,c);
+  break;
+case pen_offset_of: 
+  if ( (mp->cur_type==mp_pen_type)&& mp_nice_pair(mp, p,type(p)) )
+    mp_set_up_offset(mp, value(p));
+  else 
+    mp_bad_binary(mp, p,pen_offset_of);
+  break;
+case direction_time_of: 
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( (mp->cur_type==mp_path_type)&& mp_nice_pair(mp, p,type(p)) )
+    mp_set_up_direction_time(mp, value(p));
+  else 
+    mp_bad_binary(mp, p,direction_time_of);
+  break;
+case envelope_of:
+  if ( (type(p) != mp_pen_type) || (mp->cur_type != mp_path_type) )
+    mp_bad_binary(mp, p,envelope_of);
+  else
+    mp_set_up_envelope(mp, p);
+  break;
+
+@ @<Declare binary action...@>=
+void mp_set_up_offset (MP mp,pointer p) { 
+  mp_find_offset(mp, value(x_part_loc(p)),value(y_part_loc(p)),mp->cur_exp);
+  mp_pair_value(mp, mp->cur_x,mp->cur_y);
+}
+void mp_set_up_direction_time (MP mp,pointer p) { 
+  mp_flush_cur_exp(mp, mp_find_direction_time(mp, value(x_part_loc(p)),
+  value(y_part_loc(p)),mp->cur_exp));
+}
+void mp_set_up_envelope (MP mp,pointer p) {
+  small_number ljoin, lcap;
+  scaled miterlim;
+  pointer q = mp_copy_path(mp, mp->cur_exp); /* the original path */
+  /* TODO: accept elliptical pens for straight paths */
+  if (pen_is_elliptical(value(p))) {
+    mp_bad_envelope_pen(mp);
+    mp->cur_exp = q;
+    mp->cur_type = mp_path_type;
+    return;
+  }
+  if ( mp->internal[mp_linejoin]>unity ) ljoin=2;
+  else if ( mp->internal[mp_linejoin]>0 ) ljoin=1;
+  else ljoin=0;
+  if ( mp->internal[mp_linecap]>unity ) lcap=2;
+  else if ( mp->internal[mp_linecap]>0 ) lcap=1;
+  else lcap=0;
+  if ( mp->internal[mp_miterlimit]<unity )
+    miterlim=unity;
+  else
+    miterlim=mp->internal[mp_miterlimit];
+  mp->cur_exp = mp_make_envelope(mp, q, value(p), ljoin,lcap,miterlim);
+  mp->cur_type = mp_path_type;
+}
+
+@ @<Declare binary action...@>=
+void mp_find_point (MP mp,scaled v, quarterword c) {
+  pointer p; /* the path */
+  scaled n; /* its length */
+  p=mp->cur_exp;
+  if ( left_type(p)==mp_endpoint ) n=-unity; else n=0;
+  do {  p=link(p); n=n+unity; } while (p!=mp->cur_exp);
+  if ( n==0 ) { 
+    v=0; 
+  } else if ( v<0 ) {
+    if ( left_type(p)==mp_endpoint ) v=0;
+    else v=n-1-((-v-1) % n);
+  } else if ( v>n ) {
+    if ( left_type(p)==mp_endpoint ) v=n;
+    else v=v % n;
+  }
+  p=mp->cur_exp;
+  while ( v>=unity ) { p=link(p); v=v-unity;  };
+  if ( v!=0 ) {
+     @<Insert a fractional node by splitting the cubic@>;
+  }
+  @<Set the current expression to the desired path coordinates@>;
+}
+
+@ @<Insert a fractional node...@>=
+{ mp_split_cubic(mp, p,v*010000); p=link(p); }
+
+@ @<Set the current expression to the desired path coordinates...@>=
+switch (c) {
+case point_of: 
+  mp_pair_value(mp, x_coord(p),y_coord(p));
+  break;
+case precontrol_of: 
+  if ( left_type(p)==mp_endpoint ) mp_pair_value(mp, x_coord(p),y_coord(p));
+  else mp_pair_value(mp, left_x(p),left_y(p));
+  break;
+case postcontrol_of: 
+  if ( right_type(p)==mp_endpoint ) mp_pair_value(mp, x_coord(p),y_coord(p));
+  else mp_pair_value(mp, right_x(p),right_y(p));
+  break;
+} /* there are no other cases */
+
+@ @<Additional cases of binary operators@>=
+case arc_time_of: 
+  if ( mp->cur_type==mp_pair_type )
+     mp_pair_to_path(mp);
+  if ( (mp->cur_type==mp_path_type)&&(type(p)==mp_known) )
+    mp_flush_cur_exp(mp, mp_get_arc_time(mp, mp->cur_exp,value(p)));
+  else 
+    mp_bad_binary(mp, p,c);
+  break;
+
+@ @<Additional cases of bin...@>=
+case intersect: 
+  if ( type(p)==mp_pair_type ) {
+    q=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, p);
+    mp_pair_to_path(mp); p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q);
+  };
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( (mp->cur_type==mp_path_type)&&(type(p)==mp_path_type) ) {
+    mp_path_intersection(mp, value(p),mp->cur_exp);
+    mp_pair_value(mp, mp->cur_t,mp->cur_tt);
+  } else {
+    mp_bad_binary(mp, p,intersect);
+  }
+  break;
+
+@ @<Additional cases of bin...@>=
+case in_font:
+  if ( (mp->cur_type!=mp_string_type)||(type(p)!=mp_string_type)) 
+    mp_bad_binary(mp, p,in_font);
+  else { mp_do_infont(mp, p); binary_return; }
+  break;
+
+@ Function |new_text_node| owns the reference count for its second argument
+(the text string) but not its first (the font name).
+
+@<Declare binary action...@>=
+void mp_do_infont (MP mp,pointer p) {
+  pointer q;
+  q=mp_get_node(mp, edge_header_size);
+  mp_init_edges(mp, q);
+  link(obj_tail(q))=mp_new_text_node(mp,str(mp->cur_exp),value(p));
+  obj_tail(q)=link(obj_tail(q));
+  mp_free_node(mp, p,value_node_size);
+  mp_flush_cur_exp(mp, q);
+  mp->cur_type=mp_picture_type;
+}
+
+@* \[40] Statements and commands.
+The chief executive of \MP\ is the |do_statement| routine, which
+contains the master switch that causes all the various pieces of \MP\
+to do their things, in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web.
+
+The structure of |do_statement| itself is quite simple.  The first token
+of the statement is fetched using |get_x_next|.  If it can be the first
+token of an expression, we look for an equation, an assignment, or a
+title. Otherwise we use a \&{case} construction to branch at high speed to
+the appropriate routine for various and sundry other types of commands,
+each of which has an ``action procedure'' that does the necessary work.
+
+The program uses the fact that
+$$\hbox{|min_primary_command=max_statement_command=type_name|}$$
+to interpret a statement that starts with, e.g., `\&{string}',
+as a type declaration rather than a boolean expression.
+
+@c void mp_do_statement (MP mp) { /* governs \MP's activities */
+  mp->cur_type=mp_vacuous; mp_get_x_next(mp);
+  if ( mp->cur_cmd>max_primary_command ) {
+    @<Worry about bad statement@>;
+  } else if ( mp->cur_cmd>max_statement_command ) {
+    @<Do an equation, assignment, title, or
+     `$\langle\,$expression$\,\rangle\,$\&{endgroup}'@>;
+  } else {
+    @<Do a statement that doesn't begin with an expression@>;
+  }
+  if ( mp->cur_cmd<semicolon )
+    @<Flush unparsable junk that was found after the statement@>;
+  mp->error_count=0;
+}
+
+@ @<Declarations@>=
+@<Declare action procedures for use by |do_statement|@>
+
+@ The only command codes |>max_primary_command| that can be present
+at the beginning of a statement are |semicolon| and higher; these
+occur when the statement is null.
+
+@<Worry about bad statement@>=
+{ 
+  if ( mp->cur_cmd<semicolon ) {
+    print_err("A statement can't begin with `");
+@.A statement can't begin with x@>
+    mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod); mp_print_char(mp, '\'');
+    help5("I was looking for the beginning of a new statement.")
+      ("If you just proceed without changing anything, I'll ignore")
+      ("everything up to the next `;'. Please insert a semicolon")
+      ("now in front of anything that you don't want me to delete.")
+      ("(See Chapter 27 of The METAFONTbook for an example.)");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+    mp_back_error(mp); mp_get_x_next(mp);
+  }
+}
+
+@ The help message printed here says that everything is flushed up to
+a semicolon, but actually the commands |end_group| and |stop| will
+also terminate a statement.
+
+@<Flush unparsable junk that was found after the statement@>=
+{ 
+  print_err("Extra tokens will be flushed");
+@.Extra tokens will be flushed@>
+  help6("I've just read as much of that statement as I could fathom,")
+       ("so a semicolon should have been next. It's very puzzling...")
+       ("but I'll try to get myself back together, by ignoring")
+       ("everything up to the next `;'. Please insert a semicolon")
+       ("now in front of anything that you don't want me to delete.")
+       ("(See Chapter 27 of The METAFONTbook for an example.)");
+@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
+  mp_back_error(mp); mp->scanner_status=flushing;
+  do {  
+    get_t_next;
+    @<Decrease the string reference count...@>;
+  } while (! end_of_statement); /* |cur_cmd=semicolon|, |end_group|, or |stop| */
+  mp->scanner_status=normal;
+}
+
+@ If |do_statement| ends with |cur_cmd=end_group|, we should have
+|cur_type=mp_vacuous| unless the statement was simply an expression;
+in the latter case, |cur_type| and |cur_exp| should represent that
+expression.
+
+@<Do a statement that doesn't...@>=
+{ 
+  if ( mp->internal[mp_tracing_commands]>0 ) 
+    show_cur_cmd_mod;
+  switch (mp->cur_cmd ) {
+  case type_name:mp_do_type_declaration(mp); break;
+  case macro_def:
+    if ( mp->cur_mod>var_def ) mp_make_op_def(mp);
+    else if ( mp->cur_mod>end_def ) mp_scan_def(mp);
+     break;
+  @<Cases of |do_statement| that invoke particular commands@>;
+  } /* there are no other cases */
+  mp->cur_type=mp_vacuous;
+}
+
+@ The most important statements begin with expressions.
+
+@<Do an equation, assignment, title, or...@>=
+{ 
+  mp->var_flag=assignment; mp_scan_expression(mp);
+  if ( mp->cur_cmd<end_group ) {
+    if ( mp->cur_cmd==equals ) mp_do_equation(mp);
+    else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp);
+    else if ( mp->cur_type==mp_string_type ) {@<Do a title@> ; }
+    else if ( mp->cur_type!=mp_vacuous ){ 
+      exp_err("Isolated expression");
+@.Isolated expression@>
+      help3("I couldn't find an `=' or `:=' after the")
+        ("expression that is shown above this error message,")
+        ("so I guess I'll just ignore it and carry on.");
+      mp_put_get_error(mp);
+    }
+    mp_flush_cur_exp(mp, 0); mp->cur_type=mp_vacuous;
+  }
+}
+
+@ @<Do a title@>=
+{ 
+  if ( mp->internal[mp_tracing_titles]>0 ) {
+    mp_print_nl(mp, "");  mp_print_str(mp, mp->cur_exp); update_terminal;
+  }
+}
+
+@ Equations and assignments are performed by the pair of mutually recursive
+@^recursion@>
+routines |do_equation| and |do_assignment|. These routines are called when
+|cur_cmd=equals| and when |cur_cmd=assignment|, respectively; the left-hand
+side is in |cur_type| and |cur_exp|, while the right-hand side is yet
+to be scanned. After the routines are finished, |cur_type| and |cur_exp|
+will be equal to the right-hand side (which will normally be equal
+to the left-hand side).
+
+@<Declare action procedures for use by |do_statement|@>=
+@<Declare the procedure called |try_eq|@>
+@<Declare the procedure called |make_eq|@>
+void mp_do_equation (MP mp) ;
+
+@ @c
+void mp_do_equation (MP mp) {
+  pointer lhs; /* capsule for the left-hand side */
+  pointer p; /* temporary register */
+  lhs=mp_stash_cur_exp(mp); mp_get_x_next(mp); 
+  mp->var_flag=assignment; mp_scan_expression(mp);
+  if ( mp->cur_cmd==equals ) mp_do_equation(mp);
+  else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp);
+  if ( mp->internal[mp_tracing_commands]>two ) 
+    @<Trace the current equation@>;
+  if ( mp->cur_type==mp_unknown_path ) if ( type(lhs)==mp_pair_type ) {
+    p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, lhs); lhs=p;
+  }; /* in this case |make_eq| will change the pair to a path */
+  mp_make_eq(mp, lhs); /* equate |lhs| to |(cur_type,cur_exp)| */
+}
+
+@ And |do_assignment| is similar to |do_equation|:
+
+@<Declarations@>=
+void mp_do_assignment (MP mp);
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_assignment (MP mp) ;
+
+@ @c
+void mp_do_assignment (MP mp) {
+  pointer lhs; /* token list for the left-hand side */
+  pointer p; /* where the left-hand value is stored */
+  pointer q; /* temporary capsule for the right-hand value */
+  if ( mp->cur_type!=mp_token_list ) { 
+    exp_err("Improper `:=' will be changed to `='");
+@.Improper `:='@>
+    help2("I didn't find a variable name at the left of the `:=',")
+      ("so I'm going to pretend that you said `=' instead.");
+    mp_error(mp); mp_do_equation(mp);
+  } else { 
+    lhs=mp->cur_exp; mp->cur_type=mp_vacuous;
+    mp_get_x_next(mp); mp->var_flag=assignment; mp_scan_expression(mp);
+    if ( mp->cur_cmd==equals ) mp_do_equation(mp);
+    else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp);
+    if ( mp->internal[mp_tracing_commands]>two ) 
+      @<Trace the current assignment@>;
+    if ( info(lhs)>hash_end ) {
+      @<Assign the current expression to an internal variable@>;
+    } else  {
+      @<Assign the current expression to the variable |lhs|@>;
+    }
+    mp_flush_node_list(mp, lhs);
+  }
+}
+
+@ @<Trace the current equation@>=
+{ 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{("); mp_print_exp(mp,lhs,0);
+  mp_print(mp,")=("); mp_print_exp(mp,null,0); 
+  mp_print(mp,")}"); mp_end_diagnostic(mp, false);
+}
+
+@ @<Trace the current assignment@>=
+{ 
+  mp_begin_diagnostic(mp); mp_print_nl(mp, "{");
+  if ( info(lhs)>hash_end ) 
+     mp_print(mp, mp->int_name[info(lhs)-(hash_end)]);
+  else 
+     mp_show_token_list(mp, lhs,null,1000,0);
+  mp_print(mp, ":="); mp_print_exp(mp, null,0); 
+  mp_print_char(mp, '}'); mp_end_diagnostic(mp, false);
+}
+
+@ @<Assign the current expression to an internal variable@>=
+if ( mp->cur_type==mp_known )  {
+  mp->internal[info(lhs)-(hash_end)]=mp->cur_exp;
+} else { 
+  exp_err("Internal quantity `");
+@.Internal quantity...@>
+  mp_print(mp, mp->int_name[info(lhs)-(hash_end)]);
+  mp_print(mp, "' must receive a known value");
+  help2("I can\'t set an internal quantity to anything but a known")
+    ("numeric value, so I'll have to ignore this assignment.");
+  mp_put_get_error(mp);
+}
+
+@ @<Assign the current expression to the variable |lhs|@>=
+{ 
+  p=mp_find_variable(mp, lhs);
+  if ( p!=null ) {
+    q=mp_stash_cur_exp(mp); mp->cur_type=mp_und_type(mp, p); 
+    mp_recycle_value(mp, p);
+    type(p)=mp->cur_type; value(p)=null; mp_make_exp_copy(mp, p);
+    p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q); mp_make_eq(mp, p);
+  } else  { 
+    mp_obliterated(mp, lhs); mp_put_get_error(mp);
+  }
+}
+
+
+@ And now we get to the nitty-gritty. The |make_eq| procedure is given
+a pointer to a capsule that is to be equated to the current expression.
+
+@<Declare the procedure called |make_eq|@>=
+void mp_make_eq (MP mp,pointer lhs) ;
+
+
+@ 
+@c void mp_make_eq (MP mp,pointer lhs) {
+  small_number t; /* type of the left-hand side */
+  pointer p,q; /* pointers inside of big nodes */
+  integer v=0; /* value of the left-hand side */
+RESTART: 
+  t=type(lhs);
+  if ( t<=mp_pair_type ) v=value(lhs);
+  switch (t) {
+  @<For each type |t|, make an equation and |goto done| unless |cur_type|
+    is incompatible with~|t|@>;
+  } /* all cases have been listed */
+  @<Announce that the equation cannot be performed@>;
+DONE:
+  check_arith; mp_recycle_value(mp, lhs); 
+  mp_free_node(mp, lhs,value_node_size);
+}
+
+@ @<Announce that the equation cannot be performed@>=
+mp_disp_err(mp, lhs,""); 
+exp_err("Equation cannot be performed (");
+@.Equation cannot be performed@>
+if ( type(lhs)<=mp_pair_type ) mp_print_type(mp, type(lhs));
+else mp_print(mp, "numeric");
+mp_print_char(mp, '=');
+if ( mp->cur_type<=mp_pair_type ) mp_print_type(mp, mp->cur_type);
+else mp_print(mp, "numeric");
+mp_print_char(mp, ')');
+help2("I'm sorry, but I don't know how to make such things equal.")
+     ("(See the two expressions just above the error message.)");
+mp_put_get_error(mp)
+
+@ @<For each type |t|, make an equation and |goto done| unless...@>=
+case mp_boolean_type: case mp_string_type: case mp_pen_type:
+case mp_path_type: case mp_picture_type:
+  if ( mp->cur_type==t+unknown_tag ) { 
+    mp_nonlinear_eq(mp, v,mp->cur_exp,false); 
+    mp_unstash_cur_exp(mp, mp->cur_exp); goto DONE;
+  } else if ( mp->cur_type==t ) {
+    @<Report redundant or inconsistent equation and |goto done|@>;
+  }
+  break;
+case unknown_types:
+  if ( mp->cur_type==t-unknown_tag ) { 
+    mp_nonlinear_eq(mp, mp->cur_exp,lhs,true); goto DONE;
+  } else if ( mp->cur_type==t ) { 
+    mp_ring_merge(mp, lhs,mp->cur_exp); goto DONE;
+  } else if ( mp->cur_type==mp_pair_type ) {
+    if ( t==mp_unknown_path ) { 
+     mp_pair_to_path(mp); goto RESTART;
+    };
+  }
+  break;
+case mp_transform_type: case mp_color_type:
+case mp_cmykcolor_type: case mp_pair_type:
+  if ( mp->cur_type==t ) {
+    @<Do multiple equations and |goto done|@>;
+  }
+  break;
+case mp_known: case mp_dependent:
+case mp_proto_dependent: case mp_independent:
+  if ( mp->cur_type>=mp_known ) { 
+    mp_try_eq(mp, lhs,null); goto DONE;
+  };
+  break;
+case mp_vacuous:
+  break;
+
+@ @<Report redundant or inconsistent equation and |goto done|@>=
+{ 
+  if ( mp->cur_type<=mp_string_type ) {
+    if ( mp->cur_type==mp_string_type ) {
+      if ( mp_str_vs_str(mp, v,mp->cur_exp)!=0 ) {
+        goto NOT_FOUND;
+      }
+    } else if ( v!=mp->cur_exp ) {
+      goto NOT_FOUND;
+    }
+    @<Exclaim about a redundant equation@>; goto DONE;
+  }
+  print_err("Redundant or inconsistent equation");
+@.Redundant or inconsistent equation@>
+  help2("An equation between already-known quantities can't help.")
+       ("But don't worry; continue and I'll just ignore it.");
+  mp_put_get_error(mp); goto DONE;
+NOT_FOUND: 
+  print_err("Inconsistent equation");
+@.Inconsistent equation@>
+  help2("The equation I just read contradicts what was said before.")
+       ("But don't worry; continue and I'll just ignore it.");
+  mp_put_get_error(mp); goto DONE;
+}
+
+@ @<Do multiple equations and |goto done|@>=
+{ 
+  p=v+mp->big_node_size[t]; 
+  q=value(mp->cur_exp)+mp->big_node_size[t];
+  do {  
+    p=p-2; q=q-2; mp_try_eq(mp, p,q);
+  } while (p!=v);
+  goto DONE;
+}
+
+@ The first argument to |try_eq| is the location of a value node
+in a capsule that will soon be recycled. The second argument is
+either a location within a pair or transform node pointed to by
+|cur_exp|, or it is |null| (which means that |cur_exp| itself
+serves as the second argument). The idea is to leave |cur_exp| unchanged,
+but to equate the two operands.
+
+@<Declare the procedure called |try_eq|@>=
+void mp_try_eq (MP mp,pointer l, pointer r) ;
+
+@ 
+@c void mp_try_eq (MP mp,pointer l, pointer r) {
+  pointer p; /* dependency list for right operand minus left operand */
+  int t; /* the type of list |p| */
+  pointer q; /* the constant term of |p| is here */
+  pointer pp; /* dependency list for right operand */
+  int tt; /* the type of list |pp| */
+  boolean copied; /* have we copied a list that ought to be recycled? */
+  @<Remove the left operand from its container, negate it, and
+    put it into dependency list~|p| with constant term~|q|@>;
+  @<Add the right operand to list |p|@>;
+  if ( info(p)==null ) {
+    @<Deal with redundant or inconsistent equation@>;
+  } else { 
+    mp_linear_eq(mp, p,t);
+    if ( r==null ) if ( mp->cur_type!=mp_known ) {
+      if ( type(mp->cur_exp)==mp_known ) {
+        pp=mp->cur_exp; mp->cur_exp=value(mp->cur_exp); mp->cur_type=mp_known;
+        mp_free_node(mp, pp,value_node_size);
+      }
+    }
+  }
+}
+
+@ @<Remove the left operand from its container, negate it, and...@>=
+t=type(l);
+if ( t==mp_known ) { 
+  t=mp_dependent; p=mp_const_dependency(mp, -value(l)); q=p;
+} else if ( t==mp_independent ) {
+  t=mp_dependent; p=mp_single_dependency(mp, l); negate(value(p));
+  q=mp->dep_final;
+} else { 
+  p=dep_list(l); q=p;
+  while (1) { 
+    negate(value(q));
+    if ( info(q)==null ) break;
+    q=link(q);
+  }
+  link(prev_dep(l))=link(q); prev_dep(link(q))=prev_dep(l);
+  type(l)=mp_known;
+}
+
+@ @<Deal with redundant or inconsistent equation@>=
+{ 
+  if ( abs(value(p))>64 ) { /* off by .001 or more */
+    print_err("Inconsistent equation");
+@.Inconsistent equation@>
+    mp_print(mp, " (off by "); mp_print_scaled(mp, value(p)); 
+    mp_print_char(mp, ')');
+    help2("The equation I just read contradicts what was said before.")
+      ("But don't worry; continue and I'll just ignore it.");
+    mp_put_get_error(mp);
+  } else if ( r==null ) {
+    @<Exclaim about a redundant equation@>;
+  }
+  mp_free_node(mp, p,dep_node_size);
+}
+
+@ @<Add the right operand to list |p|@>=
+if ( r==null ) {
+  if ( mp->cur_type==mp_known ) {
+    value(q)=value(q)+mp->cur_exp; goto DONE1;
+  } else { 
+    tt=mp->cur_type;
+    if ( tt==mp_independent ) pp=mp_single_dependency(mp, mp->cur_exp);
+    else pp=dep_list(mp->cur_exp);
+  } 
+} else {
+  if ( type(r)==mp_known ) {
+    value(q)=value(q)+value(r); goto DONE1;
+  } else { 
+    tt=type(r);
+    if ( tt==mp_independent ) pp=mp_single_dependency(mp, r);
+    else pp=dep_list(r);
+  }
+}
+if ( tt!=mp_independent ) copied=false;
+else  { copied=true; tt=mp_dependent; };
+@<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>;
+if ( copied ) mp_flush_node_list(mp, pp);
+DONE1:
+
+@ @<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>=
+mp->watch_coefs=false;
+if ( t==tt ) {
+  p=mp_p_plus_q(mp, p,pp,t);
+} else if ( t==mp_proto_dependent ) {
+  p=mp_p_plus_fq(mp, p,unity,pp,mp_proto_dependent,mp_dependent);
+} else { 
+  q=p;
+  while ( info(q)!=null ) {
+    value(q)=mp_round_fraction(mp, value(q)); q=link(q);
+  }
+  t=mp_proto_dependent; p=mp_p_plus_q(mp, p,pp,t);
+}
+mp->watch_coefs=true;
+
+@ Our next goal is to process type declarations. For this purpose it's
+convenient to have a procedure that scans a $\langle\,$declared
+variable$\,\rangle$ and returns the corresponding token list. After the
+following procedure has acted, the token after the declared variable
+will have been scanned, so it will appear in |cur_cmd|, |cur_mod|,
+and~|cur_sym|.
+
+@<Declare the function called |scan_declared_variable|@>=
+pointer mp_scan_declared_variable (MP mp) {
+  pointer x; /* hash address of the variable's root */
+  pointer h,t; /* head and tail of the token list to be returned */
+  pointer l; /* hash address of left bracket */
+  mp_get_symbol(mp); x=mp->cur_sym;
+  if ( mp->cur_cmd!=tag_token ) mp_clear_symbol(mp, x,false);
+  h=mp_get_avail(mp); info(h)=x; t=h;
+  while (1) { 
+    mp_get_x_next(mp);
+    if ( mp->cur_sym==0 ) break;
+    if ( mp->cur_cmd!=tag_token ) if ( mp->cur_cmd!=internal_quantity)  {
+      if ( mp->cur_cmd==left_bracket ) {
+        @<Descend past a collective subscript@>;
+      } else {
+        break;
+      }
+    }
+    link(t)=mp_get_avail(mp); t=link(t); info(t)=mp->cur_sym;
+  }
+  if ( (eq_type(x)%outer_tag)!=tag_token ) mp_clear_symbol(mp, x,false);
+  if ( equiv(x)==null ) mp_new_root(mp, x);
+  return h;
+}
+
+@ If the subscript isn't collective, we don't accept it as part of the
+declared variable.
+
+@<Descend past a collective subscript@>=
+{ 
+  l=mp->cur_sym; mp_get_x_next(mp);
+  if ( mp->cur_cmd!=right_bracket ) {
+    mp_back_input(mp); mp->cur_sym=l; mp->cur_cmd=left_bracket; break;
+  } else {
+    mp->cur_sym=collective_subscript;
+  }
+}
+
+@ Type declarations are introduced by the following primitive operations.
+
+@<Put each...@>=
+mp_primitive(mp, "numeric",type_name,mp_numeric_type);
+@:numeric_}{\&{numeric} primitive@>
+mp_primitive(mp, "string",type_name,mp_string_type);
+@:string_}{\&{string} primitive@>
+mp_primitive(mp, "boolean",type_name,mp_boolean_type);
+@:boolean_}{\&{boolean} primitive@>
+mp_primitive(mp, "path",type_name,mp_path_type);
+@:path_}{\&{path} primitive@>
+mp_primitive(mp, "pen",type_name,mp_pen_type);
+@:pen_}{\&{pen} primitive@>
+mp_primitive(mp, "picture",type_name,mp_picture_type);
+@:picture_}{\&{picture} primitive@>
+mp_primitive(mp, "transform",type_name,mp_transform_type);
+@:transform_}{\&{transform} primitive@>
+mp_primitive(mp, "color",type_name,mp_color_type);
+@:color_}{\&{color} primitive@>
+mp_primitive(mp, "rgbcolor",type_name,mp_color_type);
+@:color_}{\&{rgbcolor} primitive@>
+mp_primitive(mp, "cmykcolor",type_name,mp_cmykcolor_type);
+@:color_}{\&{cmykcolor} primitive@>
+mp_primitive(mp, "pair",type_name,mp_pair_type);
+@:pair_}{\&{pair} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case type_name: mp_print_type(mp, m); break;
+
+@ Now we are ready to handle type declarations, assuming that a
+|type_name| has just been scanned.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_type_declaration (MP mp) ;
+
+@ @c
+void mp_do_type_declaration (MP mp) {
+  small_number t; /* the type being declared */
+  pointer p; /* token list for a declared variable */
+  pointer q; /* value node for the variable */
+  if ( mp->cur_mod>=mp_transform_type ) 
+    t=mp->cur_mod;
+  else 
+    t=mp->cur_mod+unknown_tag;
+  do {  
+    p=mp_scan_declared_variable(mp);
+    mp_flush_variable(mp, equiv(info(p)),link(p),false);
+    q=mp_find_variable(mp, p);
+    if ( q!=null ) { 
+      type(q)=t; value(q)=null; 
+    } else  { 
+      print_err("Declared variable conflicts with previous vardef");
+@.Declared variable conflicts...@>
+      help2("You can't use, e.g., `numeric foo[]' after `vardef foo'.")
+           ("Proceed, and I'll ignore the illegal redeclaration.");
+      mp_put_get_error(mp);
+    }
+    mp_flush_list(mp, p);
+    if ( mp->cur_cmd<comma ) {
+      @<Flush spurious symbols after the declared variable@>;
+    }
+  } while (! end_of_statement);
+}
+
+@ @<Flush spurious symbols after the declared variable@>=
+{ 
+  print_err("Illegal suffix of declared variable will be flushed");
+@.Illegal suffix...flushed@>
+  help5("Variables in declarations must consist entirely of")
+    ("names and collective subscripts, e.g., `x[]a'.")
+    ("Are you trying to use a reserved word in a variable name?")
+    ("I'm going to discard the junk I found here,")
+    ("up to the next comma or the end of the declaration.");
+  if ( mp->cur_cmd==numeric_token )
+    mp->help_line[2]="Explicit subscripts like `x15a' aren't permitted.";
+  mp_put_get_error(mp); mp->scanner_status=flushing;
+  do {  
+    get_t_next;
+    @<Decrease the string reference count...@>;
+  } while (mp->cur_cmd<comma); /* either |end_of_statement| or |cur_cmd=comma| */
+  mp->scanner_status=normal;
+}
+
+@ \MP's |main_control| procedure just calls |do_statement| repeatedly
+until coming to the end of the user's program.
+Each execution of |do_statement| concludes with
+|cur_cmd=semicolon|, |end_group|, or |stop|.
+
+@c void mp_main_control (MP mp) { 
+  do {  
+    mp_do_statement(mp);
+    if ( mp->cur_cmd==end_group ) {
+      print_err("Extra `endgroup'");
+@.Extra `endgroup'@>
+      help2("I'm not currently working on a `begingroup',")
+        ("so I had better not try to end anything.");
+      mp_flush_error(mp, 0);
+    }
+  } while (mp->cur_cmd!=stop);
+}
+int __attribute__((noinline)) 
+mp_run (MP mp) {
+  if (mp->history < mp_fatal_error_stop ) {
+    @<Install and test the non-local jump buffer@>;
+    mp_main_control(mp); /* come to life */
+    mp_final_cleanup(mp); /* prepare for death */
+    mp_close_files_and_terminate(mp);
+  }
+  return mp->history;
+}
+int __attribute__((noinline)) 
+mp_execute (MP mp) {
+  if (mp->history < mp_fatal_error_stop ) {
+    mp->history = mp_spotless;
+    mp->file_offset = 0;
+    mp->term_offset = 0;
+    mp->tally = 0; 
+    @<Install and test the non-local jump buffer@>;
+	if (mp->run_state==0) {
+      mp->run_state = 1;
+    } else {
+      mp_input_ln(mp,mp->term_in);
+      mp_firm_up_the_line(mp);	
+      mp->buffer[limit]='%';
+      mp->first=limit+1; 
+      loc=start;
+    }
+	do {  
+      mp_do_statement(mp);
+    } while (mp->cur_cmd!=stop);
+  }
+  return mp->history;
+}
+int __attribute__((noinline)) 
+mp_finish (MP mp) {
+  if (mp->history < mp_fatal_error_stop ) {
+    @<Install and test the non-local jump buffer@>;
+    mp_final_cleanup(mp); /* prepare for death */
+    mp_close_files_and_terminate(mp);
+  }
+  return mp->history;
+}
+const char * mp_mplib_version (MP mp) {
+  (void)mp;
+  return mplib_version;
+}
+const char * mp_metapost_version (MP mp) {
+  (void)mp;
+  return metapost_version;
+}
+
+@ @<Exported function headers@>=
+int mp_run (MP mp);
+int mp_execute (MP mp);
+int mp_finish (MP mp);
+const char * mp_mplib_version (MP mp);
+const char * mp_metapost_version (MP mp);
+
+@ @<Put each...@>=
+mp_primitive(mp, "end",stop,0);
+@:end_}{\&{end} primitive@>
+mp_primitive(mp, "dump",stop,1);
+@:dump_}{\&{dump} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case stop:
+  if ( m==0 ) mp_print(mp, "end");
+  else mp_print(mp, "dump");
+  break;
+
+@* \[41] Commands.
+Let's turn now to statements that are classified as ``commands'' because
+of their imperative nature. We'll begin with simple ones, so that it
+will be clear how to hook command processing into the |do_statement| routine;
+then we'll tackle the tougher commands.
+
+Here's one of the simplest:
+
+@<Cases of |do_statement|...@>=
+case mp_random_seed: mp_do_random_seed(mp);  break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_random_seed (MP mp) ;
+
+@ @c void mp_do_random_seed (MP mp) { 
+  mp_get_x_next(mp);
+  if ( mp->cur_cmd!=assignment ) {
+    mp_missing_err(mp, ":=");
+@.Missing `:='@>
+    help1("Always say `randomseed:=<numeric expression>'.");
+    mp_back_error(mp);
+  };
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ) {
+    exp_err("Unknown value will be ignored");
+@.Unknown value...ignored@>
+    help2("Your expression was too random for me to handle,")
+      ("so I won't change the random seed just now.");
+    mp_put_get_flush_error(mp, 0);
+  } else {
+   @<Initialize the random seed to |cur_exp|@>;
+  }
+}
+
+@ @<Initialize the random seed to |cur_exp|@>=
+{ 
+  mp_init_randoms(mp, mp->cur_exp);
+  if ( mp->selector>=log_only && mp->selector<write_file) {
+    mp->old_setting=mp->selector; mp->selector=log_only;
+    mp_print_nl(mp, "{randomseed:="); 
+    mp_print_scaled(mp, mp->cur_exp); 
+    mp_print_char(mp, '}');
+    mp_print_nl(mp, ""); mp->selector=mp->old_setting;
+  }
+}
+
+@ And here's another simple one (somewhat different in flavor):
+
+@<Cases of |do_statement|...@>=
+case mode_command: 
+  mp_print_ln(mp); mp->interaction=mp->cur_mod;
+  @<Initialize the print |selector| based on |interaction|@>;
+  if ( mp->log_opened ) mp->selector=mp->selector+2;
+  mp_get_x_next(mp);
+  break;
+
+@ @<Put each...@>=
+mp_primitive(mp, "batchmode",mode_command,mp_batch_mode);
+@:mp_batch_mode_}{\&{batchmode} primitive@>
+mp_primitive(mp, "nonstopmode",mode_command,mp_nonstop_mode);
+@:mp_nonstop_mode_}{\&{nonstopmode} primitive@>
+mp_primitive(mp, "scrollmode",mode_command,mp_scroll_mode);
+@:mp_scroll_mode_}{\&{scrollmode} primitive@>
+mp_primitive(mp, "errorstopmode",mode_command,mp_error_stop_mode);
+@:mp_error_stop_mode_}{\&{errorstopmode} primitive@>
+
+@ @<Cases of |print_cmd_mod|...@>=
+case mode_command: 
+  switch (m) {
+  case mp_batch_mode: mp_print(mp, "batchmode"); break;
+  case mp_nonstop_mode: mp_print(mp, "nonstopmode"); break;
+  case mp_scroll_mode: mp_print(mp, "scrollmode"); break;
+  default: mp_print(mp, "errorstopmode"); break;
+  }
+  break;
+
+@ The `\&{inner}' and `\&{outer}' commands are only slightly harder.
+
+@<Cases of |do_statement|...@>=
+case protection_command: mp_do_protection(mp); break;
+
+@ @<Put each...@>=
+mp_primitive(mp, "inner",protection_command,0);
+@:inner_}{\&{inner} primitive@>
+mp_primitive(mp, "outer",protection_command,1);
+@:outer_}{\&{outer} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case protection_command: 
+  if ( m==0 ) mp_print(mp, "inner");
+  else mp_print(mp, "outer");
+  break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_protection (MP mp) ;
+
+@ @c void mp_do_protection (MP mp) {
+  int m; /* 0 to unprotect, 1 to protect */
+  halfword t; /* the |eq_type| before we change it */
+  m=mp->cur_mod;
+  do {  
+    mp_get_symbol(mp); t=eq_type(mp->cur_sym);
+    if ( m==0 ) { 
+      if ( t>=outer_tag ) 
+        eq_type(mp->cur_sym)=t-outer_tag;
+    } else if ( t<outer_tag ) {
+      eq_type(mp->cur_sym)=t+outer_tag;
+    }
+    mp_get_x_next(mp);
+  } while (mp->cur_cmd==comma);
+}
+
+@ \MP\ never defines the tokens `\.(' and `\.)' to be primitives, but
+plain \MP\ begins with the declaration `\&{delimiters} \.{()}'. Such a
+declaration assigns the command code |left_delimiter| to `\.{(}' and
+|right_delimiter| to `\.{)}'; the |equiv| of each delimiter is the
+hash address of its mate.
+
+@<Cases of |do_statement|...@>=
+case delimiters: mp_def_delims(mp); break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_def_delims (MP mp) ;
+
+@ @c void mp_def_delims (MP mp) {
+  pointer l_delim,r_delim; /* the new delimiter pair */
+  mp_get_clear_symbol(mp); l_delim=mp->cur_sym;
+  mp_get_clear_symbol(mp); r_delim=mp->cur_sym;
+  eq_type(l_delim)=left_delimiter; equiv(l_delim)=r_delim;
+  eq_type(r_delim)=right_delimiter; equiv(r_delim)=l_delim;
+  mp_get_x_next(mp);
+}
+
+@ Here is a procedure that is called when \MP\ has reached a point
+where some right delimiter is mandatory.
+
+@<Declare the procedure called |check_delimiter|@>=
+void mp_check_delimiter (MP mp,pointer l_delim, pointer r_delim) {
+  if ( mp->cur_cmd==right_delimiter ) 
+    if ( mp->cur_mod==l_delim ) 
+      return;
+  if ( mp->cur_sym!=r_delim ) {
+     mp_missing_err(mp, str(text(r_delim)));
+@.Missing `)'@>
+    help2("I found no right delimiter to match a left one. So I've")
+      ("put one in, behind the scenes; this may fix the problem.");
+    mp_back_error(mp);
+  } else { 
+    print_err("The token `"); mp_print_text(r_delim);
+@.The token...delimiter@>
+    mp_print(mp, "' is no longer a right delimiter");
+    help3("Strange: This token has lost its former meaning!")
+      ("I'll read it as a right delimiter this time;")
+      ("but watch out, I'll probably miss it later.");
+    mp_error(mp);
+  }
+}
+
+@ The next four commands save or change the values associated with tokens.
+
+@<Cases of |do_statement|...@>=
+case save_command: 
+  do {  
+    mp_get_symbol(mp); mp_save_variable(mp, mp->cur_sym); mp_get_x_next(mp);
+  } while (mp->cur_cmd==comma);
+  break;
+case interim_command: mp_do_interim(mp); break;
+case let_command: mp_do_let(mp); break;
+case new_internal: mp_do_new_internal(mp); break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_statement (MP mp);
+void mp_do_interim (MP mp);
+
+@ @c void mp_do_interim (MP mp) { 
+  mp_get_x_next(mp);
+  if ( mp->cur_cmd!=internal_quantity ) {
+     print_err("The token `");
+@.The token...quantity@>
+    if ( mp->cur_sym==0 ) mp_print(mp, "(%CAPSULE)");
+    else mp_print_text(mp->cur_sym);
+    mp_print(mp, "' isn't an internal quantity");
+    help1("Something like `tracingonline' should follow `interim'.");
+    mp_back_error(mp);
+  } else { 
+    mp_save_internal(mp, mp->cur_mod); mp_back_input(mp);
+  }
+  mp_do_statement(mp);
+}
+
+@ The following procedure is careful not to undefine the left-hand symbol
+too soon, lest commands like `{\tt let x=x}' have a surprising effect.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_let (MP mp) ;
+
+@ @c void mp_do_let (MP mp) {
+  pointer l; /* hash location of the left-hand symbol */
+  mp_get_symbol(mp); l=mp->cur_sym; mp_get_x_next(mp);
+  if ( mp->cur_cmd!=equals ) if ( mp->cur_cmd!=assignment ) {
+     mp_missing_err(mp, "=");
+@.Missing `='@>
+    help3("You should have said `let symbol = something'.")
+      ("But don't worry; I'll pretend that an equals sign")
+      ("was present. The next token I read will be `something'.");
+    mp_back_error(mp);
+  }
+  mp_get_symbol(mp);
+  switch (mp->cur_cmd) {
+  case defined_macro: case secondary_primary_macro:
+  case tertiary_secondary_macro: case expression_tertiary_macro: 
+    add_mac_ref(mp->cur_mod);
+    break;
+  default: 
+    break;
+  }
+  mp_clear_symbol(mp, l,false); eq_type(l)=mp->cur_cmd;
+  if ( mp->cur_cmd==tag_token ) equiv(l)=null;
+  else equiv(l)=mp->cur_mod;
+  mp_get_x_next(mp);
+}
+
+@ @<Declarations@>=
+void mp_grow_internals (MP mp, int l);
+void mp_do_new_internal (MP mp) ;
+
+@ @c
+void mp_grow_internals (MP mp, int l) {
+  scaled *internal;
+  char * *int_name; 
+  int k;
+  if ( hash_end+l>max_halfword ) {
+    mp_confusion(mp, "out of memory space"); /* can't be reached */
+  }
+  int_name = xmalloc ((l+1),sizeof(char *));
+  internal = xmalloc ((l+1),sizeof(scaled));
+  for (k=0;k<=l; k++ ) { 
+    if (k<=mp->max_internal) {
+      internal[k]=mp->internal[k]; 
+      int_name[k]=mp->int_name[k]; 
+    } else {
+      internal[k]=0; 
+      int_name[k]=NULL; 
+    }
+  }
+  xfree(mp->internal); xfree(mp->int_name);
+  mp->int_name = int_name;
+  mp->internal = internal;
+  mp->max_internal = l;
+}
+
+
+void mp_do_new_internal (MP mp) { 
+  do {  
+    if ( mp->int_ptr==mp->max_internal ) {
+      mp_grow_internals(mp, (mp->max_internal + (mp->max_internal>>2)));
+    }
+    mp_get_clear_symbol(mp); incr(mp->int_ptr);
+    eq_type(mp->cur_sym)=internal_quantity; 
+    equiv(mp->cur_sym)=mp->int_ptr;
+    if(mp->int_name[mp->int_ptr]!=NULL)
+      xfree(mp->int_name[mp->int_ptr]);
+    mp->int_name[mp->int_ptr]=str(text(mp->cur_sym)); 
+    mp->internal[mp->int_ptr]=0;
+    mp_get_x_next(mp);
+  } while (mp->cur_cmd==comma);
+}
+
+@ @<Dealloc variables@>=
+for (k=0;k<=mp->max_internal;k++) {
+   xfree(mp->int_name[k]);
+}
+xfree(mp->internal); 
+xfree(mp->int_name); 
+
+
+@ The various `\&{show}' commands are distinguished by modifier fields
+in the usual way.
+
+@d show_token_code 0 /* show the meaning of a single token */
+@d show_stats_code 1 /* show current memory and string usage */
+@d show_code 2 /* show a list of expressions */
+@d show_var_code 3 /* show a variable and its descendents */
+@d show_dependencies_code 4 /* show dependent variables in terms of independents */
+
+@<Put each...@>=
+mp_primitive(mp, "showtoken",show_command,show_token_code);
+@:show_token_}{\&{showtoken} primitive@>
+mp_primitive(mp, "showstats",show_command,show_stats_code);
+@:show_stats_}{\&{showstats} primitive@>
+mp_primitive(mp, "show",show_command,show_code);
+@:show_}{\&{show} primitive@>
+mp_primitive(mp, "showvariable",show_command,show_var_code);
+@:show_var_}{\&{showvariable} primitive@>
+mp_primitive(mp, "showdependencies",show_command,show_dependencies_code);
+@:show_dependencies_}{\&{showdependencies} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case show_command: 
+  switch (m) {
+  case show_token_code:mp_print(mp, "showtoken"); break;
+  case show_stats_code:mp_print(mp, "showstats"); break;
+  case show_code:mp_print(mp, "show"); break;
+  case show_var_code:mp_print(mp, "showvariable"); break;
+  default: mp_print(mp, "showdependencies"); break;
+  }
+  break;
+
+@ @<Cases of |do_statement|...@>=
+case show_command:mp_do_show_whatever(mp); break;
+
+@ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine:
+if it's |show_code|, complicated structures are abbreviated, otherwise
+they aren't.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_show (MP mp) ;
+
+@ @c void mp_do_show (MP mp) { 
+  do {  
+    mp_get_x_next(mp); mp_scan_expression(mp);
+    mp_print_nl(mp, ">> ");
+@.>>@>
+    mp_print_exp(mp, null,2); mp_flush_cur_exp(mp, 0);
+  } while (mp->cur_cmd==comma);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_disp_token (MP mp) ;
+
+@ @c void mp_disp_token (MP mp) { 
+  mp_print_nl(mp, "> ");
+@.>\relax@>
+  if ( mp->cur_sym==0 ) {
+    @<Show a numeric or string or capsule token@>;
+  } else { 
+    mp_print_text(mp->cur_sym); mp_print_char(mp, '=');
+    if ( eq_type(mp->cur_sym)>=outer_tag ) mp_print(mp, "(outer) ");
+    mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod);
+    if ( mp->cur_cmd==defined_macro ) {
+      mp_print_ln(mp); mp_show_macro(mp, mp->cur_mod,null,100000);
+    } /* this avoids recursion between |show_macro| and |print_cmd_mod| */
+@^recursion@>
+  }
+}
+
+@ @<Show a numeric or string or capsule token@>=
+{ 
+  if ( mp->cur_cmd==numeric_token ) {
+    mp_print_scaled(mp, mp->cur_mod);
+  } else if ( mp->cur_cmd==capsule_token ) {
+    mp_print_capsule(mp,mp->cur_mod);
+  } else  { 
+    mp_print_char(mp, '"'); 
+    mp_print_str(mp, mp->cur_mod); mp_print_char(mp, '"');
+    delete_str_ref(mp->cur_mod);
+  }
+}
+
+@ The following cases of |print_cmd_mod| might arise in connection
+with |disp_token|, although they don't necessarily correspond to
+primitive tokens.
+
+@<Cases of |print_cmd_...@>=
+case left_delimiter:
+case right_delimiter: 
+  if ( c==left_delimiter ) mp_print(mp, "left");
+  else mp_print(mp, "right");
+  mp_print(mp, " delimiter that matches "); 
+  mp_print_text(m);
+  break;
+case tag_token:
+  if ( m==null ) mp_print(mp, "tag");
+   else mp_print(mp, "variable");
+   break;
+case defined_macro: 
+   mp_print(mp, "macro:");
+   break;
+case secondary_primary_macro:
+case tertiary_secondary_macro:
+case expression_tertiary_macro:
+  mp_print_cmd_mod(mp, macro_def,c); 
+  mp_print(mp, "'d macro:");
+  mp_print_ln(mp); mp_show_token_list(mp, link(link(m)),null,1000,0);
+  break;
+case repeat_loop:
+  mp_print(mp, "[repeat the loop]");
+  break;
+case internal_quantity:
+  mp_print(mp, mp->int_name[m]);
+  break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_show_token (MP mp) ;
+
+@ @c void mp_do_show_token (MP mp) { 
+  do {  
+    get_t_next; mp_disp_token(mp);
+    mp_get_x_next(mp);
+  } while (mp->cur_cmd==comma);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_show_stats (MP mp) ;
+
+@ @c void mp_do_show_stats (MP mp) { 
+  mp_print_nl(mp, "Memory usage ");
+@.Memory usage...@>
+  mp_print_int(mp, mp->var_used); mp_print_char(mp, '&'); mp_print_int(mp, mp->dyn_used);
+  mp_print(mp, " ("); mp_print_int(mp, mp->hi_mem_min-mp->lo_mem_max-1);
+  mp_print(mp, " still untouched)"); mp_print_ln(mp);
+  mp_print_nl(mp, "String usage ");
+  mp_print_int(mp, mp->strs_in_use-mp->init_str_use);
+  mp_print_char(mp, '&'); mp_print_int(mp, mp->pool_in_use-mp->init_pool_ptr);
+  mp_print(mp, " (");
+  mp_print_int(mp, mp->max_strings-1-mp->strs_used_up); mp_print_char(mp, '&');
+  mp_print_int(mp, mp->pool_size-mp->pool_ptr); 
+  mp_print(mp, " now untouched)"); mp_print_ln(mp);
+  mp_get_x_next(mp);
+}
+
+@ Here's a recursive procedure that gives an abbreviated account
+of a variable, for use by |do_show_var|.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_disp_var (MP mp,pointer p) ;
+
+@ @c void mp_disp_var (MP mp,pointer p) {
+  pointer q; /* traverses attributes and subscripts */
+  int n; /* amount of macro text to show */
+  if ( type(p)==mp_structured )  {
+    @<Descend the structure@>;
+  } else if ( type(p)>=mp_unsuffixed_macro ) {
+    @<Display a variable macro@>;
+  } else if ( type(p)!=undefined ){ 
+    mp_print_nl(mp, ""); mp_print_variable_name(mp, p); 
+    mp_print_char(mp, '=');
+    mp_print_exp(mp, p,0);
+  }
+}
+
+@ @<Descend the structure@>=
+{ 
+  q=attr_head(p);
+  do {  mp_disp_var(mp, q); q=link(q); } while (q!=end_attr);
+  q=subscr_head(p);
+  while ( name_type(q)==mp_subscr ) { 
+    mp_disp_var(mp, q); q=link(q);
+  }
+}
+
+@ @<Display a variable macro@>=
+{ 
+  mp_print_nl(mp, ""); mp_print_variable_name(mp, p);
+  if ( type(p)>mp_unsuffixed_macro ) 
+    mp_print(mp, "@@#"); /* |suffixed_macro| */
+  mp_print(mp, "=macro:");
+  if ( (int)mp->file_offset>=mp->max_print_line-20 ) n=5;
+  else n=mp->max_print_line-mp->file_offset-15;
+  mp_show_macro(mp, value(p),null,n);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_show_var (MP mp) ;
+
+@ @c void mp_do_show_var (MP mp) { 
+  do {  
+    get_t_next;
+    if ( mp->cur_sym>0 ) if ( mp->cur_sym<=hash_end )
+      if ( mp->cur_cmd==tag_token ) if ( mp->cur_mod!=null ) {
+      mp_disp_var(mp, mp->cur_mod); goto DONE;
+    }
+   mp_disp_token(mp);
+  DONE:
+   mp_get_x_next(mp);
+  } while (mp->cur_cmd==comma);
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_show_dependencies (MP mp) ;
+
+@ @c void mp_do_show_dependencies (MP mp) {
+  pointer p; /* link that runs through all dependencies */
+  p=link(dep_head);
+  while ( p!=dep_head ) {
+    if ( mp_interesting(mp, p) ) {
+      mp_print_nl(mp, ""); mp_print_variable_name(mp, p);
+      if ( type(p)==mp_dependent ) mp_print_char(mp, '=');
+      else mp_print(mp, " = "); /* extra spaces imply proto-dependency */
+      mp_print_dependency(mp, dep_list(p),type(p));
+    }
+    p=dep_list(p);
+    while ( info(p)!=null ) p=link(p);
+    p=link(p);
+  }
+  mp_get_x_next(mp);
+}
+
+@ Finally we are ready for the procedure that governs all of the
+show commands.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_show_whatever (MP mp) ;
+
+@ @c void mp_do_show_whatever (MP mp) { 
+  if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal;
+  switch (mp->cur_mod) {
+  case show_token_code:mp_do_show_token(mp); break;
+  case show_stats_code:mp_do_show_stats(mp); break;
+  case show_code:mp_do_show(mp); break;
+  case show_var_code:mp_do_show_var(mp); break;
+  case show_dependencies_code:mp_do_show_dependencies(mp); break;
+  } /* there are no other cases */
+  if ( mp->internal[mp_showstopping]>0 ){ 
+    print_err("OK");
+@.OK@>
+    if ( mp->interaction<mp_error_stop_mode ) { 
+      help0; decr(mp->error_count);
+    } else {
+      help1("This isn't an error message; I'm just showing something.");
+    }
+    if ( mp->cur_cmd==semicolon ) mp_error(mp);
+     else mp_put_get_error(mp);
+  }
+}
+
+@ The `\&{addto}' command needs the following additional primitives:
+
+@d double_path_code 0 /* command modifier for `\&{doublepath}' */
+@d contour_code 1 /* command modifier for `\&{contour}' */
+@d also_code 2 /* command modifier for `\&{also}' */
+
+@ Pre and postscripts need two new identifiers:
+
+@d with_pre_script 11
+@d with_post_script 13
+
+@<Put each...@>=
+mp_primitive(mp, "doublepath",thing_to_add,double_path_code);
+@:double_path_}{\&{doublepath} primitive@>
+mp_primitive(mp, "contour",thing_to_add,contour_code);
+@:contour_}{\&{contour} primitive@>
+mp_primitive(mp, "also",thing_to_add,also_code);
+@:also_}{\&{also} primitive@>
+mp_primitive(mp, "withpen",with_option,mp_pen_type);
+@:with_pen_}{\&{withpen} primitive@>
+mp_primitive(mp, "dashed",with_option,mp_picture_type);
+@:dashed_}{\&{dashed} primitive@>
+mp_primitive(mp, "withprescript",with_option,with_pre_script);
+@:with_pre_script_}{\&{withprescript} primitive@>
+mp_primitive(mp, "withpostscript",with_option,with_post_script);
+@:with_post_script_}{\&{withpostscript} primitive@>
+mp_primitive(mp, "withoutcolor",with_option,mp_no_model);
+@:with_color_}{\&{withoutcolor} primitive@>
+mp_primitive(mp, "withgreyscale",with_option,mp_grey_model);
+@:with_color_}{\&{withgreyscale} primitive@>
+mp_primitive(mp, "withcolor",with_option,mp_uninitialized_model);
+@:with_color_}{\&{withcolor} primitive@>
+/*  \&{withrgbcolor} is an alias for \&{withcolor} */
+mp_primitive(mp, "withrgbcolor",with_option,mp_rgb_model);
+@:with_color_}{\&{withrgbcolor} primitive@>
+mp_primitive(mp, "withcmykcolor",with_option,mp_cmyk_model);
+@:with_color_}{\&{withcmykcolor} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case thing_to_add:
+  if ( m==contour_code ) mp_print(mp, "contour");
+  else if ( m==double_path_code ) mp_print(mp, "doublepath");
+  else mp_print(mp, "also");
+  break;
+case with_option:
+  if ( m==mp_pen_type ) mp_print(mp, "withpen");
+  else if ( m==with_pre_script ) mp_print(mp, "withprescript");
+  else if ( m==with_post_script ) mp_print(mp, "withpostscript");
+  else if ( m==mp_no_model ) mp_print(mp, "withoutcolor");
+  else if ( m==mp_rgb_model ) mp_print(mp, "withrgbcolor");
+  else if ( m==mp_uninitialized_model ) mp_print(mp, "withcolor");
+  else if ( m==mp_cmyk_model ) mp_print(mp, "withcmykcolor");
+  else if ( m==mp_grey_model ) mp_print(mp, "withgreyscale");
+  else mp_print(mp, "dashed");
+  break;
+
+@ The |scan_with_list| procedure parses a $\langle$with list$\rangle$ and
+updates the list of graphical objects starting at |p|.  Each $\langle$with
+clause$\rangle$ updates all graphical objects whose |type| is compatible.
+Other objects are ignored.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_scan_with_list (MP mp,pointer p) ;
+
+@ @c void mp_scan_with_list (MP mp,pointer p) {
+  small_number t; /* |cur_mod| of the |with_option| (should match |cur_type|) */
+  pointer q; /* for list manipulation */
+  int old_setting; /* saved |selector| setting */
+  pointer k; /* for finding the near-last item in a list  */
+  str_number s; /* for string cleanup after combining  */
+  pointer cp,pp,dp,ap,bp;
+    /* objects being updated; |void| initially; |null| to suppress update */
+  cp=mp_void; pp=mp_void; dp=mp_void; ap=mp_void; bp=mp_void;
+  k=0;
+  while ( mp->cur_cmd==with_option ){ 
+    t=mp->cur_mod;
+    mp_get_x_next(mp);
+    if ( t!=mp_no_model ) mp_scan_expression(mp);
+    if (((t==with_pre_script)&&(mp->cur_type!=mp_string_type))||
+     ((t==with_post_script)&&(mp->cur_type!=mp_string_type))||
+     ((t==mp_uninitialized_model)&&
+        ((mp->cur_type!=mp_cmykcolor_type)&&(mp->cur_type!=mp_color_type)
+          &&(mp->cur_type!=mp_known)&&(mp->cur_type!=mp_boolean_type)))||
+     ((t==mp_cmyk_model)&&(mp->cur_type!=mp_cmykcolor_type))||
+     ((t==mp_rgb_model)&&(mp->cur_type!=mp_color_type))||
+     ((t==mp_grey_model)&&(mp->cur_type!=mp_known))||
+     ((t==mp_pen_type)&&(mp->cur_type!=t))||
+     ((t==mp_picture_type)&&(mp->cur_type!=t)) ) {
+      @<Complain about improper type@>;
+    } else if ( t==mp_uninitialized_model ) {
+      if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>;
+      if ( cp!=null )
+        @<Transfer a color from the current expression to object~|cp|@>;
+      mp_flush_cur_exp(mp, 0);
+    } else if ( t==mp_rgb_model ) {
+      if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>;
+      if ( cp!=null )
+        @<Transfer a rgbcolor from the current expression to object~|cp|@>;
+      mp_flush_cur_exp(mp, 0);
+    } else if ( t==mp_cmyk_model ) {
+      if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>;
+      if ( cp!=null )
+        @<Transfer a cmykcolor from the current expression to object~|cp|@>;
+      mp_flush_cur_exp(mp, 0);
+    } else if ( t==mp_grey_model ) {
+      if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>;
+      if ( cp!=null )
+        @<Transfer a greyscale from the current expression to object~|cp|@>;
+      mp_flush_cur_exp(mp, 0);
+    } else if ( t==mp_no_model ) {
+      if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>;
+      if ( cp!=null )
+        @<Transfer a noncolor from the current expression to object~|cp|@>;
+    } else if ( t==mp_pen_type ) {
+      if ( pp==mp_void ) @<Make |pp| an object in list~|p| that needs a pen@>;
+      if ( pp!=null ) {
+        if ( pen_p(pp)!=null ) mp_toss_knot_list(mp, pen_p(pp));
+        pen_p(pp)=mp->cur_exp; mp->cur_type=mp_vacuous;
+      }
+    } else if ( t==with_pre_script ) {
+      if ( ap==mp_void )
+        ap=p;
+      while ( (ap!=null)&&(! has_color(ap)) )
+         ap=link(ap);
+      if ( ap!=null ) {
+        if ( pre_script(ap)!=null ) { /*  build a new,combined string  */
+          s=pre_script(ap);
+          old_setting=mp->selector;
+	      mp->selector=new_string;
+          str_room(length(pre_script(ap))+length(mp->cur_exp)+2);
+	      mp_print_str(mp, mp->cur_exp);
+          append_char(13);  /* a forced \ps\ newline  */
+          mp_print_str(mp, pre_script(ap));
+          pre_script(ap)=mp_make_string(mp);
+          delete_str_ref(s);
+          mp->selector=old_setting;
+        } else {
+          pre_script(ap)=mp->cur_exp;
+        }
+        mp->cur_type=mp_vacuous;
+      }
+    } else if ( t==with_post_script ) {
+      if ( bp==mp_void )
+        k=p; 
+      bp=k;
+      while ( link(k)!=null ) {
+        k=link(k);
+        if ( has_color(k) ) bp=k;
+      }
+      if ( bp!=null ) {
+         if ( post_script(bp)!=null ) {
+           s=post_script(bp);
+           old_setting=mp->selector;
+	       mp->selector=new_string;
+           str_room(length(post_script(bp))+length(mp->cur_exp)+2);
+           mp_print_str(mp, post_script(bp));
+           append_char(13); /* a forced \ps\ newline  */
+	   mp_print_str(mp, mp->cur_exp);
+           post_script(bp)=mp_make_string(mp);
+           delete_str_ref(s);
+           mp->selector=old_setting;
+         } else {
+           post_script(bp)=mp->cur_exp;
+         }
+         mp->cur_type=mp_vacuous;
+       }
+    } else { 
+      if ( dp==mp_void ) {
+        @<Make |dp| a stroked node in list~|p|@>;
+      }
+      if ( dp!=null ) {
+        if ( dash_p(dp)!=null ) delete_edge_ref(dash_p(dp));
+        dash_p(dp)=mp_make_dashes(mp, mp->cur_exp);
+        dash_scale(dp)=unity;
+        mp->cur_type=mp_vacuous;
+      }
+    }
+  }
+  @<Copy the information from objects |cp|, |pp|, and |dp| into the rest
+    of the list@>;
+}
+
+@ @<Complain about improper type@>=
+{ exp_err("Improper type");
+@.Improper type@>
+help2("Next time say `withpen <known pen expression>';")
+  ("I'll ignore the bad `with' clause and look for another.");
+if ( t==with_pre_script )
+  mp->help_line[1]="Next time say `withprescript <known string expression>';";
+else if ( t==with_post_script )
+  mp->help_line[1]="Next time say `withpostscript <known string expression>';";
+else if ( t==mp_picture_type )
+  mp->help_line[1]="Next time say `dashed <known picture expression>';";
+else if ( t==mp_uninitialized_model )
+  mp->help_line[1]="Next time say `withcolor <known color expression>';";
+else if ( t==mp_rgb_model )
+  mp->help_line[1]="Next time say `withrgbcolor <known color expression>';";
+else if ( t==mp_cmyk_model )
+  mp->help_line[1]="Next time say `withcmykcolor <known cmykcolor expression>';";
+else if ( t==mp_grey_model )
+  mp->help_line[1]="Next time say `withgreyscale <known numeric expression>';";;
+mp_put_get_flush_error(mp, 0);
+}
+
+@ Forcing the color to be between |0| and |unity| here guarantees that no
+picture will ever contain a color outside the legal range for \ps\ graphics.
+
+@<Transfer a color from the current expression to object~|cp|@>=
+{ if ( mp->cur_type==mp_color_type )
+   @<Transfer a rgbcolor from the current expression to object~|cp|@>
+else if ( mp->cur_type==mp_cmykcolor_type )
+   @<Transfer a cmykcolor from the current expression to object~|cp|@>
+else if ( mp->cur_type==mp_known )
+   @<Transfer a greyscale from the current expression to object~|cp|@>
+else if ( mp->cur_exp==false_code )
+   @<Transfer a noncolor from the current expression to object~|cp|@>;
+}
+
+@ @<Transfer a rgbcolor from the current expression to object~|cp|@>=
+{ q=value(mp->cur_exp);
+cyan_val(cp)=0;
+magenta_val(cp)=0;
+yellow_val(cp)=0;
+black_val(cp)=0;
+red_val(cp)=value(red_part_loc(q));
+green_val(cp)=value(green_part_loc(q));
+blue_val(cp)=value(blue_part_loc(q));
+color_model(cp)=mp_rgb_model;
+if ( red_val(cp)<0 ) red_val(cp)=0;
+if ( green_val(cp)<0 ) green_val(cp)=0;
+if ( blue_val(cp)<0 ) blue_val(cp)=0;
+if ( red_val(cp)>unity ) red_val(cp)=unity;
+if ( green_val(cp)>unity ) green_val(cp)=unity;
+if ( blue_val(cp)>unity ) blue_val(cp)=unity;
+}
+
+@ @<Transfer a cmykcolor from the current expression to object~|cp|@>=
+{ q=value(mp->cur_exp);
+cyan_val(cp)=value(cyan_part_loc(q));
+magenta_val(cp)=value(magenta_part_loc(q));
+yellow_val(cp)=value(yellow_part_loc(q));
+black_val(cp)=value(black_part_loc(q));
+color_model(cp)=mp_cmyk_model;
+if ( cyan_val(cp)<0 ) cyan_val(cp)=0;
+if ( magenta_val(cp)<0 ) magenta_val(cp)=0;
+if ( yellow_val(cp)<0 ) yellow_val(cp)=0;
+if ( black_val(cp)<0 ) black_val(cp)=0;
+if ( cyan_val(cp)>unity ) cyan_val(cp)=unity;
+if ( magenta_val(cp)>unity ) magenta_val(cp)=unity;
+if ( yellow_val(cp)>unity ) yellow_val(cp)=unity;
+if ( black_val(cp)>unity ) black_val(cp)=unity;
+}
+
+@ @<Transfer a greyscale from the current expression to object~|cp|@>=
+{ q=mp->cur_exp;
+cyan_val(cp)=0;
+magenta_val(cp)=0;
+yellow_val(cp)=0;
+black_val(cp)=0;
+grey_val(cp)=q;
+color_model(cp)=mp_grey_model;
+if ( grey_val(cp)<0 ) grey_val(cp)=0;
+if ( grey_val(cp)>unity ) grey_val(cp)=unity;
+}
+
+@ @<Transfer a noncolor from the current expression to object~|cp|@>=
+{
+cyan_val(cp)=0;
+magenta_val(cp)=0;
+yellow_val(cp)=0;
+black_val(cp)=0;
+grey_val(cp)=0;
+color_model(cp)=mp_no_model;
+}
+
+@ @<Make |cp| a colored object in object list~|p|@>=
+{ cp=p;
+  while ( cp!=null ){ 
+    if ( has_color(cp) ) break;
+    cp=link(cp);
+  }
+}
+
+@ @<Make |pp| an object in list~|p| that needs a pen@>=
+{ pp=p;
+  while ( pp!=null ) {
+    if ( has_pen(pp) ) break;
+    pp=link(pp);
+  }
+}
+
+@ @<Make |dp| a stroked node in list~|p|@>=
+{ dp=p;
+  while ( dp!=null ) {
+    if ( type(dp)==mp_stroked_code ) break;
+    dp=link(dp);
+  }
+}
+
+@ @<Copy the information from objects |cp|, |pp|, and |dp| into...@>=
+@<Copy |cp|'s color into the colored objects linked to~|cp|@>;
+if ( pp>mp_void ) {
+  @<Copy |pen_p(pp)| into stroked and filled nodes linked to |pp|@>;
+}
+if ( dp>mp_void ) {
+  @<Make stroked nodes linked to |dp| refer to |dash_p(dp)|@>;
+}
+
+
+@ @<Copy |cp|'s color into the colored objects linked to~|cp|@>=
+{ q=link(cp);
+  while ( q!=null ) { 
+    if ( has_color(q) ) {
+      red_val(q)=red_val(cp);
+      green_val(q)=green_val(cp);
+      blue_val(q)=blue_val(cp);
+      black_val(q)=black_val(cp);
+      color_model(q)=color_model(cp);
+    }
+    q=link(q);
+  }
+}
+
+@ @<Copy |pen_p(pp)| into stroked and filled nodes linked to |pp|@>=
+{ q=link(pp);
+  while ( q!=null ) {
+    if ( has_pen(q) ) {
+      if ( pen_p(q)!=null ) mp_toss_knot_list(mp, pen_p(q));
+      pen_p(q)=copy_pen(pen_p(pp));
+    }
+    q=link(q);
+  }
+}
+
+@ @<Make stroked nodes linked to |dp| refer to |dash_p(dp)|@>=
+{ q=link(dp);
+  while ( q!=null ) {
+    if ( type(q)==mp_stroked_code ) {
+      if ( dash_p(q)!=null ) delete_edge_ref(dash_p(q));
+      dash_p(q)=dash_p(dp);
+      dash_scale(q)=unity;
+      if ( dash_p(q)!=null ) add_edge_ref(dash_p(q));
+    }
+    q=link(q);
+  }
+}
+
+@ One of the things we need to do when we've parsed an \&{addto} or
+similar command is find the header of a supposed \&{picture} variable, given
+a token list for that variable.  Since the edge structure is about to be
+updated, we use |private_edges| to make sure that this is possible.
+
+@<Declare action procedures for use by |do_statement|@>=
+pointer mp_find_edges_var (MP mp, pointer t) ;
+
+@ @c pointer mp_find_edges_var (MP mp, pointer t) {
+  pointer p;
+  pointer cur_edges; /* the return value */
+  p=mp_find_variable(mp, t); cur_edges=null;
+  if ( p==null ) { 
+    mp_obliterated(mp, t); mp_put_get_error(mp);
+  } else if ( type(p)!=mp_picture_type )  { 
+    print_err("Variable "); mp_show_token_list(mp, t,null,1000,0);
+@.Variable x is the wrong type@>
+    mp_print(mp, " is the wrong type ("); 
+    mp_print_type(mp, type(p)); mp_print_char(mp, ')');
+    help2("I was looking for a \"known\" picture variable.")
+         ("So I'll not change anything just now."); 
+    mp_put_get_error(mp);
+  } else { 
+    value(p)=mp_private_edges(mp, value(p));
+    cur_edges=value(p);
+  }
+  mp_flush_node_list(mp, t);
+  return cur_edges;
+}
+
+@ @<Cases of |do_statement|...@>=
+case add_to_command: mp_do_add_to(mp); break;
+case bounds_command:mp_do_bounds(mp); break;
+
+@ @<Put each...@>=
+mp_primitive(mp, "clip",bounds_command,mp_start_clip_code);
+@:clip_}{\&{clip} primitive@>
+mp_primitive(mp, "setbounds",bounds_command,mp_start_bounds_code);
+@:set_bounds_}{\&{setbounds} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case bounds_command: 
+  if ( m==mp_start_clip_code ) mp_print(mp, "clip");
+  else mp_print(mp, "setbounds");
+  break;
+
+@ The following function parses the beginning of an \&{addto} or \&{clip}
+command: it expects a variable name followed by a token with |cur_cmd=sep|
+and then an expression.  The function returns the token list for the variable
+and stores the command modifier for the separator token in the global variable
+|last_add_type|.  We must be careful because this variable might get overwritten
+any time we call |get_x_next|.
+
+@<Glob...@>=
+quarterword last_add_type;
+  /* command modifier that identifies the last \&{addto} command */
+
+@ @<Declare action procedures for use by |do_statement|@>=
+pointer mp_start_draw_cmd (MP mp,quarterword sep) ;
+
+@ @c pointer mp_start_draw_cmd (MP mp,quarterword sep) {
+  pointer lhv; /* variable to add to left */
+  quarterword add_type=0; /* value to be returned in |last_add_type| */
+  lhv=null;
+  mp_get_x_next(mp); mp->var_flag=sep; mp_scan_primary(mp);
+  if ( mp->cur_type!=mp_token_list ) {
+    @<Abandon edges command because there's no variable@>;
+  } else  { 
+    lhv=mp->cur_exp; add_type=mp->cur_mod;
+    mp->cur_type=mp_vacuous; mp_get_x_next(mp); mp_scan_expression(mp);
+  }
+  mp->last_add_type=add_type;
+  return lhv;
+}
+
+@ @<Abandon edges command because there's no variable@>=
+{ exp_err("Not a suitable variable");
+@.Not a suitable variable@>
+  help4("At this point I needed to see the name of a picture variable.")
+    ("(Or perhaps you have indeed presented me with one; I might")
+    ("have missed it, if it wasn't followed by the proper token.)")
+    ("So I'll not change anything just now.");
+  mp_put_get_flush_error(mp, 0);
+}
+
+@ Here is an example of how to use |start_draw_cmd|.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_bounds (MP mp) ;
+
+@ @c void mp_do_bounds (MP mp) {
+  pointer lhv,lhe; /* variable on left, the corresponding edge structure */
+  pointer p; /* for list manipulation */
+  integer m; /* initial value of |cur_mod| */
+  m=mp->cur_mod;
+  lhv=mp_start_draw_cmd(mp, to_token);
+  if ( lhv!=null ) {
+    lhe=mp_find_edges_var(mp, lhv);
+    if ( lhe==null ) {
+      mp_flush_cur_exp(mp, 0);
+    } else if ( mp->cur_type!=mp_path_type ) {
+      exp_err("Improper `clip'");
+@.Improper `addto'@>
+      help2("This expression should have specified a known path.")
+        ("So I'll not change anything just now."); 
+      mp_put_get_flush_error(mp, 0);
+    } else if ( left_type(mp->cur_exp)==mp_endpoint ) {
+      @<Complain about a non-cycle@>;
+    } else {
+      @<Make |cur_exp| into a \&{setbounds} or clipping path and add it to |lhe|@>;
+    }
+  }
+}
+
+@ @<Complain about a non-cycle@>=
+{ print_err("Not a cycle");
+@.Not a cycle@>
+  help2("That contour should have ended with `..cycle' or `&cycle'.")
+    ("So I'll not change anything just now."); mp_put_get_error(mp);
+}
+
+@ @<Make |cur_exp| into a \&{setbounds} or clipping path and add...@>=
+{ p=mp_new_bounds_node(mp, mp->cur_exp,m);
+  link(p)=link(dummy_loc(lhe));
+  link(dummy_loc(lhe))=p;
+  if ( obj_tail(lhe)==dummy_loc(lhe) ) obj_tail(lhe)=p;
+  p=mp_get_node(mp, mp->gr_object_size[stop_type(m)]);
+  type(p)=stop_type(m);
+  link(obj_tail(lhe))=p;
+  obj_tail(lhe)=p;
+  mp_init_bbox(mp, lhe);
+}
+
+@ The |do_add_to| procedure is a little like |do_clip| but there are a lot more
+cases to deal with.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_add_to (MP mp) ;
+
+@ @c void mp_do_add_to (MP mp) {
+  pointer lhv,lhe; /* variable on left, the corresponding edge structure */
+  pointer p; /* the graphical object or list for |scan_with_list| to update */
+  pointer e; /* an edge structure to be merged */
+  quarterword add_type; /* |also_code|, |contour_code|, or |double_path_code| */
+  lhv=mp_start_draw_cmd(mp, thing_to_add); add_type=mp->last_add_type;
+  if ( lhv!=null ) {
+    if ( add_type==also_code ) {
+      @<Make sure the current expression is a suitable picture and set |e| and |p|
+       appropriately@>;
+    } else {
+      @<Create a graphical object |p| based on |add_type| and the current
+        expression@>;
+    }
+    mp_scan_with_list(mp, p);
+    @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>;
+  }
+}
+
+@ Setting |p:=null| causes the $\langle$with list$\rangle$ to be ignored;
+setting |e:=null| prevents anything from being added to |lhe|.
+
+@ @<Make sure the current expression is a suitable picture and set |e|...@>=
+{ 
+  p=null; e=null;
+  if ( mp->cur_type!=mp_picture_type ) {
+    exp_err("Improper `addto'");
+@.Improper `addto'@>
+    help2("This expression should have specified a known picture.")
+      ("So I'll not change anything just now."); mp_put_get_flush_error(mp, 0);
+  } else { 
+    e=mp_private_edges(mp, mp->cur_exp); mp->cur_type=mp_vacuous;
+    p=link(dummy_loc(e));
+  }
+}
+
+@ In this case |add_type<>also_code| so setting |p:=null| suppresses future
+attempts to add to the edge structure.
+
+@<Create a graphical object |p| based on |add_type| and the current...@>=
+{ e=null; p=null;
+  if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp);
+  if ( mp->cur_type!=mp_path_type ) {
+    exp_err("Improper `addto'");
+@.Improper `addto'@>
+    help2("This expression should have specified a known path.")
+      ("So I'll not change anything just now."); 
+    mp_put_get_flush_error(mp, 0);
+  } else if ( add_type==contour_code ) {
+    if ( left_type(mp->cur_exp)==mp_endpoint ) {
+      @<Complain about a non-cycle@>;
+    } else { 
+      p=mp_new_fill_node(mp, mp->cur_exp);
+      mp->cur_type=mp_vacuous;
+    }
+  } else { 
+    p=mp_new_stroked_node(mp, mp->cur_exp);
+    mp->cur_type=mp_vacuous;
+  }
+}
+
+@ @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>=
+lhe=mp_find_edges_var(mp, lhv);
+if ( lhe==null ) {
+  if ( (e==null)&&(p!=null) ) e=mp_toss_gr_object(mp, p);
+  if ( e!=null ) delete_edge_ref(e);
+} else if ( add_type==also_code ) {
+  if ( e!=null ) {
+    @<Merge |e| into |lhe| and delete |e|@>;
+  } else { 
+    do_nothing;
+  }
+} else if ( p!=null ) {
+  link(obj_tail(lhe))=p;
+  obj_tail(lhe)=p;
+  if ( add_type==double_path_code )
+    if ( pen_p(p)==null ) 
+      pen_p(p)=mp_get_pen_circle(mp, 0);
+}
+
+@ @<Merge |e| into |lhe| and delete |e|@>=
+{ if ( link(dummy_loc(e))!=null ) {
+    link(obj_tail(lhe))=link(dummy_loc(e));
+    obj_tail(lhe)=obj_tail(e);
+    obj_tail(e)=dummy_loc(e);
+    link(dummy_loc(e))=null;
+    mp_flush_dash_list(mp, lhe);
+  }
+  mp_toss_edges(mp, e);
+}
+
+@ @<Cases of |do_statement|...@>=
+case ship_out_command: mp_do_ship_out(mp); break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@<Declare the function called |tfm_check|@>
+@<Declare the \ps\ output procedures@>
+void mp_do_ship_out (MP mp) ;
+
+@ @c void mp_do_ship_out (MP mp) {
+  integer c; /* the character code */
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_picture_type ) {
+    @<Complain that it's not a known picture@>;
+  } else { 
+    c=mp_round_unscaled(mp, mp->internal[mp_char_code]) % 256;
+    if ( c<0 ) c=c+256;
+    @<Store the width information for character code~|c|@>;
+    mp_ship_out(mp, mp->cur_exp);
+    mp_flush_cur_exp(mp, 0);
+  }
+}
+
+@ @<Complain that it's not a known picture@>=
+{ 
+  exp_err("Not a known picture");
+  help1("I can only output known pictures.");
+  mp_put_get_flush_error(mp, 0);
+}
+
+@ The \&{everyjob} command simply assigns a nonzero value to the global variable
+|start_sym|.
+
+@<Cases of |do_statement|...@>=
+case every_job_command: 
+  mp_get_symbol(mp); mp->start_sym=mp->cur_sym; mp_get_x_next(mp);
+  break;
+
+@ @<Glob...@>=
+halfword start_sym; /* a symbolic token to insert at beginning of job */
+
+@ @<Set init...@>=
+mp->start_sym=0;
+
+@ Finally, we have only the ``message'' commands remaining.
+
+@d message_code 0
+@d err_message_code 1
+@d err_help_code 2
+@d filename_template_code 3
+@d print_with_leading_zeroes(A)  g = mp->pool_ptr;
+              mp_print_int(mp, (A)); g = mp->pool_ptr-g;
+              if ( f>g ) {
+                mp->pool_ptr = mp->pool_ptr - g;
+                while ( f>g ) {
+                  mp_print_char(mp, '0');
+                  decr(f);
+                  };
+                mp_print_int(mp, (A));
+              };
+              f = 0
+
+@<Put each...@>=
+mp_primitive(mp, "message",message_command,message_code);
+@:message_}{\&{message} primitive@>
+mp_primitive(mp, "errmessage",message_command,err_message_code);
+@:err_message_}{\&{errmessage} primitive@>
+mp_primitive(mp, "errhelp",message_command,err_help_code);
+@:err_help_}{\&{errhelp} primitive@>
+mp_primitive(mp, "filenametemplate",message_command,filename_template_code);
+@:filename_template_}{\&{filenametemplate} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case message_command: 
+  if ( m<err_message_code ) mp_print(mp, "message");
+  else if ( m==err_message_code ) mp_print(mp, "errmessage");
+  else if ( m==filename_template_code ) mp_print(mp, "filenametemplate");
+  else mp_print(mp, "errhelp");
+  break;
+
+@ @<Cases of |do_statement|...@>=
+case message_command: mp_do_message(mp); break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+@<Declare a procedure called |no_string_err|@>
+void mp_do_message (MP mp) ;
+
+@ 
+@c void mp_do_message (MP mp) {
+  int m; /* the type of message */
+  m=mp->cur_mod; mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_string_type )
+    mp_no_string_err(mp, "A message should be a known string expression.");
+  else {
+    switch (m) {
+    case message_code: 
+      mp_print_nl(mp, ""); mp_print_str(mp, mp->cur_exp);
+      break;
+    case err_message_code:
+      @<Print string |cur_exp| as an error message@>;
+      break;
+    case err_help_code:
+      @<Save string |cur_exp| as the |err_help|@>;
+      break;
+    case filename_template_code:
+      @<Save the filename template@>;
+      break;
+    } /* there are no other cases */
+  }
+  mp_flush_cur_exp(mp, 0);
+}
+
+@ @<Declare a procedure called |no_string_err|@>=
+void mp_no_string_err (MP mp, const char *s) { 
+   exp_err("Not a string");
+@.Not a string@>
+  help1(s);
+  mp_put_get_error(mp);
+}
+
+@ The global variable |err_help| is zero when the user has most recently
+given an empty help string, or if none has ever been given.
+
+@<Save string |cur_exp| as the |err_help|@>=
+{ 
+  if ( mp->err_help!=0 ) delete_str_ref(mp->err_help);
+  if ( length(mp->cur_exp)==0 ) mp->err_help=0;
+  else  { mp->err_help=mp->cur_exp; add_str_ref(mp->err_help); }
+}
+
+@ If \&{errmessage} occurs often in |mp_scroll_mode|, without user-defined
+\&{errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+@<Glob...@>=
+boolean long_help_seen; /* has the long \.{\\errmessage} help been used? */
+
+@ @<Set init...@>=mp->long_help_seen=false;
+
+@ @<Print string |cur_exp| as an error message@>=
+{ 
+  print_err(""); mp_print_str(mp, mp->cur_exp);
+  if ( mp->err_help!=0 ) {
+    mp->use_err_help=true;
+  } else if ( mp->long_help_seen ) { 
+    help1("(That was another `errmessage'.)") ; 
+  } else  { 
+   if ( mp->interaction<mp_error_stop_mode ) mp->long_help_seen=true;
+    help4("This error message was generated by an `errmessage'")
+     ("command, so I can\'t give any explicit help.")
+     ("Pretend that you're Miss Marple: Examine all clues,")
+@^Marple, Jane@>
+     ("and deduce the truth by inspired guesses.");
+  }
+  mp_put_get_error(mp); mp->use_err_help=false;
+}
+
+@ @<Cases of |do_statement|...@>=
+case write_command: mp_do_write(mp); break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_write (MP mp) ;
+
+@ @c void mp_do_write (MP mp) {
+  str_number t; /* the line of text to be written */
+  write_index n,n0; /* for searching |wr_fname| and |wr_file| arrays */
+  int old_setting; /* for saving |selector| during output */
+  mp_get_x_next(mp);
+  mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_string_type ) {
+    mp_no_string_err(mp, "The text to be written should be a known string expression");
+  } else if ( mp->cur_cmd!=to_token ) { 
+    print_err("Missing `to' clause");
+    help1("A write command should end with `to <filename>'");
+    mp_put_get_error(mp);
+  } else { 
+    t=mp->cur_exp; mp->cur_type=mp_vacuous;
+    mp_get_x_next(mp);
+    mp_scan_expression(mp);
+    if ( mp->cur_type!=mp_string_type )
+      mp_no_string_err(mp, "I can\'t write to that file name.  It isn't a known string");
+    else {
+      @<Write |t| to the file named by |cur_exp|@>;
+    }
+    delete_str_ref(t);
+  }
+  mp_flush_cur_exp(mp, 0);
+}
+
+@ @<Write |t| to the file named by |cur_exp|@>=
+{ 
+  @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if
+    |cur_exp| must be inserted@>;
+  if ( mp_str_vs_str(mp, t,mp->eof_line)==0 ) {
+    @<Record the end of file on |wr_file[n]|@>;
+  } else { 
+    old_setting=mp->selector;
+    mp->selector=n+write_file;
+    mp_print_str(mp, t); mp_print_ln(mp);
+    mp->selector = old_setting;
+  }
+}
+
+@ @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if...@>=
+{
+  char *fn = str(mp->cur_exp);
+  n=mp->write_files;
+  n0=mp->write_files;
+  while (mp_xstrcmp(fn,mp->wr_fname[n])!=0) { 
+    if ( n==0 ) { /* bottom reached */
+	  if ( n0==mp->write_files ) {
+        if ( mp->write_files<mp->max_write_files ) {
+          incr(mp->write_files);
+        } else {
+          void **wr_file;
+          char **wr_fname;
+	      write_index l,k;
+          l = mp->max_write_files + (mp->max_write_files>>2);
+          wr_file = xmalloc((l+1),sizeof(void *));
+          wr_fname = xmalloc((l+1),sizeof(char *));
+	      for (k=0;k<=l;k++) {
+            if (k<=mp->max_write_files) {
+   	          wr_file[k]=mp->wr_file[k]; 
+              wr_fname[k]=mp->wr_fname[k];
+            } else {
+   	          wr_file[k]=0; 
+              wr_fname[k]=NULL;
+            }
+          }
+	      xfree(mp->wr_file); xfree(mp->wr_fname);
+          mp->max_write_files = l;
+          mp->wr_file = wr_file;
+          mp->wr_fname = wr_fname;
+        }
+      }
+      n=n0;
+      mp_open_write_file(mp, fn ,n);
+    } else { 
+      decr(n);
+	  if ( mp->wr_fname[n]==NULL )  n0=n; 
+    }
+  }
+}
+
+@ @<Record the end of file on |wr_file[n]|@>=
+{ (mp->close_file)(mp,mp->wr_file[n]);
+  xfree(mp->wr_fname[n]);
+  mp->wr_fname[n]=NULL;
+  if ( n==mp->write_files-1 ) mp->write_files=n;
+}
+
+
+@* \[42] Writing font metric data.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too. One of \MP's duties is to
+write \.{TFM} files so that the user's fonts can readily be
+applied to typesetting.
+@:TFM files}{\.{TFM} files@>
+@^font metric files@>
+
+The information in a \.{TFM} file appears in a sequence of 8-bit bytes.
+Since the number of bytes is always a multiple of~4, we could
+also regard the file as a sequence of 32-bit words, but \MP\ uses the
+byte interpretation. The format of \.{TFM} files was designed by
+Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds
+@^Ramshaw, Lyle Harold@>
+of information in a compact but useful form.
+
+@<Glob...@>=
+void * tfm_file; /* the font metric output goes here */
+char * metric_file_name; /* full name of the font metric file */
+
+@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit
+integers that give the lengths of the various subsequent portions
+of the file. These twelve integers are, in order:
+$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr
+|lf|&length of the entire file, in words;\cr
+|lh|&length of the header data, in words;\cr
+|bc|&smallest character code in the font;\cr
+|ec|&largest character code in the font;\cr
+|nw|&number of words in the width table;\cr
+|nh|&number of words in the height table;\cr
+|nd|&number of words in the depth table;\cr
+|ni|&number of words in the italic correction table;\cr
+|nl|&number of words in the lig/kern table;\cr
+|nk|&number of words in the kern table;\cr
+|ne|&number of words in the extensible character table;\cr
+|np|&number of font parameter words.\cr}}$$
+They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|,
+|ne<=256|, and
+$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$
+Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|),
+and as few as 0 characters (if |bc=ec+1|).
+
+Incidentally, when two or more 8-bit bytes are combined to form an integer of
+16 or more bits, the most significant bytes appear first in the file.
+This is called BigEndian order.
+@^BigEndian order@>
+
+@ The rest of the \.{TFM} file may be regarded as a sequence of ten data
+arrays.
+
+The most important data type used here is a |fix_word|, which is
+a 32-bit representation of a binary fraction. A |fix_word| is a signed
+quantity, with the two's complement of the entire word used to represent
+negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the
+binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and
+the smallest is $-2048$. We will see below, however, that all but two of
+the |fix_word| values must lie between $-16$ and $+16$.
+
+@ The first data array is a block of header information, which contains
+general facts about the font. The header must contain at least two words,
+|header[0]| and |header[1]|, whose meaning is explained below.  Additional
+header information of use to other software routines might also be
+included, and \MP\ will generate it if the \.{headerbyte} command occurs.
+For example, 16 more words of header information are in use at the Xerox
+Palo Alto Research Center; the first ten specify the character coding
+scheme used (e.g., `\.{XEROX TEXT}' or `\.{TEX MATHSY}'), the next five
+give the font family name (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the
+last gives the ``face byte.''
+
+\yskip\hang|header[0]| is a 32-bit check sum that \MP\ will copy into
+the \.{GF} output file. This helps ensure consistency between files,
+since \TeX\ records the check sums from the \.{TFM}'s it reads, and these
+should match the check sums on actual fonts that are used.  The actual
+relation between this check sum and the rest of the \.{TFM} file is not
+important; the check sum is simply an identification number with the
+property that incompatible fonts almost always have distinct check sums.
+@^check sum@>
+
+\yskip\hang|header[1]| is a |fix_word| containing the design size of the
+font, in units of \TeX\ points. This number must be at least 1.0; it is
+fairly arbitrary, but usually the design size is 10.0 for a ``10 point''
+font, i.e., a font that was designed to look best at a 10-point size,
+whatever that really means. When a \TeX\ user asks for a font `\.{at}
+$\delta$ \.{pt}', the effect is to override the design size and replace it
+by $\delta$, and to multiply the $x$ and~$y$ coordinates of the points in
+the font image by a factor of $\delta$ divided by the design size.  {\sl
+All other dimensions in the\/ \.{TFM} file are |fix_word|\kern-1pt\
+numbers in design-size units.} Thus, for example, the value of |param[6]|,
+which defines the \.{em} unit, is often the |fix_word| value $2^{20}=1.0$,
+since many fonts have a design size equal to one em.  The other dimensions
+must be less than 16 design-size units in absolute value; thus,
+|header[1]| and |param[1]| are the only |fix_word| entries in the whole
+\.{TFM} file whose first byte might be something besides 0 or 255.
+@^design size@>
+
+@ Next comes the |char_info| array, which contains one |char_info_word|
+per character. Each word in this part of the file contains six fields
+packed into four bytes as follows.
+
+\yskip\hang first byte: |width_index| (8 bits)\par
+\hang second byte: |height_index| (4 bits) times 16, plus |depth_index|
+  (4~bits)\par
+\hang third byte: |italic_index| (6 bits) times 4, plus |tag|
+  (2~bits)\par
+\hang fourth byte: |remainder| (8 bits)\par
+\yskip\noindent
+The actual width of a character is \\{width}|[width_index]|, in design-size
+units; this is a device for compressing information, since many characters
+have the same width. Since it is quite common for many characters
+to have the same height, depth, or italic correction, the \.{TFM} format
+imposes a limit of 16 different heights, 16 different depths, and
+64 different italic corrections.
+
+Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]=
+\\{italic}[0]=0$ should always hold, so that an index of zero implies a
+value of zero.  The |width_index| should never be zero unless the
+character does not exist in the font, since a character is valid if and
+only if it lies between |bc| and |ec| and has a nonzero |width_index|.
+
+@ The |tag| field in a |char_info_word| has four values that explain how to
+interpret the |remainder| field.
+
+\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par
+\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning
+program starting at location |remainder| in the |lig_kern| array.\par
+\hang|tag=2| (|list_tag|) means that this character is part of a chain of
+characters of ascending sizes, and not the largest in the chain.  The
+|remainder| field gives the character code of the next larger character.\par
+\hang|tag=3| (|ext_tag|) means that this character code represents an
+extensible character, i.e., a character that is built up of smaller pieces
+so that it can be made arbitrarily large. The pieces are specified in
+|exten[remainder]|.\par
+\yskip\noindent
+Characters with |tag=2| and |tag=3| are treated as characters with |tag=0|
+unless they are used in special circumstances in math formulas. For example,
+\TeX's \.{\\sum} operation looks for a |list_tag|, and the \.{\\left}
+operation looks for both |list_tag| and |ext_tag|.
+
+@d no_tag 0 /* vanilla character */
+@d lig_tag 1 /* character has a ligature/kerning program */
+@d list_tag 2 /* character has a successor in a charlist */
+@d ext_tag 3 /* character is extensible */
+
+@ The |lig_kern| array contains instructions in a simple programming language
+that explains what to do for special letter pairs. Each word in this array is a
+|lig_kern_command| of four bytes.
+
+\yskip\hang first byte: |skip_byte|, indicates that this is the final program
+  step if the byte is 128 or more, otherwise the next step is obtained by
+  skipping this number of intervening steps.\par
+\hang second byte: |next_char|, ``if |next_char| follows the current character,
+  then perform the operation and stop, otherwise continue.''\par
+\hang third byte: |op_byte|, indicates a ligature step if less than~128,
+  a kern step otherwise.\par
+\hang fourth byte: |remainder|.\par
+\yskip\noindent
+In a kern step, an
+additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted
+between the current character and |next_char|. This amount is
+often negative, so that the characters are brought closer together
+by kerning; but it might be positive.
+
+There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where
+$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is
+|remainder| is inserted between the current character and |next_char|;
+then the current character is deleted if $b=0$, and |next_char| is
+deleted if $c=0$; then we pass over $a$~characters to reach the next
+current character (which may have a ligature/kerning program of its own).
+
+If the very first instruction of the |lig_kern| array has |skip_byte=255|,
+the |next_char| byte is the so-called right boundary character of this font;
+the value of |next_char| need not lie between |bc| and~|ec|.
+If the very last instruction of the |lig_kern| array has |skip_byte=255|,
+there is a special ligature/kerning program for a left boundary character,
+beginning at location |256*op_byte+remainder|.
+The interpretation is that \TeX\ puts implicit boundary characters
+before and after each consecutive string of characters from the same font.
+These implicit characters do not appear in the output, but they can affect
+ligatures and kerning.
+
+If the very first instruction of a character's |lig_kern| program has
+|skip_byte>128|, the program actually begins in location
+|256*op_byte+remainder|. This feature allows access to large |lig_kern|
+arrays, because the first instruction must otherwise
+appear in a location |<=255|.
+
+Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy
+the condition
+$$\hbox{|256*op_byte+remainder<nl|.}$$
+If such an instruction is encountered during
+normal program execution, it denotes an unconditional halt; no ligature
+command is performed.
+
+@d stop_flag (128)
+  /* value indicating `\.{STOP}' in a lig/kern program */
+@d kern_flag (128) /* op code for a kern step */
+@d skip_byte(A) mp->lig_kern[(A)].b0
+@d next_char(A) mp->lig_kern[(A)].b1
+@d op_byte(A) mp->lig_kern[(A)].b2
+@d rem_byte(A) mp->lig_kern[(A)].b3
+
+@ Extensible characters are specified by an |extensible_recipe|, which
+consists of four bytes called |top|, |mid|, |bot|, and |rep| (in this
+order). These bytes are the character codes of individual pieces used to
+build up a large symbol.  If |top|, |mid|, or |bot| are zero, they are not
+present in the built-up result. For example, an extensible vertical line is
+like an extensible bracket, except that the top and bottom pieces are missing.
+
+Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box
+if the piece isn't present. Then the extensible characters have the form
+$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent;
+in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
+The width of the extensible character is the width of $R$; and the
+height-plus-depth is the sum of the individual height-plus-depths of the
+components used, since the pieces are butted together in a vertical list.
+
+@d ext_top(A) mp->exten[(A)].b0 /* |top| piece in a recipe */
+@d ext_mid(A) mp->exten[(A)].b1 /* |mid| piece in a recipe */
+@d ext_bot(A) mp->exten[(A)].b2 /* |bot| piece in a recipe */
+@d ext_rep(A) mp->exten[(A)].b3 /* |rep| piece in a recipe */
+
+@ The final portion of a \.{TFM} file is the |param| array, which is another
+sequence of |fix_word| values.
+
+\yskip\hang|param[1]=slant| is the amount of italic slant, which is used
+to help position accents. For example, |slant=.25| means that when you go
+up one unit, you also go .25 units to the right. The |slant| is a pure
+number; it is the only |fix_word| other than the design size itself that is
+not scaled by the design size.
+@^design size@>
+
+\hang|param[2]=space| is the normal spacing between words in text.
+Note that character 040 in the font need not have anything to do with
+blank spaces.
+
+\hang|param[3]=space_stretch| is the amount of glue stretching between words.
+
+\hang|param[4]=space_shrink| is the amount of glue shrinking between words.
+
+\hang|param[5]=x_height| is the size of one ex in the font; it is also
+the height of letters for which accents don't have to be raised or lowered.
+
+\hang|param[6]=quad| is the size of one em in the font.
+
+\hang|param[7]=extra_space| is the amount added to |param[2]| at the
+ends of sentences.
+
+\yskip\noindent
+If fewer than seven parameters are present, \TeX\ sets the missing parameters
+to zero.
+
+@d slant_code 1
+@d space_code 2
+@d space_stretch_code 3
+@d space_shrink_code 4
+@d x_height_code 5
+@d quad_code 6
+@d extra_space_code 7
+
+@ So that is what \.{TFM} files hold. One of \MP's duties is to output such
+information, and it does this all at once at the end of a job.
+In order to prepare for such frenetic activity, it squirrels away the
+necessary facts in various arrays as information becomes available.
+
+Character dimensions (\&{charwd}, \&{charht}, \&{chardp}, and \&{charic})
+are stored respectively in |tfm_width|, |tfm_height|, |tfm_depth|, and
+|tfm_ital_corr|. Other information about a character (e.g., about
+its ligatures or successors) is accessible via the |char_tag| and
+|char_remainder| arrays. Other information about the font as a whole
+is kept in additional arrays called |header_byte|, |lig_kern|,
+|kern|, |exten|, and |param|.
+
+@d max_tfm_int 32510
+@d undefined_label max_tfm_int /* an undefined local label */
+
+@<Glob...@>=
+#define TFM_ITEMS 257
+eight_bits bc;
+eight_bits ec; /* smallest and largest character codes shipped out */
+scaled tfm_width[TFM_ITEMS]; /* \&{charwd} values */
+scaled tfm_height[TFM_ITEMS]; /* \&{charht} values */
+scaled tfm_depth[TFM_ITEMS]; /* \&{chardp} values */
+scaled tfm_ital_corr[TFM_ITEMS]; /* \&{charic} values */
+boolean char_exists[TFM_ITEMS]; /* has this code been shipped out? */
+int char_tag[TFM_ITEMS]; /* |remainder| category */
+int char_remainder[TFM_ITEMS]; /* the |remainder| byte */
+char *header_byte; /* bytes of the \.{TFM} header */
+int header_last; /* last initialized \.{TFM} header byte */
+int header_size; /* size of the \.{TFM} header */
+four_quarters *lig_kern; /* the ligature/kern table */
+short nl; /* the number of ligature/kern steps so far */
+scaled *kern; /* distinct kerning amounts */
+short nk; /* the number of distinct kerns so far */
+four_quarters exten[TFM_ITEMS]; /* extensible character recipes */
+short ne; /* the number of extensible characters so far */
+scaled *param; /* \&{fontinfo} parameters */
+short np; /* the largest \&{fontinfo} parameter specified so far */
+short nw;short nh;short nd;short ni; /* sizes of \.{TFM} subtables */
+short skip_table[TFM_ITEMS]; /* local label status */
+boolean lk_started; /* has there been a lig/kern step in this command yet? */
+integer bchar; /* right boundary character */
+short bch_label; /* left boundary starting location */
+short ll;short lll; /* registers used for lig/kern processing */
+short label_loc[257]; /* lig/kern starting addresses */
+eight_bits label_char[257]; /* characters for |label_loc| */
+short label_ptr; /* highest position occupied in |label_loc| */
+
+@ @<Allocate or initialize ...@>=
+mp->header_last = 0; mp->header_size = 128; /* just for init */
+mp->header_byte = xmalloc(mp->header_size, sizeof(char));
+mp->lig_kern = NULL; /* allocated when needed */
+mp->kern = NULL; /* allocated when needed */ 
+mp->param = NULL; /* allocated when needed */
+
+@ @<Dealloc variables@>=
+xfree(mp->header_byte);
+xfree(mp->lig_kern);
+xfree(mp->kern);
+xfree(mp->param);
+
+@ @<Set init...@>=
+for (k=0;k<= 255;k++ ) {
+  mp->tfm_width[k]=0; mp->tfm_height[k]=0; mp->tfm_depth[k]=0; mp->tfm_ital_corr[k]=0;
+  mp->char_exists[k]=false; mp->char_tag[k]=no_tag; mp->char_remainder[k]=0;
+  mp->skip_table[k]=undefined_label;
+}
+memset(mp->header_byte,0,mp->header_size);
+mp->bc=255; mp->ec=0; mp->nl=0; mp->nk=0; mp->ne=0; mp->np=0;
+mp->internal[mp_boundary_char]=-unity;
+mp->bch_label=undefined_label;
+mp->label_loc[0]=-1; mp->label_ptr=0;
+
+@ @<Declarations@>=
+scaled mp_tfm_check (MP mp,small_number m) ;
+
+@ @<Declare the function called |tfm_check|@>=
+scaled mp_tfm_check (MP mp,small_number m) {
+  if ( abs(mp->internal[m])>=fraction_half ) {
+    print_err("Enormous "); mp_print(mp, mp->int_name[m]);
+@.Enormous charwd...@>
+@.Enormous chardp...@>
+@.Enormous charht...@>
+@.Enormous charic...@>
+@.Enormous designsize...@>
+    mp_print(mp, " has been reduced");
+    help1("Font metric dimensions must be less than 2048pt.");
+    mp_put_get_error(mp);
+    if ( mp->internal[m]>0 ) return (fraction_half-1);
+    else return (1-fraction_half);
+  } else {
+    return mp->internal[m];
+  }
+}
+
+@ @<Store the width information for character code~|c|@>=
+if ( c<mp->bc ) mp->bc=c;
+if ( c>mp->ec ) mp->ec=c;
+mp->char_exists[c]=true;
+mp->tfm_width[c]=mp_tfm_check(mp, mp_char_wd);
+mp->tfm_height[c]=mp_tfm_check(mp, mp_char_ht);
+mp->tfm_depth[c]=mp_tfm_check(mp, mp_char_dp);
+mp->tfm_ital_corr[c]=mp_tfm_check(mp, mp_char_ic)
+
+@ Now let's consider \MP's special \.{TFM}-oriented commands.
+
+@<Cases of |do_statement|...@>=
+case tfm_command: mp_do_tfm_command(mp); break;
+
+@ @d char_list_code 0
+@d lig_table_code 1
+@d extensible_code 2
+@d header_byte_code 3
+@d font_dimen_code 4
+
+@<Put each...@>=
+mp_primitive(mp, "charlist",tfm_command,char_list_code);
+@:char_list_}{\&{charlist} primitive@>
+mp_primitive(mp, "ligtable",tfm_command,lig_table_code);
+@:lig_table_}{\&{ligtable} primitive@>
+mp_primitive(mp, "extensible",tfm_command,extensible_code);
+@:extensible_}{\&{extensible} primitive@>
+mp_primitive(mp, "headerbyte",tfm_command,header_byte_code);
+@:header_byte_}{\&{headerbyte} primitive@>
+mp_primitive(mp, "fontdimen",tfm_command,font_dimen_code);
+@:font_dimen_}{\&{fontdimen} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case tfm_command: 
+  switch (m) {
+  case char_list_code:mp_print(mp, "charlist"); break;
+  case lig_table_code:mp_print(mp, "ligtable"); break;
+  case extensible_code:mp_print(mp, "extensible"); break;
+  case header_byte_code:mp_print(mp, "headerbyte"); break;
+  default: mp_print(mp, "fontdimen"); break;
+  }
+  break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+eight_bits mp_get_code (MP mp) ;
+
+@ @c eight_bits mp_get_code (MP mp) { /* scans a character code value */
+  integer c; /* the code value found */
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type==mp_known ) { 
+    c=mp_round_unscaled(mp, mp->cur_exp);
+    if ( c>=0 ) if ( c<256 ) return c;
+  } else if ( mp->cur_type==mp_string_type ) {
+    if ( length(mp->cur_exp)==1 )  { 
+      c=mp->str_pool[mp->str_start[mp->cur_exp]];
+      return c;
+    }
+  }
+  exp_err("Invalid code has been replaced by 0");
+@.Invalid code...@>
+  help2("I was looking for a number between 0 and 255, or for a")
+       ("string of length 1. Didn't find it; will use 0 instead.");
+  mp_put_get_flush_error(mp, 0); c=0;
+  return c;
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_set_tag (MP mp,halfword c, small_number t, halfword r) ;
+
+@ @c void mp_set_tag (MP mp,halfword c, small_number t, halfword r) { 
+  if ( mp->char_tag[c]==no_tag ) {
+    mp->char_tag[c]=t; mp->char_remainder[c]=r;
+    if ( t==lig_tag ){ 
+      incr(mp->label_ptr); mp->label_loc[mp->label_ptr]=r; 
+      mp->label_char[mp->label_ptr]=c;
+    }
+  } else {
+    @<Complain about a character tag conflict@>;
+  }
+}
+
+@ @<Complain about a character tag conflict@>=
+{ 
+  print_err("Character ");
+  if ( (c>' ')&&(c<127) ) mp_print_char(mp,c);
+  else if ( c==256 ) mp_print(mp, "||");
+  else  { mp_print(mp, "code "); mp_print_int(mp, c); };
+  mp_print(mp, " is already ");
+@.Character c is already...@>
+  switch (mp->char_tag[c]) {
+  case lig_tag: mp_print(mp, "in a ligtable"); break;
+  case list_tag: mp_print(mp, "in a charlist"); break;
+  case ext_tag: mp_print(mp, "extensible"); break;
+  } /* there are no other cases */
+  help2("It's not legal to label a character more than once.")
+    ("So I'll not change anything just now.");
+  mp_put_get_error(mp); 
+}
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_tfm_command (MP mp) ;
+
+@ @c void mp_do_tfm_command (MP mp) {
+  int c,cc; /* character codes */
+  int k; /* index into the |kern| array */
+  int j; /* index into |header_byte| or |param| */
+  switch (mp->cur_mod) {
+  case char_list_code: 
+    c=mp_get_code(mp);
+     /* we will store a list of character successors */
+    while ( mp->cur_cmd==colon )   { 
+      cc=mp_get_code(mp); mp_set_tag(mp, c,list_tag,cc); c=cc;
+    };
+    break;
+  case lig_table_code: 
+    if (mp->lig_kern==NULL) 
+       mp->lig_kern = xmalloc((max_tfm_int+1),sizeof(four_quarters));
+    if (mp->kern==NULL) 
+       mp->kern = xmalloc((max_tfm_int+1),sizeof(scaled));
+    @<Store a list of ligature/kern steps@>;
+    break;
+  case extensible_code: 
+    @<Define an extensible recipe@>;
+    break;
+  case header_byte_code: 
+  case font_dimen_code: 
+    c=mp->cur_mod; mp_get_x_next(mp);
+    mp_scan_expression(mp);
+    if ( (mp->cur_type!=mp_known)||(mp->cur_exp<half_unit) ) {
+      exp_err("Improper location");
+@.Improper location@>
+      help2("I was looking for a known, positive number.")
+       ("For safety's sake I'll ignore the present command.");
+      mp_put_get_error(mp);
+    } else  { 
+      j=mp_round_unscaled(mp, mp->cur_exp);
+      if ( mp->cur_cmd!=colon ) {
+        mp_missing_err(mp, ":");
+@.Missing `:'@>
+        help1("A colon should follow a headerbyte or fontinfo location.");
+        mp_back_error(mp);
+      }
+      if ( c==header_byte_code ) { 
+	@<Store a list of header bytes@>;
+      } else {     
+        if (mp->param==NULL) 
+          mp->param = xmalloc((max_tfm_int+1),sizeof(scaled));
+        @<Store a list of font dimensions@>;
+      }
+    }
+    break;
+  } /* there are no other cases */
+}
+
+@ @<Store a list of ligature/kern steps@>=
+{ 
+  mp->lk_started=false;
+CONTINUE: 
+  mp_get_x_next(mp);
+  if ((mp->cur_cmd==skip_to)&& mp->lk_started )
+    @<Process a |skip_to| command and |goto done|@>;
+  if ( mp->cur_cmd==bchar_label ) { c=256; mp->cur_cmd=colon; }
+  else { mp_back_input(mp); c=mp_get_code(mp); };
+  if ((mp->cur_cmd==colon)||(mp->cur_cmd==double_colon)) {
+    @<Record a label in a lig/kern subprogram and |goto continue|@>;
+  }
+  if ( mp->cur_cmd==lig_kern_token ) { 
+    @<Compile a ligature/kern command@>; 
+  } else  { 
+    print_err("Illegal ligtable step");
+@.Illegal ligtable step@>
+    help1("I was looking for `=:' or `kern' here.");
+    mp_back_error(mp); next_char(mp->nl)=qi(0); 
+    op_byte(mp->nl)=qi(0); rem_byte(mp->nl)=qi(0);
+    skip_byte(mp->nl)=stop_flag+1; /* this specifies an unconditional stop */
+  }
+  if ( mp->nl==max_tfm_int) mp_fatal_error(mp, "ligtable too large");
+  incr(mp->nl);
+  if ( mp->cur_cmd==comma ) goto CONTINUE;
+  if ( skip_byte(mp->nl-1)<stop_flag ) skip_byte(mp->nl-1)=stop_flag;
+}
+DONE:
+
+@ @<Put each...@>=
+mp_primitive(mp, "=:",lig_kern_token,0);
+@:=:_}{\.{=:} primitive@>
+mp_primitive(mp, "=:|",lig_kern_token,1);
+@:=:/_}{\.{=:\char'174} primitive@>
+mp_primitive(mp, "=:|>",lig_kern_token,5);
+@:=:/>_}{\.{=:\char'174>} primitive@>
+mp_primitive(mp, "|=:",lig_kern_token,2);
+@:=:/_}{\.{\char'174=:} primitive@>
+mp_primitive(mp, "|=:>",lig_kern_token,6);
+@:=:/>_}{\.{\char'174=:>} primitive@>
+mp_primitive(mp, "|=:|",lig_kern_token,3);
+@:=:/_}{\.{\char'174=:\char'174} primitive@>
+mp_primitive(mp, "|=:|>",lig_kern_token,7);
+@:=:/>_}{\.{\char'174=:\char'174>} primitive@>
+mp_primitive(mp, "|=:|>>",lig_kern_token,11);
+@:=:/>_}{\.{\char'174=:\char'174>>} primitive@>
+mp_primitive(mp, "kern",lig_kern_token,128);
+@:kern_}{\&{kern} primitive@>
+
+@ @<Cases of |print_cmd...@>=
+case lig_kern_token: 
+  switch (m) {
+  case 0:mp_print(mp, "=:"); break;
+  case 1:mp_print(mp, "=:|"); break;
+  case 2:mp_print(mp, "|=:"); break;
+  case 3:mp_print(mp, "|=:|"); break;
+  case 5:mp_print(mp, "=:|>"); break;
+  case 6:mp_print(mp, "|=:>"); break;
+  case 7:mp_print(mp, "|=:|>"); break;
+  case 11:mp_print(mp, "|=:|>>"); break;
+  default: mp_print(mp, "kern"); break;
+  }
+  break;
+
+@ Local labels are implemented by maintaining the |skip_table| array,
+where |skip_table[c]| is either |undefined_label| or the address of the
+most recent lig/kern instruction that skips to local label~|c|. In the
+latter case, the |skip_byte| in that instruction will (temporarily)
+be zero if there were no prior skips to this label, or it will be the
+distance to the prior skip.
+
+We may need to cancel skips that span more than 127 lig/kern steps.
+
+@d cancel_skips(A) mp->ll=(A);
+  do {  
+    mp->lll=qo(skip_byte(mp->ll)); 
+    skip_byte(mp->ll)=stop_flag; mp->ll=mp->ll-mp->lll;
+  } while (mp->lll!=0)
+@d skip_error(A) { print_err("Too far to skip");
+@.Too far to skip@>
+  help1("At most 127 lig/kern steps can separate skipto1 from 1::.");
+  mp_error(mp); cancel_skips((A));
+  }
+
+@<Process a |skip_to| command and |goto done|@>=
+{ 
+  c=mp_get_code(mp);
+  if ( mp->nl-mp->skip_table[c]>128 ) {
+    skip_error(mp->skip_table[c]); mp->skip_table[c]=undefined_label;
+  }
+  if ( mp->skip_table[c]==undefined_label ) skip_byte(mp->nl-1)=qi(0);
+  else skip_byte(mp->nl-1)=qi(mp->nl-mp->skip_table[c]-1);
+  mp->skip_table[c]=mp->nl-1; goto DONE;
+}
+
+@ @<Record a label in a lig/kern subprogram and |goto continue|@>=
+{ 
+  if ( mp->cur_cmd==colon ) {
+    if ( c==256 ) mp->bch_label=mp->nl;
+    else mp_set_tag(mp, c,lig_tag,mp->nl);
+  } else if ( mp->skip_table[c]<undefined_label ) {
+    mp->ll=mp->skip_table[c]; mp->skip_table[c]=undefined_label;
+    do {  
+      mp->lll=qo(skip_byte(mp->ll));
+      if ( mp->nl-mp->ll>128 ) {
+        skip_error(mp->ll); goto CONTINUE;
+      }
+      skip_byte(mp->ll)=qi(mp->nl-mp->ll-1); mp->ll=mp->ll-mp->lll;
+    } while (mp->lll!=0);
+  }
+  goto CONTINUE;
+}
+
+@ @<Compile a ligature/kern...@>=
+{ 
+  next_char(mp->nl)=qi(c); skip_byte(mp->nl)=qi(0);
+  if ( mp->cur_mod<128 ) { /* ligature op */
+    op_byte(mp->nl)=qi(mp->cur_mod); rem_byte(mp->nl)=qi(mp_get_code(mp));
+  } else { 
+    mp_get_x_next(mp); mp_scan_expression(mp);
+    if ( mp->cur_type!=mp_known ) {
+      exp_err("Improper kern");
+@.Improper kern@>
+      help2("The amount of kern should be a known numeric value.")
+        ("I'm zeroing this one. Proceed, with fingers crossed.");
+      mp_put_get_flush_error(mp, 0);
+    }
+    mp->kern[mp->nk]=mp->cur_exp;
+    k=0; 
+    while ( mp->kern[k]!=mp->cur_exp ) incr(k);
+    if ( k==mp->nk ) {
+      if ( mp->nk==max_tfm_int ) mp_fatal_error(mp, "too many TFM kerns");
+      incr(mp->nk);
+    }
+    op_byte(mp->nl)=kern_flag+(k / 256);
+    rem_byte(mp->nl)=qi((k % 256));
+  }
+  mp->lk_started=true;
+}
+
+@ @d missing_extensible_punctuation(A) 
+  { mp_missing_err(mp, (A));
+@.Missing `\char`\#'@>
+  help1("I'm processing `extensible c: t,m,b,r'."); mp_back_error(mp);
+  }
+
+@<Define an extensible recipe@>=
+{ 
+  if ( mp->ne==256 ) mp_fatal_error(mp, "too many extensible recipies");
+  c=mp_get_code(mp); mp_set_tag(mp, c,ext_tag,mp->ne);
+  if ( mp->cur_cmd!=colon ) missing_extensible_punctuation(":");
+  ext_top(mp->ne)=qi(mp_get_code(mp));
+  if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(",");
+  ext_mid(mp->ne)=qi(mp_get_code(mp));
+  if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(",");
+  ext_bot(mp->ne)=qi(mp_get_code(mp));
+  if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(",");
+  ext_rep(mp->ne)=qi(mp_get_code(mp));
+  incr(mp->ne);
+}
+
+@ The header could contain ASCII zeroes, so can't use |strdup|.
+
+@<Store a list of header bytes@>=
+do {  
+  if ( j>=mp->header_size ) {
+    int l = mp->header_size + (mp->header_size >> 2);
+    char *t = xmalloc(l,sizeof(char));
+    memset(t,0,l); 
+    memcpy(t,mp->header_byte,mp->header_size);
+    xfree (mp->header_byte);
+    mp->header_byte = t;
+    mp->header_size = l;
+  }
+  mp->header_byte[j]=mp_get_code(mp); 
+  incr(j); incr(mp->header_last);
+} while (mp->cur_cmd==comma)
+
+@ @<Store a list of font dimensions@>=
+do {  
+  if ( j>max_tfm_int ) mp_fatal_error(mp, "too many fontdimens");
+  while ( j>mp->np ) { incr(mp->np); mp->param[mp->np]=0; };
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_known ){ 
+    exp_err("Improper font parameter");
+@.Improper font parameter@>
+    help1("I'm zeroing this one. Proceed, with fingers crossed.");
+    mp_put_get_flush_error(mp, 0);
+  }
+  mp->param[j]=mp->cur_exp; incr(j);
+} while (mp->cur_cmd==comma)
+
+@ OK: We've stored all the data that is needed for the \.{TFM} file.
+All that remains is to output it in the correct format.
+
+An interesting problem needs to be solved in this connection, because
+the \.{TFM} format allows at most 256~widths, 16~heights, 16~depths,
+and 64~italic corrections. If the data has more distinct values than
+this, we want to meet the necessary restrictions by perturbing the
+given values as little as possible.
+
+\MP\ solves this problem in two steps. First the values of a given
+kind (widths, heights, depths, or italic corrections) are sorted;
+then the list of sorted values is perturbed, if necessary.
+
+The sorting operation is facilitated by having a special node of
+essentially infinite |value| at the end of the current list.
+
+@<Initialize table entries...@>=
+value(inf_val)=fraction_four;
+
+@ Straight linear insertion is good enough for sorting, since the lists
+are usually not terribly long. As we work on the data, the current list
+will start at |link(temp_head)| and end at |inf_val|; the nodes in this
+list will be in increasing order of their |value| fields.
+
+Given such a list, the |sort_in| function takes a value and returns a pointer
+to where that value can be found in the list. The value is inserted in
+the proper place, if necessary.
+
+At the time we need to do these operations, most of \MP's work has been
+completed, so we will have plenty of memory to play with. The value nodes
+that are allocated for sorting will never be returned to free storage.
+
+@d clear_the_list link(temp_head)=inf_val
+
+@c pointer mp_sort_in (MP mp,scaled v) {
+  pointer p,q,r; /* list manipulation registers */
+  p=temp_head;
+  while (1) { 
+    q=link(p);
+    if ( v<=value(q) ) break;
+    p=q;
+  }
+  if ( v<value(q) ) {
+    r=mp_get_node(mp, value_node_size); value(r)=v; link(r)=q; link(p)=r;
+  }
+  return link(p);
+}
+
+@ Now we come to the interesting part, where we reduce the list if necessary
+until it has the required size. The |min_cover| routine is basic to this
+process; it computes the minimum number~|m| such that the values of the
+current sorted list can be covered by |m|~intervals of width~|d|. It
+also sets the global value |perturbation| to the smallest value $d'>d$
+such that the covering found by this algorithm would be different.
+
+In particular, |min_cover(0)| returns the number of distinct values in the
+current list and sets |perturbation| to the minimum distance between
+adjacent values.
+
+@c integer mp_min_cover (MP mp,scaled d) {
+  pointer p; /* runs through the current list */
+  scaled l; /* the least element covered by the current interval */
+  integer m; /* lower bound on the size of the minimum cover */
+  m=0; p=link(temp_head); mp->perturbation=el_gordo;
+  while ( p!=inf_val ){ 
+    incr(m); l=value(p);
+    do {  p=link(p); } while (value(p)<=l+d);
+    if ( value(p)-l<mp->perturbation ) 
+      mp->perturbation=value(p)-l;
+  }
+  return m;
+}
+
+@ @<Glob...@>=
+scaled perturbation; /* quantity related to \.{TFM} rounding */
+integer excess; /* the list is this much too long */
+
+@ The smallest |d| such that a given list can be covered with |m| intervals
+is determined by the |threshold| routine, which is sort of an inverse
+to |min_cover|. The idea is to increase the interval size rapidly until
+finding the range, then to go sequentially until the exact borderline has
+been discovered.
+
+@c scaled mp_threshold (MP mp,integer m) {
+  scaled d; /* lower bound on the smallest interval size */
+  mp->excess=mp_min_cover(mp, 0)-m;
+  if ( mp->excess<=0 ) {
+    return 0;
+  } else  { 
+    do {  
+      d=mp->perturbation;
+    } while (mp_min_cover(mp, d+d)>m);
+    while ( mp_min_cover(mp, d)>m ) 
+      d=mp->perturbation;
+    return d;
+  }
+}
+
+@ The |skimp| procedure reduces the current list to at most |m| entries,
+by changing values if necessary. It also sets |info(p):=k| if |value(p)|
+is the |k|th distinct value on the resulting list, and it sets
+|perturbation| to the maximum amount by which a |value| field has
+been changed. The size of the resulting list is returned as the
+value of |skimp|.
+
+@c integer mp_skimp (MP mp,integer m) {
+  scaled d; /* the size of intervals being coalesced */
+  pointer p,q,r; /* list manipulation registers */
+  scaled l; /* the least value in the current interval */
+  scaled v; /* a compromise value */
+  d=mp_threshold(mp, m); mp->perturbation=0;
+  q=temp_head; m=0; p=link(temp_head);
+  while ( p!=inf_val ) {
+    incr(m); l=value(p); info(p)=m;
+    if ( value(link(p))<=l+d ) {
+      @<Replace an interval of values by its midpoint@>;
+    }
+    q=p; p=link(p);
+  }
+  return m;
+}
+
+@ @<Replace an interval...@>=
+{ 
+  do {  
+    p=link(p); info(p)=m;
+    decr(mp->excess); if ( mp->excess==0 ) d=0;
+  } while (value(link(p))<=l+d);
+  v=l+halfp(value(p)-l);
+  if ( value(p)-v>mp->perturbation ) 
+    mp->perturbation=value(p)-v;
+  r=q;
+  do {  
+    r=link(r); value(r)=v;
+  } while (r!=p);
+  link(q)=p; /* remove duplicate values from the current list */
+}
+
+@ A warning message is issued whenever something is perturbed by
+more than 1/16\thinspace pt.
+
+@c void mp_tfm_warning (MP mp,small_number m) { 
+  mp_print_nl(mp, "(some "); 
+  mp_print(mp, mp->int_name[m]);
+@.some charwds...@>
+@.some chardps...@>
+@.some charhts...@>
+@.some charics...@>
+  mp_print(mp, " values had to be adjusted by as much as ");
+  mp_print_scaled(mp, mp->perturbation); mp_print(mp, "pt)");
+}
+
+@ Here's an example of how we use these routines.
+The width data needs to be perturbed only if there are 256 distinct
+widths, but \MP\ must check for this case even though it is
+highly unusual.
+
+An integer variable |k| will be defined when we use this code.
+The |dimen_head| array will contain pointers to the sorted
+lists of dimensions.
+
+@<Massage the \.{TFM} widths@>=
+clear_the_list;
+for (k=mp->bc;k<=mp->ec;k++)  {
+  if ( mp->char_exists[k] )
+    mp->tfm_width[k]=mp_sort_in(mp, mp->tfm_width[k]);
+}
+mp->nw=mp_skimp(mp, 255)+1; mp->dimen_head[1]=link(temp_head);
+if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_wd)
+
+@ @<Glob...@>=
+pointer dimen_head[5]; /* lists of \.{TFM} dimensions */
+
+@ Heights, depths, and italic corrections are different from widths
+not only because their list length is more severely restricted, but
+also because zero values do not need to be put into the lists.
+
+@<Massage the \.{TFM} heights, depths, and italic corrections@>=
+clear_the_list;
+for (k=mp->bc;k<=mp->ec;k++) {
+  if ( mp->char_exists[k] ) {
+    if ( mp->tfm_height[k]==0 ) mp->tfm_height[k]=zero_val;
+    else mp->tfm_height[k]=mp_sort_in(mp, mp->tfm_height[k]);
+  }
+}
+mp->nh=mp_skimp(mp, 15)+1; mp->dimen_head[2]=link(temp_head);
+if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_ht);
+clear_the_list;
+for (k=mp->bc;k<=mp->ec;k++) {
+  if ( mp->char_exists[k] ) {
+    if ( mp->tfm_depth[k]==0 ) mp->tfm_depth[k]=zero_val;
+    else mp->tfm_depth[k]=mp_sort_in(mp, mp->tfm_depth[k]);
+  }
+}
+mp->nd=mp_skimp(mp, 15)+1; mp->dimen_head[3]=link(temp_head);
+if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_dp);
+clear_the_list;
+for (k=mp->bc;k<=mp->ec;k++) {
+  if ( mp->char_exists[k] ) {
+    if ( mp->tfm_ital_corr[k]==0 ) mp->tfm_ital_corr[k]=zero_val;
+    else mp->tfm_ital_corr[k]=mp_sort_in(mp, mp->tfm_ital_corr[k]);
+  }
+}
+mp->ni=mp_skimp(mp, 63)+1; mp->dimen_head[4]=link(temp_head);
+if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_ic)
+
+@ @<Initialize table entries...@>=
+value(zero_val)=0; info(zero_val)=0;
+
+@ Bytes 5--8 of the header are set to the design size, unless the user has
+some crazy reason for specifying them differently.
+@^design size@>
+
+Error messages are not allowed at the time this procedure is called,
+so a warning is printed instead.
+
+The value of |max_tfm_dimen| is calculated so that
+$$\hbox{|make_scaled(16*max_tfm_dimen,internal[mp_design_size])|}
+ < \\{three\_bytes}.$$
+
+@d three_bytes 0100000000 /* $2^{24}$ */
+
+@c 
+void mp_fix_design_size (MP mp) {
+  scaled d; /* the design size */
+  d=mp->internal[mp_design_size];
+  if ( (d<unity)||(d>=fraction_half) ) {
+    if ( d!=0 )
+      mp_print_nl(mp, "(illegal design size has been changed to 128pt)");
+@.illegal design size...@>
+    d=040000000; mp->internal[mp_design_size]=d;
+  }
+  if ( mp->header_byte[4]<0 ) if ( mp->header_byte[5]<0 )
+    if ( mp->header_byte[6]<0 ) if ( mp->header_byte[7]<0 ) {
+     mp->header_byte[4]=d / 04000000;
+     mp->header_byte[5]=(d / 4096) % 256;
+     mp->header_byte[6]=(d / 16) % 256;
+     mp->header_byte[7]=(d % 16)*16;
+  };
+  mp->max_tfm_dimen=16*mp->internal[mp_design_size]-1-mp->internal[mp_design_size] / 010000000;
+  if ( mp->max_tfm_dimen>=fraction_half ) mp->max_tfm_dimen=fraction_half-1;
+}
+
+@ The |dimen_out| procedure computes a |fix_word| relative to the
+design size. If the data was out of range, it is corrected and the
+global variable |tfm_changed| is increased by~one.
+
+@c integer mp_dimen_out (MP mp,scaled x) { 
+  if ( abs(x)>mp->max_tfm_dimen ) {
+    incr(mp->tfm_changed);
+    if ( x>0 ) x=mp->max_tfm_dimen; else x=-mp->max_tfm_dimen;
+  }
+  x=mp_make_scaled(mp, x*16,mp->internal[mp_design_size]);
+  return x;
+}
+
+@ @<Glob...@>=
+scaled max_tfm_dimen; /* bound on widths, heights, kerns, etc. */
+integer tfm_changed; /* the number of data entries that were out of bounds */
+
+@ If the user has not specified any of the first four header bytes,
+the |fix_check_sum| procedure replaces them by a ``check sum'' computed
+from the |tfm_width| data relative to the design size.
+@^check sum@>
+
+@c void mp_fix_check_sum (MP mp) {
+  eight_bits k; /* runs through character codes */
+  eight_bits B1,B2,B3,B4; /* bytes of the check sum */
+  integer x;  /* hash value used in check sum computation */
+  if ( mp->header_byte[0]==0 && mp->header_byte[1]==0 &&
+       mp->header_byte[2]==0 && mp->header_byte[3]==0 ) {
+    @<Compute a check sum in |(b1,b2,b3,b4)|@>;
+    mp->header_byte[0]=B1; mp->header_byte[1]=B2;
+    mp->header_byte[2]=B3; mp->header_byte[3]=B4; 
+    return;
+  }
+}
+
+@ @<Compute a check sum in |(b1,b2,b3,b4)|@>=
+B1=mp->bc; B2=mp->ec; B3=mp->bc; B4=mp->ec; mp->tfm_changed=0;
+for (k=mp->bc;k<=mp->ec;k++) { 
+  if ( mp->char_exists[k] ) {
+    x=mp_dimen_out(mp, value(mp->tfm_width[k]))+(k+4)*020000000; /* this is positive */
+    B1=(B1+B1+x) % 255;
+    B2=(B2+B2+x) % 253;
+    B3=(B3+B3+x) % 251;
+    B4=(B4+B4+x) % 247;
+  }
+}
+
+@ Finally we're ready to actually write the \.{TFM} information.
+Here are some utility routines for this purpose.
+
+@d tfm_out(A) do { /* output one byte to |tfm_file| */
+  unsigned char s=(A); 
+  (mp->write_binary_file)(mp,mp->tfm_file,(void *)&s,1); 
+  } while (0)
+
+@c void mp_tfm_two (MP mp,integer x) { /* output two bytes to |tfm_file| */
+  tfm_out(x / 256); tfm_out(x % 256);
+}
+void mp_tfm_four (MP mp,integer x) { /* output four bytes to |tfm_file| */
+  if ( x>=0 ) tfm_out(x / three_bytes);
+  else { 
+    x=x+010000000000; /* use two's complement for negative values */
+    x=x+010000000000;
+    tfm_out((x / three_bytes) + 128);
+  };
+  x=x % three_bytes; tfm_out(x / unity);
+  x=x % unity; tfm_out(x / 0400);
+  tfm_out(x % 0400);
+}
+void mp_tfm_qqqq (MP mp,four_quarters x) { /* output four quarterwords to |tfm_file| */
+  tfm_out(qo(x.b0)); tfm_out(qo(x.b1)); 
+  tfm_out(qo(x.b2)); tfm_out(qo(x.b3));
+}
+
+@ @<Finish the \.{TFM} file@>=
+if ( mp->job_name==NULL ) mp_open_log_file(mp);
+mp_pack_job_name(mp, ".tfm");
+while ( ! mp_b_open_out(mp, &mp->tfm_file, mp_filetype_metrics) )
+  mp_prompt_file_name(mp, "file name for font metrics",".tfm");
+mp->metric_file_name=xstrdup(mp->name_of_file);
+@<Output the subfile sizes and header bytes@>;
+@<Output the character information bytes, then
+  output the dimensions themselves@>;
+@<Output the ligature/kern program@>;
+@<Output the extensible character recipes and the font metric parameters@>;
+  if ( mp->internal[mp_tracing_stats]>0 )
+  @<Log the subfile sizes of the \.{TFM} file@>;
+mp_print_nl(mp, "Font metrics written on "); 
+mp_print(mp, mp->metric_file_name); mp_print_char(mp, '.');
+@.Font metrics written...@>
+(mp->close_file)(mp,mp->tfm_file)
+
+@ Integer variables |lh|, |k|, and |lk_offset| will be defined when we use
+this code.
+
+@<Output the subfile sizes and header bytes@>=
+k=mp->header_last;
+LH=(k+3) / 4; /* this is the number of header words */
+if ( mp->bc>mp->ec ) mp->bc=1; /* if there are no characters, |ec=0| and |bc=1| */
+@<Compute the ligature/kern program offset and implant the
+  left boundary label@>;
+mp_tfm_two(mp,6+LH+(mp->ec-mp->bc+1)+mp->nw+mp->nh+mp->nd+mp->ni+mp->nl
+     +lk_offset+mp->nk+mp->ne+mp->np);
+  /* this is the total number of file words that will be output */
+mp_tfm_two(mp, LH); mp_tfm_two(mp, mp->bc); mp_tfm_two(mp, mp->ec); 
+mp_tfm_two(mp, mp->nw); mp_tfm_two(mp, mp->nh);
+mp_tfm_two(mp, mp->nd); mp_tfm_two(mp, mp->ni); mp_tfm_two(mp, mp->nl+lk_offset); 
+mp_tfm_two(mp, mp->nk); mp_tfm_two(mp, mp->ne);
+mp_tfm_two(mp, mp->np);
+for (k=0;k< 4*LH;k++)   { 
+  tfm_out(mp->header_byte[k]);
+}
+
+@ @<Output the character information bytes...@>=
+for (k=mp->bc;k<=mp->ec;k++) {
+  if ( ! mp->char_exists[k] ) {
+    mp_tfm_four(mp, 0);
+  } else { 
+    tfm_out(info(mp->tfm_width[k])); /* the width index */
+    tfm_out((info(mp->tfm_height[k]))*16+info(mp->tfm_depth[k]));
+    tfm_out((info(mp->tfm_ital_corr[k]))*4+mp->char_tag[k]);
+    tfm_out(mp->char_remainder[k]);
+  };
+}
+mp->tfm_changed=0;
+for (k=1;k<=4;k++) { 
+  mp_tfm_four(mp, 0); p=mp->dimen_head[k];
+  while ( p!=inf_val ) {
+    mp_tfm_four(mp, mp_dimen_out(mp, value(p))); p=link(p);
+  }
+}
+
+
+@ We need to output special instructions at the beginning of the
+|lig_kern| array in order to specify the right boundary character
+and/or to handle starting addresses that exceed 255. The |label_loc|
+and |label_char| arrays have been set up to record all the
+starting addresses; we have $-1=|label_loc|[0]<|label_loc|[1]\le\cdots
+\le|label_loc|[|label_ptr]|$.
+
+@<Compute the ligature/kern program offset...@>=
+mp->bchar=mp_round_unscaled(mp, mp->internal[mp_boundary_char]);
+if ((mp->bchar<0)||(mp->bchar>255))
+  { mp->bchar=-1; mp->lk_started=false; lk_offset=0; }
+else { mp->lk_started=true; lk_offset=1; };
+@<Find the minimum |lk_offset| and adjust all remainders@>;
+if ( mp->bch_label<undefined_label )
+  { skip_byte(mp->nl)=qi(255); next_char(mp->nl)=qi(0);
+  op_byte(mp->nl)=qi(((mp->bch_label+lk_offset)/ 256));
+  rem_byte(mp->nl)=qi(((mp->bch_label+lk_offset)% 256));
+  incr(mp->nl); /* possibly |nl=lig_table_size+1| */
+  }
+
+@ @<Find the minimum |lk_offset|...@>=
+k=mp->label_ptr; /* pointer to the largest unallocated label */
+if ( mp->label_loc[k]+lk_offset>255 ) {
+  lk_offset=0; mp->lk_started=false; /* location 0 can do double duty */
+  do {  
+    mp->char_remainder[mp->label_char[k]]=lk_offset;
+    while ( mp->label_loc[k-1]==mp->label_loc[k] ) {
+       decr(k); mp->char_remainder[mp->label_char[k]]=lk_offset;
+    }
+    incr(lk_offset); decr(k);
+  } while (! (lk_offset+mp->label_loc[k]<256));
+    /* N.B.: |lk_offset=256| satisfies this when |k=0| */
+}
+if ( lk_offset>0 ) {
+  while ( k>0 ) {
+    mp->char_remainder[mp->label_char[k]]
+     =mp->char_remainder[mp->label_char[k]]+lk_offset;
+    decr(k);
+  }
+}
+
+@ @<Output the ligature/kern program@>=
+for (k=0;k<= 255;k++ ) {
+  if ( mp->skip_table[k]<undefined_label ) {
+     mp_print_nl(mp, "(local label "); mp_print_int(mp, k); mp_print(mp, ":: was missing)");
+@.local label l:: was missing@>
+    cancel_skips(mp->skip_table[k]);
+  }
+}
+if ( mp->lk_started ) { /* |lk_offset=1| for the special |bchar| */
+  tfm_out(255); tfm_out(mp->bchar); mp_tfm_two(mp, 0);
+} else {
+  for (k=1;k<=lk_offset;k++) {/* output the redirection specs */
+    mp->ll=mp->label_loc[mp->label_ptr];
+    if ( mp->bchar<0 ) { tfm_out(254); tfm_out(0);   }
+    else { tfm_out(255); tfm_out(mp->bchar);   };
+    mp_tfm_two(mp, mp->ll+lk_offset);
+    do {  
+      decr(mp->label_ptr);
+    } while (! (mp->label_loc[mp->label_ptr]<mp->ll));
+  }
+}
+for (k=0;k<=mp->nl-1;k++) mp_tfm_qqqq(mp, mp->lig_kern[k]);
+for (k=0;k<=mp->nk-1;k++) mp_tfm_four(mp, mp_dimen_out(mp, mp->kern[k]))
+
+@ @<Output the extensible character recipes...@>=
+for (k=0;k<=mp->ne-1;k++) 
+  mp_tfm_qqqq(mp, mp->exten[k]);
+for (k=1;k<=mp->np;k++) {
+  if ( k==1 ) {
+    if ( abs(mp->param[1])<fraction_half ) {
+      mp_tfm_four(mp, mp->param[1]*16);
+    } else  { 
+      incr(mp->tfm_changed);
+      if ( mp->param[1]>0 ) mp_tfm_four(mp, el_gordo);
+      else mp_tfm_four(mp, -el_gordo);
+    }
+  } else {
+    mp_tfm_four(mp, mp_dimen_out(mp, mp->param[k]));
+  }
+}
+if ( mp->tfm_changed>0 )  { 
+  if ( mp->tfm_changed==1 ) mp_print_nl(mp, "(a font metric dimension");
+@.a font metric dimension...@>
+  else  { 
+    mp_print_nl(mp, "("); mp_print_int(mp, mp->tfm_changed);
+@.font metric dimensions...@>
+    mp_print(mp, " font metric dimensions");
+  }
+  mp_print(mp, " had to be decreased)");
+}
+
+@ @<Log the subfile sizes of the \.{TFM} file@>=
+{ 
+  char s[200];
+  wlog_ln(" ");
+  if ( mp->bch_label<undefined_label ) decr(mp->nl);
+  snprintf(s,128,"(You used %iw,%ih,%id,%ii,%il,%ik,%ie,%ip metric file positions)",
+                 mp->nw, mp->nh, mp->nd, mp->ni, mp->nl, mp->nk, mp->ne,mp->np);
+  wlog_ln(s);
+}
+
+@* \[43] Reading font metric data.
+
+\MP\ isn't a typesetting program but it does need to find the bounding box
+of a sequence of typeset characters.  Thus it needs to read \.{TFM} files as
+well as write them.
+
+@<Glob...@>=
+void * tfm_infile;
+
+@ All the width, height, and depth information is stored in an array called
+|font_info|.  This array is allocated sequentially and each font is stored
+as a series of |char_info| words followed by the width, height, and depth
+tables.  Since |font_name| entries are permanent, their |str_ref| values are
+set to |max_str_ref|.
+
+@<Types...@>=
+typedef unsigned int font_number; /* |0..font_max| */
+
+@ The |font_info| array is indexed via a group directory arrays.
+For example, the |char_info| data for character~|c| in font~|f| will be
+in |font_info[char_base[f]+c].qqqq|.
+
+@<Glob...@>=
+font_number font_max; /* maximum font number for included text fonts */
+size_t      font_mem_size; /* number of words for \.{TFM} information for text fonts */
+memory_word *font_info; /* height, width, and depth data */
+char        **font_enc_name; /* encoding names, if any */
+boolean     *font_ps_name_fixed; /* are the postscript names fixed already?  */
+int         next_fmem; /* next unused entry in |font_info| */
+font_number last_fnum; /* last font number used so far */
+scaled      *font_dsize;  /* 16 times the ``design'' size in \ps\ points */
+char        **font_name;  /* name as specified in the \&{infont} command */
+char        **font_ps_name;  /* PostScript name for use when |internal[mp_prologues]>0| */
+font_number last_ps_fnum; /* last valid |font_ps_name| index */
+eight_bits  *font_bc;
+eight_bits  *font_ec;  /* first and last character code */
+int         *char_base;  /* base address for |char_info| */
+int         *width_base; /* index for zeroth character width */
+int         *height_base; /* index for zeroth character height */
+int         *depth_base; /* index for zeroth character depth */
+pointer     *font_sizes;
+
+@ @<Allocate or initialize ...@>=
+mp->font_mem_size = 10000; 
+mp->font_info = xmalloc ((mp->font_mem_size+1),sizeof(memory_word));
+memset (mp->font_info,0,sizeof(memory_word)*(mp->font_mem_size+1));
+mp->font_enc_name = NULL;
+mp->font_ps_name_fixed = NULL;
+mp->font_dsize = NULL;
+mp->font_name = NULL;
+mp->font_ps_name = NULL;
+mp->font_bc = NULL;
+mp->font_ec = NULL;
+mp->last_fnum = null_font;
+mp->char_base = NULL;
+mp->width_base = NULL;
+mp->height_base = NULL;
+mp->depth_base = NULL;
+mp->font_sizes = null;
+
+@ @<Dealloc variables@>=
+for (k=1;k<=(int)mp->last_fnum;k++) {
+  xfree(mp->font_enc_name[k]);
+  xfree(mp->font_name[k]);
+  xfree(mp->font_ps_name[k]);
+}
+xfree(mp->font_info);
+xfree(mp->font_enc_name);
+xfree(mp->font_ps_name_fixed);
+xfree(mp->font_dsize);
+xfree(mp->font_name);
+xfree(mp->font_ps_name);
+xfree(mp->font_bc);
+xfree(mp->font_ec);
+xfree(mp->char_base);
+xfree(mp->width_base);
+xfree(mp->height_base);
+xfree(mp->depth_base);
+xfree(mp->font_sizes);
+
+@ 
+@c 
+void mp_reallocate_fonts (MP mp, font_number l) {
+  font_number f;
+  XREALLOC(mp->font_enc_name,      l, char *);
+  XREALLOC(mp->font_ps_name_fixed, l, boolean);
+  XREALLOC(mp->font_dsize,         l, scaled);
+  XREALLOC(mp->font_name,          l, char *);
+  XREALLOC(mp->font_ps_name,       l, char *);
+  XREALLOC(mp->font_bc,            l, eight_bits);
+  XREALLOC(mp->font_ec,            l, eight_bits);
+  XREALLOC(mp->char_base,          l, int);
+  XREALLOC(mp->width_base,         l, int);
+  XREALLOC(mp->height_base,        l, int);
+  XREALLOC(mp->depth_base,         l, int);
+  XREALLOC(mp->font_sizes,         l, pointer);
+  for (f=(mp->last_fnum+1);f<=l;f++) {
+    mp->font_enc_name[f]=NULL;
+    mp->font_ps_name_fixed[f] = false;
+    mp->font_name[f]=NULL;
+    mp->font_ps_name[f]=NULL;
+    mp->font_sizes[f]=null;
+  }
+  mp->font_max = l;
+}
+
+@ @<Declare |mp_reallocate| functions@>=
+void mp_reallocate_fonts (MP mp, font_number l);
+
+
+@ A |null_font| containing no characters is useful for error recovery.  Its
+|font_name| entry starts out empty but is reset each time an erroneous font is
+found.  This helps to cut down on the number of duplicate error messages without
+wasting a lot of space.
+
+@d null_font 0 /* the |font_number| for an empty font */
+
+@<Set initial...@>=
+mp->font_dsize[null_font]=0;
+mp->font_bc[null_font]=1;
+mp->font_ec[null_font]=0;
+mp->char_base[null_font]=0;
+mp->width_base[null_font]=0;
+mp->height_base[null_font]=0;
+mp->depth_base[null_font]=0;
+mp->next_fmem=0;
+mp->last_fnum=null_font;
+mp->last_ps_fnum=null_font;
+mp->font_name[null_font]=(char *)"nullfont";
+mp->font_ps_name[null_font]=(char *)"";
+mp->font_ps_name_fixed[null_font] = false;
+mp->font_enc_name[null_font]=NULL;
+mp->font_sizes[null_font]=null;
+
+@ Each |char_info| word is of type |four_quarters|.  The |b0| field contains
+the |width index|; the |b1| field contains the height
+index; the |b2| fields contains the depth index, and the |b3| field used only
+for temporary storage. (It is used to keep track of which characters occur in
+an edge structure that is being shipped out.)
+The corresponding words in the width, height, and depth tables are stored as
+|scaled| values in units of \ps\ points.
+
+With the macros below, the |char_info| word for character~|c| in font~|f| is
+|char_info(f)(c)| and the width is
+$$\hbox{|char_width(f)(char_info(f)(c)).sc|.}$$
+
+@d char_info_end(A) (A)].qqqq
+@d char_info(A) mp->font_info[mp->char_base[(A)]+char_info_end
+@d char_width_end(A) (A).b0].sc
+@d char_width(A) mp->font_info[mp->width_base[(A)]+char_width_end
+@d char_height_end(A) (A).b1].sc
+@d char_height(A) mp->font_info[mp->height_base[(A)]+char_height_end
+@d char_depth_end(A) (A).b2].sc
+@d char_depth(A) mp->font_info[mp->depth_base[(A)]+char_depth_end
+@d ichar_exists(A) ((A).b0>0)
+
+@ The |font_ps_name| for a built-in font should be what PostScript expects.
+A preliminary name is obtained here from the \.{TFM} name as given in the
+|fname| argument.  This gets updated later from an external table if necessary.
+
+@<Declare text measuring subroutines@>=
+@<Declare subroutines for parsing file names@>
+font_number mp_read_font_info (MP mp, char *fname) {
+  boolean file_opened; /* has |tfm_infile| been opened? */
+  font_number n; /* the number to return */
+  halfword lf,tfm_lh,bc,ec,nw,nh,nd; /* subfile size parameters */
+  size_t whd_size; /* words needed for heights, widths, and depths */
+  int i,ii; /* |font_info| indices */
+  int jj; /* counts bytes to be ignored */
+  scaled z; /* used to compute the design size */
+  fraction d;
+  /* height, width, or depth as a fraction of design size times $2^{-8}$ */
+  eight_bits h_and_d; /* height and depth indices being unpacked */
+  unsigned char tfbyte; /* a byte read from the file */
+  n=null_font;
+  @<Open |tfm_infile| for input@>;
+  @<Read data from |tfm_infile|; if there is no room, say so and |goto done|;
+    otherwise |goto bad_tfm| or |goto done| as appropriate@>;
+BAD_TFM:
+  @<Complain that the \.{TFM} file is bad@>;
+DONE:
+  if ( file_opened ) (mp->close_file)(mp,mp->tfm_infile);
+  if ( n!=null_font ) { 
+    mp->font_ps_name[n]=mp_xstrdup(mp,fname);
+    mp->font_name[n]=mp_xstrdup(mp,fname);
+  }
+  return n;
+}
+
+@ \MP\ doesn't bother to check the entire \.{TFM} file for errors or explain
+precisely what is wrong if it does find a problem.  Programs called \.{TFtoPL}
+@.TFtoPL@> @.PLtoTF@>
+and \.{PLtoTF} can be used to debug \.{TFM} files.
+
+@<Complain that the \.{TFM} file is bad@>=
+print_err("Font ");
+mp_print(mp, fname);
+if ( file_opened ) mp_print(mp, " not usable: TFM file is bad");
+else mp_print(mp, " not usable: TFM file not found");
+help3("I wasn't able to read the size data for this font so this")
+  ("`infont' operation won't produce anything. If the font name")
+  ("is right, you might ask an expert to make a TFM file");
+if ( file_opened )
+  mp->help_line[0]="is right, try asking an expert to fix the TFM file";
+mp_error(mp)
+
+@ @<Read data from |tfm_infile|; if there is no room, say so...@>=
+@<Read the \.{TFM} size fields@>;
+@<Use the size fields to allocate space in |font_info|@>;
+@<Read the \.{TFM} header@>;
+@<Read the character data and the width, height, and depth tables and
+  |goto done|@>
+
+@ A bad \.{TFM} file can be shorter than it claims to be.  The code given here
+might try to read past the end of the file if this happens.  Changes will be
+needed if it causes a system error to refer to |tfm_infile^| or call
+|get_tfm_infile| when |eof(tfm_infile)| is true.  For example, the definition
+@^system dependencies@>
+of |tfget| could be changed to
+``|begin get(tfm_infile); if eof(tfm_infile) then goto bad_tfm; end|.''
+
+@d tfget do { 
+  size_t wanted=1; 
+  void *tfbyte_ptr = &tfbyte;
+  (mp->read_binary_file)(mp,mp->tfm_infile,&tfbyte_ptr,&wanted); 
+  if (wanted==0) goto BAD_TFM; 
+} while (0)
+@d read_two(A) { (A)=tfbyte;
+  if ( (A)>127 ) goto BAD_TFM;
+  tfget; (A)=(A)*0400+tfbyte;
+}
+@d tf_ignore(A) { for (jj=(A);jj>=1;jj--) tfget; }
+
+@<Read the \.{TFM} size fields@>=
+tfget; read_two(lf);
+tfget; read_two(tfm_lh);
+tfget; read_two(bc);
+tfget; read_two(ec);
+if ( (bc>1+ec)||(ec>255) ) goto BAD_TFM;
+tfget; read_two(nw);
+tfget; read_two(nh);
+tfget; read_two(nd);
+whd_size=(ec+1-bc)+nw+nh+nd;
+if ( lf<(int)(6+tfm_lh+whd_size) ) goto BAD_TFM;
+tf_ignore(10)
+
+@ Offsets are added to |char_base[n]| and |width_base[n]| so that is not
+necessary to apply the |so|  and |qo| macros when looking up the width of a
+character in the string pool.  In order to ensure nonnegative |char_base|
+values when |bc>0|, it may be necessary to reserve a few unused |font_info|
+elements.
+
+@<Use the size fields to allocate space in |font_info|@>=
+if ( mp->next_fmem<bc) mp->next_fmem=bc;  /* ensure nonnegative |char_base| */
+if (mp->last_fnum==mp->font_max)
+  mp_reallocate_fonts(mp,(mp->font_max+(mp->font_max>>2)));
+while (mp->next_fmem+whd_size>=mp->font_mem_size) {
+  size_t l = mp->font_mem_size+(mp->font_mem_size>>2);
+  memory_word *font_info;
+  font_info = xmalloc ((l+1),sizeof(memory_word));
+  memset (font_info,0,sizeof(memory_word)*(l+1));
+  memcpy (font_info,mp->font_info,sizeof(memory_word)*(mp->font_mem_size+1));
+  xfree(mp->font_info);
+  mp->font_info = font_info;
+  mp->font_mem_size = l;
+}
+incr(mp->last_fnum);
+n=mp->last_fnum;
+mp->font_bc[n]=bc;
+mp->font_ec[n]=ec;
+mp->char_base[n]=mp->next_fmem-bc;
+mp->width_base[n]=mp->next_fmem+ec-bc+1;
+mp->height_base[n]=mp->width_base[n]+nw;
+mp->depth_base[n]=mp->height_base[n]+nh;
+mp->next_fmem=mp->next_fmem+whd_size;
+
+
+@ @<Read the \.{TFM} header@>=
+if ( tfm_lh<2 ) goto BAD_TFM;
+tf_ignore(4);
+tfget; read_two(z);
+tfget; z=z*0400+tfbyte;
+tfget; z=z*0400+tfbyte; /* now |z| is 16 times the design size */
+mp->font_dsize[n]=mp_take_fraction(mp, z,267432584);
+  /* times ${72\over72.27}2^{28}$ to convert from \TeX\ points */
+tf_ignore(4*(tfm_lh-2))
+
+@ @<Read the character data and the width, height, and depth tables...@>=
+ii=mp->width_base[n];
+i=mp->char_base[n]+bc;
+while ( i<ii ) { 
+  tfget; mp->font_info[i].qqqq.b0=qi(tfbyte);
+  tfget; h_and_d=tfbyte;
+  mp->font_info[i].qqqq.b1=h_and_d / 16;
+  mp->font_info[i].qqqq.b2=h_and_d % 16;
+  tfget; tfget;
+  incr(i);
+}
+while ( i<mp->next_fmem ) {
+  @<Read a four byte dimension, scale it by the design size, store it in
+    |font_info[i]|, and increment |i|@>;
+}
+goto DONE
+
+@ The raw dimension read into |d| should have magnitude at most $2^{24}$ when
+interpreted as an integer, and this includes a scale factor of $2^{20}$.  Thus
+we can multiply it by sixteen and think of it as a |fraction| that has been
+divided by sixteen.  This cancels the extra scale factor contained in
+|font_dsize[n|.
+
+@<Read a four byte dimension, scale it by the design size, store it in...@>=
+{ 
+tfget; d=tfbyte;
+if ( d>=0200 ) d=d-0400;
+tfget; d=d*0400+tfbyte;
+tfget; d=d*0400+tfbyte;
+tfget; d=d*0400+tfbyte;
+mp->font_info[i].sc=mp_take_fraction(mp, d*16,mp->font_dsize[n]);
+incr(i);
+}
+
+@ This function does no longer use the file name parser, because |fname| is
+a C string already.
+@<Open |tfm_infile| for input@>=
+file_opened=false;
+mp_ptr_scan_file(mp, fname);
+if ( strlen(mp->cur_area)==0 ) { xfree(mp->cur_area); }
+if ( strlen(mp->cur_ext)==0 )  { xfree(mp->cur_ext); mp->cur_ext=xstrdup(".tfm"); }
+pack_cur_name;
+mp->tfm_infile = (mp->open_file)(mp, mp->name_of_file, "r",mp_filetype_metrics);
+if ( !mp->tfm_infile  ) goto BAD_TFM;
+file_opened=true
+
+@ When we have a font name and we don't know whether it has been loaded yet,
+we scan the |font_name| array before calling |read_font_info|.
+
+@<Declare text measuring subroutines@>=
+font_number mp_find_font (MP mp, char *f) {
+  font_number n;
+  for (n=0;n<=mp->last_fnum;n++) {
+    if (mp_xstrcmp(f,mp->font_name[n])==0 ) {
+      mp_xfree(f);
+      return n;
+    }
+  }
+  n = mp_read_font_info(mp, f);
+  mp_xfree(f);
+  return n;
+}
+
+@ One simple application of |find_font| is the implementation of the |font_size|
+operator that gets the design size for a given font name.
+
+@<Find the design size of the font whose name is |cur_exp|@>=
+mp_flush_cur_exp(mp, (mp->font_dsize[mp_find_font(mp, str(mp->cur_exp))]+8) / 16)
+
+@ If we discover that the font doesn't have a requested character, we omit it
+from the bounding box computation and expect the \ps\ interpreter to drop it.
+This routine issues a warning message if the user has asked for it.
+
+@<Declare text measuring subroutines@>=
+void mp_lost_warning (MP mp,font_number f, pool_pointer k) { 
+  if ( mp->internal[mp_tracing_lost_chars]>0 ) { 
+    mp_begin_diagnostic(mp);
+    if ( mp->selector==log_only ) incr(mp->selector);
+    mp_print_nl(mp, "Missing character: There is no ");
+@.Missing character@>
+    mp_print_str(mp, mp->str_pool[k]); 
+    mp_print(mp, " in font ");
+    mp_print(mp, mp->font_name[f]); mp_print_char(mp, '!'); 
+    mp_end_diagnostic(mp, false);
+  }
+}
+
+@ The whole purpose of saving the height, width, and depth information is to be
+able to find the bounding box of an item of text in an edge structure.  The
+|set_text_box| procedure takes a text node and adds this information.
+
+@<Declare text measuring subroutines@>=
+void mp_set_text_box (MP mp,pointer p) {
+  font_number f; /* |font_n(p)| */
+  ASCII_code bc,ec; /* range of valid characters for font |f| */
+  pool_pointer k,kk; /* current character and character to stop at */
+  four_quarters cc; /* the |char_info| for the current character */
+  scaled h,d; /* dimensions of the current character */
+  width_val(p)=0;
+  height_val(p)=-el_gordo;
+  depth_val(p)=-el_gordo;
+  f=font_n(p);
+  bc=mp->font_bc[f];
+  ec=mp->font_ec[f];
+  kk=str_stop(text_p(p));
+  k=mp->str_start[text_p(p)];
+  while ( k<kk ) {
+    @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>;
+  }
+  @<Set the height and depth to zero if the bounding box is empty@>;
+}
+
+@ @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>=
+{ 
+  if ( (mp->str_pool[k]<bc)||(mp->str_pool[k]>ec) ) {
+    mp_lost_warning(mp, f,k);
+  } else { 
+    cc=char_info(f)(mp->str_pool[k]);
+    if ( ! ichar_exists(cc) ) {
+      mp_lost_warning(mp, f,k);
+    } else { 
+      width_val(p)=width_val(p)+char_width(f)(cc);
+      h=char_height(f)(cc);
+      d=char_depth(f)(cc);
+      if ( h>height_val(p) ) height_val(p)=h;
+      if ( d>depth_val(p) ) depth_val(p)=d;
+    }
+  }
+  incr(k);
+}
+
+@ Let's hope modern compilers do comparisons correctly when the difference would
+overflow.
+
+@<Set the height and depth to zero if the bounding box is empty@>=
+if ( height_val(p)<-depth_val(p) ) { 
+  height_val(p)=0;
+  depth_val(p)=0;
+}
+
+@ The new primitives fontmapfile and fontmapline.
+
+@<Declare action procedures for use by |do_statement|@>=
+void mp_do_mapfile (MP mp) ;
+void mp_do_mapline (MP mp) ;
+
+@ @c void mp_do_mapfile (MP mp) { 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_string_type ) {
+    @<Complain about improper map operation@>;
+  } else {
+    mp_map_file(mp,mp->cur_exp);
+  }
+}
+void mp_do_mapline (MP mp) { 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_string_type ) {
+     @<Complain about improper map operation@>;
+  } else { 
+     mp_map_line(mp,mp->cur_exp);
+  }
+}
+
+@ @<Complain about improper map operation@>=
+{ 
+  exp_err("Unsuitable expression");
+  help1("Only known strings can be map files or map lines.");
+  mp_put_get_error(mp);
+}
+
+@ To print |scaled| value to PDF output we need some subroutines to ensure
+accurary.
+
+@d max_integer   0x7FFFFFFF /* $2^{31}-1$ */
+
+@<Glob...@>=
+scaled one_bp; /* scaled value corresponds to 1bp */
+scaled one_hundred_bp; /* scaled value corresponds to 100bp */
+scaled one_hundred_inch; /* scaled value corresponds to 100in */
+integer ten_pow[10]; /* $10^0..10^9$ */
+integer scaled_out; /* amount of |scaled| that was taken out in |divide_scaled| */
+
+@ @<Set init...@>=
+mp->one_bp = 65782; /* 65781.76 */
+mp->one_hundred_bp = 6578176;
+mp->one_hundred_inch = 473628672;
+mp->ten_pow[0] = 1;
+for (i = 1;i<= 9; i++ ) {
+  mp->ten_pow[i] = 10*mp->ten_pow[i - 1];
+}
+
+@ The following function divides |s| by |m|. |dd| is number of decimal digits.
+
+@c scaled mp_divide_scaled (MP mp,scaled s, scaled m, integer  dd) {
+  scaled q,r;
+  integer sign,i;
+  sign = 1;
+  if ( s < 0 ) { sign = -sign; s = -s; }
+  if ( m < 0 ) { sign = -sign; m = -m; }
+  if ( m == 0 )
+    mp_confusion(mp, "arithmetic: divided by zero");
+  else if ( m >= (max_integer / 10) )
+    mp_confusion(mp, "arithmetic: number too big");
+  q = s / m;
+  r = s % m;
+  for (i = 1;i<=dd;i++) {
+    q = 10*q + (10*r) / m;
+    r = (10*r) % m;
+  }
+  if ( 2*r >= m ) { incr(q); r = r - m; }
+  mp->scaled_out = sign*(s - (r / mp->ten_pow[dd]));
+  return (sign*q);
+}
+
+@* \[44] Shipping pictures out.
+The |ship_out| procedure, to be described below, is given a pointer to
+an edge structure. Its mission is to output a file containing the \ps\
+description of an edge structure.
+
+@ Each time an edge structure is shipped out we write a new \ps\ output
+file named according to the current \&{charcode}.
+@:char_code_}{\&{charcode} primitive@>
+
+This is the only backend function that remains in the main |mpost.w| file. 
+There are just too many variable accesses needed for status reporting 
+etcetera to make it worthwile to move the code to |psout.w|.
+
+@<Internal library declarations@>=
+void mp_open_output_file (MP mp) ;
+
+@ @c 
+char *mp_set_output_file_name (MP mp, integer c) {
+  char *ss = NULL; /* filename extension proposal */  
+  int old_setting; /* previous |selector| setting */
+  pool_pointer i; /*  indexes into |filename_template|  */
+  integer cc; /* a temporary integer for template building  */
+  integer f,g=0; /* field widths */
+  if ( mp->job_name==NULL ) mp_open_log_file(mp);
+  if ( mp->filename_template==0 ) {
+    char *s; /* a file extension derived from |c| */
+    if ( c<0 ) 
+      s=xstrdup(".ps");
+    else 
+      @<Use |c| to compute the file extension |s|@>;
+    mp_pack_job_name(mp, s);
+    ss = s ;
+  } else { /* initializations */
+    str_number s, n; /* a file extension derived from |c| */
+    old_setting=mp->selector; 
+    mp->selector=new_string;
+    f = 0;
+    i = mp->str_start[mp->filename_template];
+    n = rts(""); /* initialize */
+    while ( i<str_stop(mp->filename_template) ) {
+       if ( mp->str_pool[i]=='%' ) {
+      CONTINUE:
+        incr(i);
+        if ( i<str_stop(mp->filename_template) ) {
+          if ( mp->str_pool[i]=='j' ) {
+            mp_print(mp, mp->job_name);
+          } else if ( mp->str_pool[i]=='d' ) {
+             cc= mp_round_unscaled(mp, mp->internal[mp_day]);
+             print_with_leading_zeroes(cc);
+          } else if ( mp->str_pool[i]=='m' ) {
+             cc= mp_round_unscaled(mp, mp->internal[mp_month]);
+             print_with_leading_zeroes(cc);
+          } else if ( mp->str_pool[i]=='y' ) {
+             cc= mp_round_unscaled(mp, mp->internal[mp_year]);
+             print_with_leading_zeroes(cc);
+          } else if ( mp->str_pool[i]=='H' ) {
+             cc= mp_round_unscaled(mp, mp->internal[mp_time]) / 60;
+             print_with_leading_zeroes(cc);
+          }  else if ( mp->str_pool[i]=='M' ) {
+             cc= mp_round_unscaled(mp, mp->internal[mp_time]) % 60;
+             print_with_leading_zeroes(cc);
+          } else if ( mp->str_pool[i]=='c' ) {
+            if ( c<0 ) mp_print(mp, "ps");
+            else print_with_leading_zeroes(c);
+          } else if ( (mp->str_pool[i]>='0') && 
+                      (mp->str_pool[i]<='9') ) {
+            if ( (f<10)  )
+              f = (f*10) + mp->str_pool[i]-'0';
+            goto CONTINUE;
+          } else {
+            mp_print_str(mp, mp->str_pool[i]);
+          }
+        }
+      } else {
+        if ( mp->str_pool[i]=='.' )
+          if (length(n)==0)
+            n = mp_make_string(mp);
+        mp_print_str(mp, mp->str_pool[i]);
+      };
+      incr(i);
+    };
+    s = mp_make_string(mp);
+    mp->selector= old_setting;
+    if (length(n)==0) {
+       n=s;
+       s=rts("");
+    };
+    mp_pack_file_name(mp, str(n),"",str(s));
+    delete_str_ref(n);
+	ss = str(s);
+    delete_str_ref(s);
+  }
+  return ss;
+}
+
+char * mp_get_output_file_name (MP mp) {
+  char *fname; /* return value */
+  char *saved_name;  /* saved |name_of_file| */
+  saved_name = mp_xstrdup(mp, mp->name_of_file);
+  (void)mp_set_output_file_name(mp, mp_round_unscaled(mp, mp->internal[mp_char_code]));
+  fname = mp_xstrdup(mp, mp->name_of_file);
+  mp_pack_file_name(mp, saved_name,NULL,NULL);
+  return fname;
+}
+
+void mp_open_output_file (MP mp) {
+  char *ss; /* filename extension proposal */
+  integer c; /* \&{charcode} rounded to the nearest integer */
+  c=mp_round_unscaled(mp, mp->internal[mp_char_code]);
+  ss = mp_set_output_file_name(mp, c);
+  while ( ! mp_a_open_out(mp, (void *)&mp->ps_file, mp_filetype_postscript) )
+    mp_prompt_file_name(mp, "file name for output",ss);
+  xfree(ss);
+  @<Store the true output file name if appropriate@>;
+}
+
+@ The file extension created here could be up to five characters long in
+extreme cases so it may have to be shortened on some systems.
+@^system dependencies@>
+
+@<Use |c| to compute the file extension |s|@>=
+{ 
+  s = xmalloc(7,1);
+  snprintf(s,7,".%i",(int)c);
+}
+
+@ The user won't want to see all the output file names so we only save the
+first and last ones and a count of how many there were.  For this purpose
+files are ordered primarily by \&{charcode} and secondarily by order of
+creation.
+@:char_code_}{\&{charcode} primitive@>
+
+@<Store the true output file name if appropriate@>=
+if ((c<mp->first_output_code)&&(mp->first_output_code>=0)) {
+  mp->first_output_code=c;
+  xfree(mp->first_file_name);
+  mp->first_file_name=xstrdup(mp->name_of_file);
+}
+if ( c>=mp->last_output_code ) {
+  mp->last_output_code=c;
+  xfree(mp->last_file_name);
+  mp->last_file_name=xstrdup(mp->name_of_file);
+}
+
+@ @<Glob...@>=
+char * first_file_name;
+char * last_file_name; /* full file names */
+integer first_output_code;integer last_output_code; /* rounded \&{charcode} values */
+@:char_code_}{\&{charcode} primitive@>
+integer total_shipped; /* total number of |ship_out| operations completed */
+
+@ @<Set init...@>=
+mp->first_file_name=xstrdup("");
+mp->last_file_name=xstrdup("");
+mp->first_output_code=32768;
+mp->last_output_code=-32768;
+mp->total_shipped=0;
+
+@ @<Dealloc variables@>=
+xfree(mp->first_file_name);
+xfree(mp->last_file_name);
+
+@ @<Begin the progress report for the output of picture~|c|@>=
+if ( (int)mp->term_offset>mp->max_print_line-6 ) mp_print_ln(mp);
+else if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_char(mp, ' ');
+mp_print_char(mp, '[');
+if ( c>=0 ) mp_print_int(mp, c)
+
+@ @<End progress report@>=
+mp_print_char(mp, ']');
+update_terminal;
+incr(mp->total_shipped)
+
+@ @<Explain what output files were written@>=
+if ( mp->total_shipped>0 ) { 
+  mp_print_nl(mp, "");
+  mp_print_int(mp, mp->total_shipped);
+  mp_print(mp, " output file");
+  if ( mp->total_shipped>1 ) mp_print_char(mp, 's');
+  mp_print(mp, " written: ");
+  mp_print(mp, mp->first_file_name);
+  if ( mp->total_shipped>1 ) {
+    if ( 31+strlen(mp->first_file_name)+
+         strlen(mp->last_file_name)> (unsigned)mp->max_print_line) 
+      mp_print_ln(mp);
+    mp_print(mp, " .. ");
+    mp_print(mp, mp->last_file_name);
+  }
+}
+
+@ @<Internal library declarations@>=
+boolean mp_has_font_size(MP mp, font_number f );
+
+@ @c 
+boolean mp_has_font_size(MP mp, font_number f ) {
+  return (mp->font_sizes[f]!=null);
+}
+
+@ The \&{special} command saves up lines of text to be printed during the next
+|ship_out| operation.  The saved items are stored as a list of capsule tokens.
+
+@<Glob...@>=
+pointer last_pending; /* the last token in a list of pending specials */
+
+@ @<Set init...@>=
+mp->last_pending=spec_head;
+
+@ @<Cases of |do_statement|...@>=
+case special_command: 
+  if ( mp->cur_mod==0 ) mp_do_special(mp); else 
+  if ( mp->cur_mod==1 ) mp_do_mapfile(mp); else 
+  mp_do_mapline(mp);
+  break;
+
+@ @<Declare action procedures for use by |do_statement|@>=
+void mp_do_special (MP mp) ;
+
+@ @c void mp_do_special (MP mp) { 
+  mp_get_x_next(mp); mp_scan_expression(mp);
+  if ( mp->cur_type!=mp_string_type ) {
+    @<Complain about improper special operation@>;
+  } else { 
+    link(mp->last_pending)=mp_stash_cur_exp(mp);
+    mp->last_pending=link(mp->last_pending);
+    link(mp->last_pending)=null;
+  }
+}
+
+@ @<Complain about improper special operation@>=
+{ 
+  exp_err("Unsuitable expression");
+  help1("Only known strings are allowed for output as specials.");
+  mp_put_get_error(mp);
+}
+
+@ On the export side, we need an extra object type for special strings.
+
+@<Graphical object codes@>=
+mp_special_code=8, 
+
+@ @<Export pending specials@>=
+p=link(spec_head);
+while ( p!=null ) {
+  mp_special_object *tp;
+  tp = (mp_special_object *)mp_new_graphic_object(mp,mp_special_code);  
+  gr_pre_script(tp)  = str(value(p));
+  if (hh->body==NULL) hh->body = (mp_graphic_object *)tp; 
+  else gr_link(hp) = (mp_graphic_object *)tp;
+  hp = (mp_graphic_object *)tp;
+  p=link(p);
+}
+mp_flush_token_list(mp, link(spec_head));
+link(spec_head)=null;
+mp->last_pending=spec_head
+
+@ We are now ready for the main output procedure.  Note that the |selector|
+setting is saved in a global variable so that |begin_diagnostic| can access it.
+
+@<Declare the \ps\ output procedures@>=
+void mp_ship_out (MP mp, pointer h) ;
+
+@ Once again, the |gr_XXXX| macros are defined in |mppsout.h|
+
+@d export_color(q,p) 
+  if ( color_model(p)==mp_uninitialized_model ) {
+    gr_color_model(q)  = (mp->internal[mp_default_color_model]>>16);
+    gr_cyan_val(q)     = 0;
+	gr_magenta_val(q)  = 0;
+	gr_yellow_val(q)   = 0;
+	gr_black_val(q)    = (gr_color_model(q)==mp_cmyk_model ? unity : 0);
+  } else {
+    gr_color_model(q)  = color_model(p);
+    gr_cyan_val(q)     = cyan_val(p);
+    gr_magenta_val(q)  = magenta_val(p);
+    gr_yellow_val(q)   = yellow_val(p);
+    gr_black_val(q)    = black_val(p);
+  }
+
+@d export_scripts(q,p)
+  if (pre_script(p)!=null)  gr_pre_script(q)   = str(pre_script(p));
+  if (post_script(p)!=null) gr_post_script(q)  = str(post_script(p));
+
+@c
+struct mp_edge_object *mp_gr_export(MP mp, pointer h) {
+  pointer p; /* the current graphical object */
+  integer t; /* a temporary value */
+  mp_edge_object *hh; /* the first graphical object */
+  struct mp_graphic_object *hq; /* something |hp| points to  */
+  struct mp_text_object    *tt;
+  struct mp_fill_object    *tf;
+  struct mp_stroked_object *ts;
+  struct mp_clip_object    *tc;
+  struct mp_bounds_object  *tb;
+  struct mp_graphic_object *hp = NULL; /* the current graphical object */
+  mp_set_bbox(mp, h, true);
+  hh = mp_xmalloc(mp,1,sizeof(mp_edge_object));
+  hh->body = NULL;
+  hh->_next = NULL;
+  hh->_parent = mp;
+  hh->_minx = minx_val(h);
+  hh->_miny = miny_val(h);
+  hh->_maxx = maxx_val(h);
+  hh->_maxy = maxy_val(h);
+  hh->_filename = mp_get_output_file_name(mp);
+  @<Export pending specials@>;
+  p=link(dummy_loc(h));
+  while ( p!=null ) { 
+    hq = mp_new_graphic_object(mp,type(p));
+    switch (type(p)) {
+    case mp_fill_code:
+      tf = (mp_fill_object *)hq;
+      gr_pen_p(tf)        = mp_export_knot_list(mp,pen_p(p));
+      if ((pen_p(p)==null) || pen_is_elliptical(pen_p(p)))  {
+  	    gr_path_p(tf)       = mp_export_knot_list(mp,path_p(p));
+      } else {
+        pointer pc, pp;
+        pc = mp_copy_path(mp, path_p(p));
+        pp = mp_make_envelope(mp, pc, pen_p(p),ljoin_val(p),0,miterlim_val(p));
+        gr_path_p(tf)       = mp_export_knot_list(mp,pp);
+        mp_toss_knot_list(mp, pp);
+        pc = mp_htap_ypoc(mp, path_p(p));
+        pp = mp_make_envelope(mp, pc, pen_p(p),ljoin_val(p),0,miterlim_val(p));
+        gr_htap_p(tf)       = mp_export_knot_list(mp,pp);
+        mp_toss_knot_list(mp, pp);
+      }
+      export_color(tf,p) ;
+      export_scripts(tf,p);
+      gr_ljoin_val(tf)    = ljoin_val(p);
+      gr_miterlim_val(tf) = miterlim_val(p);
+      break;
+    case mp_stroked_code:
+      ts = (mp_stroked_object *)hq;
+      gr_pen_p(ts)        = mp_export_knot_list(mp,pen_p(p));
+      if (pen_is_elliptical(pen_p(p)))  {
+	      gr_path_p(ts)       = mp_export_knot_list(mp,path_p(p));
+      } else {
+        pointer pc;
+        pc=mp_copy_path(mp, path_p(p));
+        t=lcap_val(p);
+        if ( left_type(pc)!=mp_endpoint ) { 
+          left_type(mp_insert_knot(mp, pc,x_coord(pc),y_coord(pc)))=mp_endpoint;
+          right_type(pc)=mp_endpoint;
+          pc=link(pc);
+          t=1;
+        }
+        pc=mp_make_envelope(mp,pc,pen_p(p),ljoin_val(p),t,miterlim_val(p));
+        gr_path_p(ts)       = mp_export_knot_list(mp,pc);
+        mp_toss_knot_list(mp, pc);
+      }
+      export_color(ts,p) ;
+      export_scripts(ts,p);
+      gr_ljoin_val(ts)    = ljoin_val(p);
+      gr_miterlim_val(ts) = miterlim_val(p);
+      gr_lcap_val(ts)     = lcap_val(p);
+      gr_dash_p(ts)       = mp_export_dashes(mp,dash_p(p));
+      break;
+    case mp_text_code:
+      tt = (mp_text_object *)hq;
+      gr_text_p(tt)       = str(text_p(p));
+      gr_font_n(tt)       = font_n(p);
+      gr_font_name(tt)    = mp_xstrdup(mp,mp->font_name[font_n(p)]);
+      gr_font_dsize(tt)   = mp->font_dsize[font_n(p)];
+      export_color(tt,p) ;
+      export_scripts(tt,p);
+      gr_width_val(tt)    = width_val(p);
+      gr_height_val(tt)   = height_val(p);
+      gr_depth_val(tt)    = depth_val(p);
+      gr_tx_val(tt)       = tx_val(p);
+      gr_ty_val(tt)       = ty_val(p);
+      gr_txx_val(tt)      = txx_val(p);
+      gr_txy_val(tt)      = txy_val(p);
+      gr_tyx_val(tt)      = tyx_val(p);
+      gr_tyy_val(tt)      = tyy_val(p);
+      break;
+    case mp_start_clip_code: 
+      tc = (mp_clip_object *)hq;
+      gr_path_p(tc) = mp_export_knot_list(mp,path_p(p));
+      break;
+    case mp_start_bounds_code:
+      tb = (mp_bounds_object *)hq;
+      gr_path_p(tb) = mp_export_knot_list(mp,path_p(p));
+      break;
+    case mp_stop_clip_code: 
+    case mp_stop_bounds_code:
+      /* nothing to do here */
+      break;
+    } 
+    if (hh->body==NULL) hh->body=hq; else  gr_link(hp) = hq;
+    hp = hq;
+    p=link(p);
+  }
+  return hh;
+}
+
+@ @<Exported function ...@>=
+struct mp_edge_object *mp_gr_export(MP mp, int h);
+
+@ This function is now nearly trivial.
+
+@c
+void mp_ship_out (MP mp, pointer h) { /* output edge structure |h| */
+  integer c; /* \&{charcode} rounded to the nearest integer */
+  c=mp_round_unscaled(mp, mp->internal[mp_char_code]);
+  @<Begin the progress report for the output of picture~|c|@>;
+  (mp->shipout_backend) (mp, h);
+  @<End progress report@>;
+  if ( mp->internal[mp_tracing_output]>0 ) 
+   mp_print_edges(mp, h," (just shipped out)",true);
+}
+
+@ @<Declarations@>=
+void mp_shipout_backend (MP mp, pointer h);
+
+@ @c
+void mp_shipout_backend (MP mp, pointer h) {
+  mp_edge_object *hh; /* the first graphical object */
+  hh = mp_gr_export(mp,h);
+  mp_gr_ship_out (hh,
+                 (mp->internal[mp_prologues]>>16),
+                 (mp->internal[mp_procset]>>16));
+  mp_gr_toss_objects(hh);
+}
+
+@ @<Exported types@>=
+typedef void (*mp_backend_writer)(MP, int);
+
+@ @<Option variables@>=
+mp_backend_writer shipout_backend;
+
+@ @<Allocate or initialize ...@>=
+set_callback_option(shipout_backend);
+
+@ Now that we've finished |ship_out|, let's look at the other commands
+by which a user can send things to the \.{GF} file.
+
+@ @<Determine if a character has been shipped out@>=
+{ 
+  mp->cur_exp=mp_round_unscaled(mp, mp->cur_exp) % 256;
+  if ( mp->cur_exp<0 ) mp->cur_exp=mp->cur_exp+256;
+  boolean_reset(mp->char_exists[mp->cur_exp]);
+  mp->cur_type=mp_boolean_type;
+}
+
+@ @<Glob...@>=
+psout_data ps;
+
+@ @<Allocate or initialize ...@>=
+mp_backend_initialize(mp);
+
+@ @<Dealloc...@>=
+mp_backend_free(mp);
+
+
+@* \[45] Dumping and undumping the tables.
+After \.{INIMP} has seen a collection of macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \MP\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INIMP@>
+
+The global variable |mem_ident| is a string that is printed right
+after the |banner| line when \MP\ is ready to start. For \.{INIMP} this
+string says simply `\.{(INIMP)}'; for other versions of \MP\ it says,
+for example, `\.{(mem=plain 1990.4.14)}', showing the year,
+month, and day that the mem file was created. We have |mem_ident=0|
+before \MP's tables are loaded.
+
+@<Glob...@>=
+char * mem_ident;
+
+@ @<Set init...@>=
+mp->mem_ident=NULL;
+
+@ @<Initialize table entries...@>=
+mp->mem_ident=xstrdup(" (INIMP)");
+
+@ @<Declare act...@>=
+void mp_store_mem_file (MP mp) ;
+
+@ @c void mp_store_mem_file (MP mp) {
+  integer k;  /* all-purpose index */
+  pointer p,q; /* all-purpose pointers */
+  integer x; /* something to dump */
+  four_quarters w; /* four ASCII codes */
+  memory_word WW;
+  @<Create the |mem_ident|, open the mem file,
+    and inform the user that dumping has begun@>;
+  @<Dump constants for consistency check@>;
+  @<Dump the string pool@>;
+  @<Dump the dynamic memory@>;
+  @<Dump the table of equivalents and the hash table@>;
+  @<Dump a few more things and the closing check word@>;
+  @<Close the mem file@>;
+}
+
+@ Corresponding to the procedure that dumps a mem file, we also have a function
+that reads~one~in. The function returns |false| if the dumped mem is
+incompatible with the present \MP\ table sizes, etc.
+
+@d off_base 6666 /* go here if the mem file is unacceptable */
+@d too_small(A) { wake_up_terminal;
+  wterm_ln("---! Must increase the "); wterm((A));
+@.Must increase the x@>
+  goto OFF_BASE;
+  }
+
+@c 
+boolean mp_load_mem_file (MP mp) {
+  integer k; /* all-purpose index */
+  pointer p,q; /* all-purpose pointers */
+  integer x; /* something undumped */
+  str_number s; /* some temporary string */
+  four_quarters w; /* four ASCII codes */
+  memory_word WW;
+  @<Undump constants for consistency check@>;
+  @<Undump the string pool@>;
+  @<Undump the dynamic memory@>;
+  @<Undump the table of equivalents and the hash table@>;
+  @<Undump a few more things and the closing check word@>;
+  return true; /* it worked! */
+OFF_BASE: 
+  wake_up_terminal;
+  wterm_ln("(Fatal mem file error; I'm stymied)\n");
+@.Fatal mem file error@>
+   return false;
+}
+
+@ @<Declarations@>=
+boolean mp_load_mem_file (MP mp) ;
+
+@ Mem files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(A)   { WW=(A);       (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_int(A)  { int cint=(A); (mp->write_binary_file)(mp,mp->mem_file,&cint,sizeof(cint)); }
+@d dump_hh(A)   { WW.hh=(A);    (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_qqqq(A) { WW.qqqq=(A);  (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); }
+@d dump_string(A) { dump_int(strlen(A)+1);
+                    (mp->write_binary_file)(mp,mp->mem_file,A,strlen(A)+1); }
+
+@<Glob...@>=
+void * mem_file; /* for input or output of mem information */
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d mgeti(A) do {
+  size_t wanted = sizeof(A);
+  void *A_ptr = &A;
+  (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
+  if (wanted!=sizeof(A)) goto OFF_BASE;
+} while (0)
+
+@d mgetw(A) do {
+  size_t wanted = sizeof(A);
+  void *A_ptr = &A;
+  (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted);
+  if (wanted!=sizeof(A)) goto OFF_BASE;
+} while (0)
+
+@d undump_wd(A)   { mgetw(WW); A=WW; }
+@d undump_int(A)  { int cint; mgeti(cint); A=cint; }
+@d undump_hh(A)   { mgetw(WW); A=WW.hh; }
+@d undump_qqqq(A) { mgetw(WW); A=WW.qqqq; }
+@d undump_strings(A,B,C) { 
+   undump_int(x); if ( (x<(A)) || (x>(B)) ) goto OFF_BASE; else C=str(x); }
+@d undump(A,B,C) { undump_int(x); if ( (x<(A)) || (x>(int)(B)) ) goto OFF_BASE; else C=x; }
+@d undump_size(A,B,C,D) { undump_int(x);
+                          if (x<(A)) goto OFF_BASE; 
+                          if (x>(B)) { too_small((C)); } else { D=x;} }
+@d undump_string(A) do { 
+  size_t the_wanted; 
+  void *the_string;
+  integer XX=0; 
+  undump_int(XX);
+  the_wanted = XX;
+  the_string = xmalloc(XX,sizeof(char));
+  (mp->read_binary_file)(mp,mp->mem_file,&the_string,&the_wanted);
+  A = (char *)the_string;
+  if (the_wanted!=(size_t)XX) goto OFF_BASE;
+} while (0)
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+dump_int(mp->mem_top);
+dump_int(mp->hash_size);
+dump_int(mp->hash_prime)
+dump_int(mp->param_size);
+dump_int(mp->max_in_open);
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INIMP} and \MP\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@<Undump constants for consistency check@>=
+undump_int(x); mp->mem_top = x;
+undump_int(x); if (mp->hash_size != x) goto OFF_BASE;
+undump_int(x); if (mp->hash_prime != x) goto OFF_BASE;
+undump_int(x); if (mp->param_size != x) goto OFF_BASE;
+undump_int(x); if (mp->max_in_open != x) goto OFF_BASE
+
+@ We do string pool compaction to avoid dumping unused strings.
+
+@d dump_four_ASCII 
+  w.b0=qi(mp->str_pool[k]); w.b1=qi(mp->str_pool[k+1]);
+  w.b2=qi(mp->str_pool[k+2]); w.b3=qi(mp->str_pool[k+3]);
+  dump_qqqq(w)
+
+@<Dump the string pool@>=
+mp_do_compaction(mp, mp->pool_size);
+dump_int(mp->pool_ptr);
+dump_int(mp->max_str_ptr);
+dump_int(mp->str_ptr);
+k=0;
+while ( (mp->next_str[k]==k+1) && (k<=mp->max_str_ptr) ) 
+  incr(k);
+dump_int(k);
+while ( k<=mp->max_str_ptr ) { 
+  dump_int(mp->next_str[k]); incr(k);
+}
+k=0;
+while (1)  { 
+  dump_int(mp->str_start[k]); /* TODO: valgrind warning here */
+  if ( k==mp->str_ptr ) {
+    break;
+  } else { 
+    k=mp->next_str[k]; 
+  }
+}
+k=0;
+while (k+4<mp->pool_ptr ) { 
+  dump_four_ASCII; k=k+4; 
+}
+k=mp->pool_ptr-4; dump_four_ASCII;
+mp_print_ln(mp); mp_print(mp, "at most "); mp_print_int(mp, mp->max_str_ptr);
+mp_print(mp, " strings of total length ");
+mp_print_int(mp, mp->pool_ptr)
+
+@ @d undump_four_ASCII 
+  undump_qqqq(w);
+  mp->str_pool[k]=qo(w.b0); mp->str_pool[k+1]=qo(w.b1);
+  mp->str_pool[k+2]=qo(w.b2); mp->str_pool[k+3]=qo(w.b3)
+
+@<Undump the string pool@>=
+undump_int(mp->pool_ptr);
+mp_reallocate_pool(mp, mp->pool_ptr) ;
+undump_int(mp->max_str_ptr);
+mp_reallocate_strings (mp,mp->max_str_ptr) ;
+undump(0,mp->max_str_ptr,mp->str_ptr);
+undump(0,mp->max_str_ptr+1,s);
+for (k=0;k<=s-1;k++) 
+  mp->next_str[k]=k+1;
+for (k=s;k<=mp->max_str_ptr;k++) 
+  undump(s+1,mp->max_str_ptr+1,mp->next_str[k]);
+mp->fixed_str_use=0;
+k=0;
+while (1) { 
+  undump(0,mp->pool_ptr,mp->str_start[k]);
+  if ( k==mp->str_ptr ) break;
+  mp->str_ref[k]=max_str_ref;
+  incr(mp->fixed_str_use);
+  mp->last_fixed_str=k; k=mp->next_str[k];
+}
+k=0;
+while ( k+4<mp->pool_ptr ) { 
+  undump_four_ASCII; k=k+4;
+}
+k=mp->pool_ptr-4; undump_four_ASCII;
+mp->init_str_use=mp->fixed_str_use; mp->init_pool_ptr=mp->pool_ptr;
+mp->max_pool_ptr=mp->pool_ptr;
+mp->strs_used_up=mp->fixed_str_use;
+mp->pool_in_use=mp->str_start[mp->str_ptr]; mp->strs_in_use=mp->fixed_str_use;
+mp->max_pl_used=mp->pool_in_use; mp->max_strs_used=mp->strs_in_use;
+mp->pact_count=0; mp->pact_chars=0; mp->pact_strs=0;
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+mp_sort_avail(mp); mp->var_used=0;
+dump_int(mp->lo_mem_max); dump_int(mp->rover);
+p=0; q=mp->rover; x=0;
+do {  
+  for (k=p;k<= q+1;k++) 
+    dump_wd(mp->mem[k]);
+  x=x+q+2-p; mp->var_used=mp->var_used+q-p;
+  p=q+node_size(q); q=rlink(q);
+} while (q!=mp->rover);
+mp->var_used=mp->var_used+mp->lo_mem_max-p; 
+mp->dyn_used=mp->mem_end+1-mp->hi_mem_min;
+for (k=p;k<= mp->lo_mem_max;k++ ) 
+  dump_wd(mp->mem[k]);
+x=x+mp->lo_mem_max+1-p;
+dump_int(mp->hi_mem_min); dump_int(mp->avail);
+for (k=mp->hi_mem_min;k<=mp->mem_end;k++ ) 
+  dump_wd(mp->mem[k]);
+x=x+mp->mem_end+1-mp->hi_mem_min;
+p=mp->avail;
+while ( p!=null ) { 
+  decr(mp->dyn_used); p=link(p);
+}
+dump_int(mp->var_used); dump_int(mp->dyn_used);
+mp_print_ln(mp); mp_print_int(mp, x);
+mp_print(mp, " memory locations dumped; current usage is ");
+mp_print_int(mp, mp->var_used); mp_print_char(mp, '&'); mp_print_int(mp, mp->dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump(lo_mem_stat_max+1000,hi_mem_stat_min-1,mp->lo_mem_max);
+undump(lo_mem_stat_max+1,mp->lo_mem_max,mp->rover);
+p=0; q=mp->rover;
+do {  
+  for (k=p;k<= q+1; k++) 
+    undump_wd(mp->mem[k]);
+  p=q+node_size(q);
+  if ( (p>mp->lo_mem_max)||((q>=rlink(q))&&(rlink(q)!=mp->rover)) ) 
+    goto OFF_BASE;
+  q=rlink(q);
+} while (q!=mp->rover);
+for (k=p;k<=mp->lo_mem_max;k++ ) 
+  undump_wd(mp->mem[k]);
+undump(mp->lo_mem_max+1,hi_mem_stat_min,mp->hi_mem_min);
+undump(null,mp->mem_top,mp->avail); mp->mem_end=mp->mem_top;
+for (k=mp->hi_mem_min;k<= mp->mem_end;k++) 
+  undump_wd(mp->mem[k]);
+undump_int(mp->var_used); undump_int(mp->dyn_used)
+
+@ A different scheme is used to compress the hash table, since its lower region
+is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three
+words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely
+packed for |p>=hash_used|, so the remaining entries are output in~a~block.
+
+@<Dump the table of equivalents and the hash table@>=
+dump_int(mp->hash_used); 
+mp->st_count=frozen_inaccessible-1-mp->hash_used;
+for (p=1;p<=mp->hash_used;p++) {
+  if ( text(p)!=0 ) {
+     dump_int(p); dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); incr(mp->st_count);
+  }
+}
+for (p=mp->hash_used+1;p<=(int)hash_end;p++) {
+  dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]);
+}
+dump_int(mp->st_count);
+mp_print_ln(mp); mp_print_int(mp, mp->st_count); mp_print(mp, " symbolic tokens")
+
+@ @<Undump the table of equivalents and the hash table@>=
+undump(1,frozen_inaccessible,mp->hash_used); 
+p=0;
+do {  
+  undump(p+1,mp->hash_used,p); 
+  undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
+} while (p!=mp->hash_used);
+for (p=mp->hash_used+1;p<=(int)hash_end;p++ )  { 
+  undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]);
+}
+undump_int(mp->st_count)
+
+@ We have already printed a lot of statistics, so we set |mp_tracing_stats:=0|
+to prevent them appearing again.
+
+@<Dump a few more things and the closing check word@>=
+dump_int(mp->max_internal);
+dump_int(mp->int_ptr);
+for (k=1;k<= mp->int_ptr;k++ ) { 
+  dump_int(mp->internal[k]); 
+  dump_string(mp->int_name[k]);
+}
+dump_int(mp->start_sym); 
+dump_int(mp->interaction); 
+dump_string(mp->mem_ident);
+dump_int(mp->bg_loc); dump_int(mp->eg_loc); dump_int(mp->serial_no); dump_int(69073);
+mp->internal[mp_tracing_stats]=0
+
+@ @<Undump a few more things and the closing check word@>=
+undump_int(x);
+if (x>mp->max_internal) mp_grow_internals(mp,x);
+undump_int(mp->int_ptr);
+for (k=1;k<= mp->int_ptr;k++) { 
+  undump_int(mp->internal[k]);
+  undump_string(mp->int_name[k]);
+}
+undump(0,frozen_inaccessible,mp->start_sym);
+if (mp->interaction==mp_unspecified_mode) {
+  undump(mp_unspecified_mode,mp_error_stop_mode,mp->interaction);
+} else {
+  undump(mp_unspecified_mode,mp_error_stop_mode,x);
+}
+undump_string(mp->mem_ident);
+undump(1,hash_end,mp->bg_loc);
+undump(1,hash_end,mp->eg_loc);
+undump_int(mp->serial_no);
+undump_int(x); 
+if (x!=69073) goto OFF_BASE
+
+@ @<Create the |mem_ident|...@>=
+{ 
+  xfree(mp->mem_ident);
+  mp->mem_ident = xmalloc(256,1);
+  snprintf(mp->mem_ident,256," (mem=%s %i.%i.%i)", 
+           mp->job_name,
+           (int)(mp_round_unscaled(mp, mp->internal[mp_year]) % 100),
+           (int)mp_round_unscaled(mp, mp->internal[mp_month]),
+           (int)mp_round_unscaled(mp, mp->internal[mp_day]));
+  mp_pack_job_name(mp, mem_extension);
+  while (! mp_w_open_out(mp, &mp->mem_file) )
+    mp_prompt_file_name(mp, "mem file name", mem_extension);
+  mp_print_nl(mp, "Beginning to dump on file ");
+@.Beginning to dump...@>
+  mp_print(mp, mp->name_of_file); 
+  mp_print_nl(mp, mp->mem_ident);
+}
+
+@ @<Dealloc variables@>=
+xfree(mp->mem_ident);
+
+@ @<Close the mem file@>=
+(mp->close_file)(mp,mp->mem_file)
+
+@* \[46] The main program.
+This is it: the part of \MP\ that executes all those procedures we have
+written.
+
+Well---almost. We haven't put the parsing subroutines into the
+program yet; and we'd better leave space for a few more routines that may
+have been forgotten.
+
+@c @<Declare the basic parsing subroutines@>
+@<Declare miscellaneous procedures that were declared |forward|@>
+@<Last-minute procedures@>
+
+@ We've noted that there are two versions of \MP. One, called \.{INIMP},
+@.INIMP@>
+has to be run first; it initializes everything from scratch, without
+reading a mem file, and it has the capability of dumping a mem file.
+The other one is called `\.{VIRMP}'; it is a ``virgin'' program that needs
+@.VIRMP@>
+to input a mem file in order to get started. \.{VIRMP} typically has
+a bit more memory capacity than \.{INIMP}, because it does not need the
+space consumed by the dumping/undumping routines and the numerous calls on
+|primitive|, etc.
+
+The \.{VIRMP} program cannot read a mem file instantaneously, of course;
+the best implementations therefore allow for production versions of \MP\ that
+not only avoid the loading routine for object code, they also have
+a mem file pre-loaded. 
+
+@ @<Option variables@>=
+int ini_version; /* are we iniMP? */
+
+@ @<Set |ini_version|@>=
+mp->ini_version = (opt->ini_version ? true : false);
+
+@ Here we do whatever is needed to complete \MP's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+void mp_close_files_and_terminate (MP mp) {
+  integer k; /* all-purpose index */
+  integer LH; /* the length of the \.{TFM} header, in words */
+  int lk_offset; /* extra words inserted at beginning of |lig_kern| array */
+  pointer p; /* runs through a list of \.{TFM} dimensions */
+  @<Close all open files in the |rd_file| and |wr_file| arrays@>;
+  if ( mp->internal[mp_tracing_stats]>0 )
+    @<Output statistics about this job@>;
+  wake_up_terminal; 
+  @<Do all the finishing work on the \.{TFM} file@>;
+  @<Explain what output files were written@>;
+  if ( mp->log_opened ){ 
+    wlog_cr;
+    (mp->close_file)(mp,mp->log_file); 
+    mp->selector=mp->selector-2;
+    if ( mp->selector==term_only ) {
+      mp_print_nl(mp, "Transcript written on ");
+@.Transcript written...@>
+      mp_print(mp, mp->log_name); mp_print_char(mp, '.');
+    }
+  }
+  mp_print_ln(mp);
+  t_close_out;
+  t_close_in;
+}
+
+@ @<Declarations@>=
+void mp_close_files_and_terminate (MP mp) ;
+
+@ @<Close all open files in the |rd_file| and |wr_file| arrays@>=
+if (mp->rd_fname!=NULL) {
+  for (k=0;k<=(int)mp->read_files-1;k++ ) {
+    if ( mp->rd_fname[k]!=NULL ) {
+      (mp->close_file)(mp,mp->rd_file[k]);
+   }
+ }
+}
+if (mp->wr_fname!=NULL) {
+  for (k=0;k<=(int)mp->write_files-1;k++) {
+    if ( mp->wr_fname[k]!=NULL ) {
+     (mp->close_file)(mp,mp->wr_file[k]);
+    }
+  }
+}
+
+@ @<Dealloc ...@>=
+for (k=0;k<(int)mp->max_read_files;k++ ) {
+  if ( mp->rd_fname[k]!=NULL ) {
+    (mp->close_file)(mp,mp->rd_file[k]);
+    mp_xfree(mp->rd_fname[k]); 
+  }
+}
+mp_xfree(mp->rd_file);
+mp_xfree(mp->rd_fname);
+for (k=0;k<(int)mp->max_write_files;k++) {
+  if ( mp->wr_fname[k]!=NULL ) {
+    (mp->close_file)(mp,mp->wr_file[k]);
+    mp_xfree(mp->wr_fname[k]); 
+  }
+}
+mp_xfree(mp->wr_file);
+mp_xfree(mp->wr_fname);
+
+
+@ We want to produce a \.{TFM} file if and only if |mp_fontmaking| is positive.
+
+We reclaim all of the variable-size memory at this point, so that
+there is no chance of another memory overflow after the memory capacity
+has already been exceeded.
+
+@<Do all the finishing work on the \.{TFM} file@>=
+if ( mp->internal[mp_fontmaking]>0 ) {
+  @<Make the dynamic memory into one big available node@>;
+  @<Massage the \.{TFM} widths@>;
+  mp_fix_design_size(mp); mp_fix_check_sum(mp);
+  @<Massage the \.{TFM} heights, depths, and italic corrections@>;
+  mp->internal[mp_fontmaking]=0; /* avoid loop in case of fatal error */
+  @<Finish the \.{TFM} file@>;
+}
+
+@ @<Make the dynamic memory into one big available node@>=
+mp->rover=lo_mem_stat_max+1; link(mp->rover)=empty_flag; mp->lo_mem_max=mp->hi_mem_min-1;
+if ( mp->lo_mem_max-mp->rover>max_halfword ) mp->lo_mem_max=max_halfword+mp->rover;
+node_size(mp->rover)=mp->lo_mem_max-mp->rover; 
+llink(mp->rover)=mp->rover; rlink(mp->rover)=mp->rover;
+link(mp->lo_mem_max)=null; info(mp->lo_mem_max)=null
+
+@ The present section goes directly to the log file instead of using
+|print| commands, because there's no need for these strings to take
+up |str_pool| memory when a non-{\bf stat} version of \MP\ is being used.
+
+@<Output statistics...@>=
+if ( mp->log_opened ) { 
+  char s[128];
+  wlog_ln(" ");
+  wlog_ln("Here is how much of MetaPost's memory you used:");
+@.Here is how much...@>
+  snprintf(s,128," %i string%s out of %i",(int)mp->max_strs_used-mp->init_str_use,
+          (mp->max_strs_used!=mp->init_str_use+1 ? "s" : ""),
+          (int)(mp->max_strings-1-mp->init_str_use));
+  wlog_ln(s);
+  snprintf(s,128," %i string characters out of %i",
+           (int)mp->max_pl_used-mp->init_pool_ptr,
+           (int)mp->pool_size-mp->init_pool_ptr);
+  wlog_ln(s);
+  snprintf(s,128," %i words of memory out of %i",
+           (int)mp->lo_mem_max+mp->mem_end-mp->hi_mem_min+2,
+           (int)mp->mem_end);
+  wlog_ln(s);
+  snprintf(s,128," %i symbolic tokens out of %i", (int)mp->st_count, (int)mp->hash_size);
+  wlog_ln(s);
+  snprintf(s,128," %ii,%in,%ip,%ib stack positions out of %ii,%in,%ip,%ib",
+           (int)mp->max_in_stack,(int)mp->int_ptr,
+           (int)mp->max_param_stack,(int)mp->max_buf_stack+1,
+           (int)mp->stack_size,(int)mp->max_internal,(int)mp->param_size,(int)mp->buf_size);
+  wlog_ln(s);
+  snprintf(s,128," %i string compactions (moved %i characters, %i strings)",
+          (int)mp->pact_count,(int)mp->pact_chars,(int)mp->pact_strs);
+  wlog_ln(s);
+}
+
+@ It is nice to have have some of the stats available from the API.
+
+@<Exported function ...@>=
+int mp_memory_usage (MP mp );
+int mp_hash_usage (MP mp );
+int mp_param_usage (MP mp );
+int mp_open_usage (MP mp );
+
+@ @c
+int mp_memory_usage (MP mp ) {
+	return (int)mp->lo_mem_max+mp->mem_end-mp->hi_mem_min+2;
+}
+int mp_hash_usage (MP mp ) {
+  return (int)mp->st_count;
+}
+int mp_param_usage (MP mp ) {
+	return (int)mp->max_param_stack;
+}
+int mp_open_usage (MP mp ) {
+	return (int)mp->max_in_stack;
+}
+
+@ We get to the |final_cleanup| routine when \&{end} or \&{dump} has
+been scanned.
+
+@<Last-minute...@>=
+void mp_final_cleanup (MP mp) {
+  small_number c; /* 0 for \&{end}, 1 for \&{dump} */
+  c=mp->cur_mod;
+  if ( mp->job_name==NULL ) mp_open_log_file(mp);
+  while ( mp->input_ptr>0 ) {
+    if ( token_state ) mp_end_token_list(mp);
+    else  mp_end_file_reading(mp);
+  }
+  while ( mp->loop_ptr!=null ) mp_stop_iteration(mp);
+  while ( mp->open_parens>0 ) { 
+    mp_print(mp, " )"); decr(mp->open_parens);
+  };
+  while ( mp->cond_ptr!=null ) {
+    mp_print_nl(mp, "(end occurred when ");
+@.end occurred...@>
+    mp_print_cmd_mod(mp, fi_or_else,mp->cur_if);
+    /* `\.{if}' or `\.{elseif}' or `\.{else}' */
+    if ( mp->if_line!=0 ) {
+      mp_print(mp, " on line "); mp_print_int(mp, mp->if_line);
+    }
+    mp_print(mp, " was incomplete)");
+    mp->if_line=if_line_field(mp->cond_ptr);
+    mp->cur_if=name_type(mp->cond_ptr); mp->cond_ptr=link(mp->cond_ptr);
+  }
+  if ( mp->history!=mp_spotless )
+    if ( ((mp->history==mp_warning_issued)||(mp->interaction<mp_error_stop_mode)) )
+      if ( mp->selector==term_and_log ) {
+    mp->selector=term_only;
+    mp_print_nl(mp, "(see the transcript file for additional information)");
+@.see the transcript file...@>
+    mp->selector=term_and_log;
+  }
+  if ( c==1 ) {
+    if (mp->ini_version) {
+      mp_store_mem_file(mp); return;
+    }
+    mp_print_nl(mp, "(dump is performed only by INIMP)"); return;
+@.dump...only by INIMP@>
+  }
+}
+
+@ @<Declarations@>=
+void mp_final_cleanup (MP mp) ;
+void mp_init_prim (MP mp) ;
+void mp_init_tab (MP mp) ;
+
+@ @<Last-minute...@>=
+void mp_init_prim (MP mp) { /* initialize all the primitives */
+  @<Put each...@>;
+}
+@#
+void mp_init_tab (MP mp) { /* initialize other tables */
+  integer k; /* all-purpose index */
+  @<Initialize table entries (done by \.{INIMP} only)@>;
+}
+
+
+@ When we begin the following code, \MP's tables may still contain garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \MP\ is ready to call on the
+|main_control| routine to do its work.
+
+@<Get the first line...@>=
+{ 
+  @<Initialize the input routines@>;
+  if ( (mp->mem_ident==NULL)||(mp->buffer[loc]=='&') ) {
+    if ( mp->mem_ident!=NULL ) {
+      mp_do_initialize(mp); /* erase preloaded mem */
+    }
+    if ( ! mp_open_mem_file(mp) ) return mp_fatal_error_stop;
+    if ( ! mp_load_mem_file(mp) ) {
+      (mp->close_file)(mp, mp->mem_file); 
+      return mp_fatal_error_stop;
+    }
+    (mp->close_file)(mp, mp->mem_file);
+    while ( (loc<limit)&&(mp->buffer[loc]==' ') ) incr(loc);
+  }
+  mp->buffer[limit]='%';
+  mp_fix_date_and_time(mp);
+  if (mp->random_seed==0)
+    mp->random_seed = (mp->internal[mp_time] / unity)+mp->internal[mp_day];
+  mp_init_randoms(mp, mp->random_seed);
+  @<Initialize the print |selector|...@>;
+  if ( loc<limit ) if ( mp->buffer[loc]!='\\' ) 
+    mp_start_input(mp); /* \&{input} assumed */
+}
+
+@ @<Run inimpost commands@>=
+{
+  mp_get_strings_started(mp);
+  mp_init_tab(mp); /* initialize the tables */
+  mp_init_prim(mp); /* call |primitive| for each primitive */
+  mp->init_str_use=mp->str_ptr; mp->init_pool_ptr=mp->pool_ptr;
+  mp->max_str_ptr=mp->str_ptr; mp->max_pool_ptr=mp->pool_ptr;
+  mp_fix_date_and_time(mp);
+}
+
+
+@* \[47] Debugging.
+Once \MP\ is working, you should be able to diagnose most errors with
+the \.{show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \MP\ with a few more aids. An additional routine called |debug_help|
+will also come into play when you type `\.D' after an error message;
+|debug_help| also occurs just before a fatal error causes \MP\ to succumb.
+@^debugging@>
+@^system dependencies@>
+
+The interface to |debug_help| is primitive, but it is good enough when used
+with a debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits |debug_help|), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the debugger), or a positive number |m| followed by
+an argument |n|. The meaning of |m| and |n| will be clear from the
+program below. (If |m=13|, there is an additional argument, |l|.)
+@.debug \#@>
+
+@<Last-minute...@>=
+void mp_debug_help (MP mp) { /* routine to display various things */
+  integer k;
+  int l,m,n;
+  char *aline;
+  size_t len;
+  while (1) { 
+    wake_up_terminal;
+    mp_print_nl(mp, "debug # (-1 to exit):"); update_terminal;
+@.debug \#@>
+    m = 0;
+    aline = (mp->read_ascii_file)(mp,mp->term_in, &len);
+    if (len) { sscanf(aline,"%i",&m); xfree(aline); }
+    if ( m<=0 )
+      return;
+    n = 0 ;
+    aline = (mp->read_ascii_file)(mp,mp->term_in, &len);
+    if (len) { sscanf(aline,"%i",&n); xfree(aline); }
+    switch (m) {
+    @<Numbered cases for |debug_help|@>;
+    default: mp_print(mp, "?"); break;
+    }
+  }
+}
+
+@ @<Numbered cases...@>=
+case 1: mp_print_word(mp, mp->mem[n]); /* display |mem[n]| in all forms */
+  break;
+case 2: mp_print_int(mp, info(n));
+  break;
+case 3: mp_print_int(mp, link(n));
+  break;
+case 4: mp_print_int(mp, eq_type(n)); mp_print_char(mp, ':'); mp_print_int(mp, equiv(n));
+  break;
+case 5: mp_print_variable_name(mp, n);
+  break;
+case 6: mp_print_int(mp, mp->internal[n]);
+  break;
+case 7: mp_do_show_dependencies(mp);
+  break;
+case 9: mp_show_token_list(mp, n,null,100000,0);
+  break;
+case 10: mp_print_str(mp, n);
+  break;
+case 11: mp_check_mem(mp, n>0); /* check wellformedness; print new busy locations if |n>0| */
+  break;
+case 12: mp_search_mem(mp, n); /* look for pointers to |n| */
+  break;
+case 13: 
+  l = 0;  
+  aline = (mp->read_ascii_file)(mp,mp->term_in, &len);
+  if (len) { sscanf(aline,"%i",&l); xfree(aline); }
+  mp_print_cmd_mod(mp, n,l); 
+  break;
+case 14: for (k=0;k<=n;k++) mp_print_str(mp, mp->buffer[k]);
+  break;
+case 15: mp->panicking=! mp->panicking;
+  break;
+
+
+@ Saving the filename template
+
+@<Save the filename template@>=
+{ 
+  if ( mp->filename_template!=0 ) delete_str_ref(mp->filename_template);
+  if ( length(mp->cur_exp)==0 ) mp->filename_template=0;
+  else { 
+    mp->filename_template=mp->cur_exp; add_str_ref(mp->filename_template);
+  }
+}
+
+@* \[48] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modification of the program
+that are necessary to make \MP\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* \[49] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \MP\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''.
+Approximately 25 sections are listed under ``inner loop''; these account
+for more than 60\pct! of \MP's running time, exclusive of input and output.
diff --git a/Build/source/texk/web2c/luatexdir/lua/psout.w b/Build/source/texk/web2c/luatexdir/lua/psout.w
new file mode 100644
index 00000000000..4a3f588ef7f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/psout.w
@@ -0,0 +1,5697 @@
+% $Id: mp.web,v 1.8 2005/08/24 10:54:02 taco Exp $
+% MetaPost, by John Hobby.  Public domain.
+
+% Much of this program was copied with permission from MF.web Version 1.9
+% It interprets a language very similar to D.E. Knuth's METAFONT, but with
+% changes designed to make it more suitable for PostScript output.
+
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+% PostScript is a trademark of Adobe Systems Incorporated.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\def\PASCAL{Pascal}
+\def\ps{PostScript}
+\def\ph{\hbox{Pascal-H}}
+\def\psqrt#1{\sqrt{\mathstrut#1}}
+\def\k{_{k+1}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\font\logos=logosl10
+\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+\mathchardef\vb="026A % synonym for `\|'
+\def\[#1]{} % from pascal web
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{MetaPost \ps\ output}
+\def\topofcontents{\hsize 5.5in
+  \vglue -30pt plus 1fil minus 1.5in
+  \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+  }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pdfoutput=1
+\pageno=3
+
+@ 
+@d true 1
+@d false 0
+@d null_font 0
+@d null 0
+@d unity   0200000 /* $2^{16}$, represents 1.00000 */
+@d el_gordo   017777777777 /* $2^{31}-1$, the largest value that \MP\ likes */
+@d incr(A)   (A)=(A)+1 /* increase a variable by unity */
+@d decr(A)   (A)=(A)-1 /* decrease a variable by unity */
+@d negate(A)   (A)=-(A) /* change the sign of a variable */
+@d odd(A)   ((A)%2==1)
+@d half(A) ((A)/2)
+@d print_err(A) mp_print_err(mp,(A))
+@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
+
+@c
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdarg.h>
+#include <assert.h>
+#include "avl.h"
+#include "mplib.h"
+#include "mpmp.h" /* internal header */
+#include "mppsout.h" /* internal header */
+@h
+@<Declarations@>
+@<Static variables in the outer block@>
+
+@ There is a small bit of code from the backend that bleads through
+to the frontend because I do not know how to set up the includes
+properly. Those are the definitions of |struct libavl_allocator|
+and |typedef struct psout_data_struct * psout_data|.
+
+The |libavl_allocator| is a trick that makes sure that frontends 
+do not need |avl.h|, and the |psout_data| is needed for the backend 
+data structure.
+
+@ @(mppsout.h@>=
+@<Types...@>
+typedef struct psout_data_struct {
+  @<Globals@>
+} psout_data_struct ;
+@<Exported function headers@>
+
+@ @<Exported function headers@>=
+void mp_backend_initialize (MP mp) ;
+void mp_backend_free (MP mp) ;
+
+@
+@c void mp_backend_initialize (MP mp) {
+  mp->ps = mp_xmalloc(mp,1,sizeof(psout_data_struct));
+  @<Set initial values@>;
+}
+void mp_backend_free (MP mp) {
+  @<Dealloc variables@>;
+  enc_free(mp);
+  t1_free(mp);
+  fm_free(mp);
+  mp_xfree(mp->ps);
+  mp->ps = NULL;
+}
+
+@ Writing to ps files
+
+@<Globals@>=
+integer ps_offset;
+  /* the number of characters on the current \ps\ file line */
+
+@ @<Set initial values@>=
+mp->ps->ps_offset = 0;
+
+@
+
+@d wps(A)     (mp->write_ascii_file)(mp,mp->ps_file,(A))
+@d wps_chr(A) do { 
+  char ss[2]; 
+  ss[0]=(A); ss[1]=0; 
+  (mp->write_ascii_file)(mp,mp->ps_file,(char *)ss); 
+} while (0)
+@d wps_cr     (mp->write_ascii_file)(mp,mp->ps_file,"\n")
+@d wps_ln(A)  { wterm_cr; (mp->write_ascii_file)(mp,mp->ps_file,(A)); }
+
+@c
+void mp_ps_print_ln (MP mp) { /* prints an end-of-line */
+  wps_cr; 
+  mp->ps->ps_offset=0;
+} 
+
+@ @c
+void mp_ps_print_char (MP mp, ASCII_code s) { /* prints a single character */
+  if ( s==13 ) {
+    wps_cr; mp->ps->ps_offset=0;
+  } else {
+    wps_chr(s); incr(mp->ps->ps_offset);
+  }
+}
+
+@ @c
+void mp_ps_do_print (MP mp, const char *ss, unsigned int len) { /* prints string |s| */
+  unsigned int j = 0;
+  while ( j<len ){ 
+    mp_ps_print_char(mp, ss[j]); incr(j);
+  }
+}
+
+@ Deciding where to break the ps output line. 
+
+@d ps_room(A) if ( (mp->ps->ps_offset+(int)(A))>mp->max_print_line ) {
+  mp_ps_print_ln(mp); /* optional line break */
+}
+
+@c
+void mp_ps_print (MP mp, const char *ss) {
+  ps_room(strlen(ss));
+  mp_ps_do_print(mp, ss, strlen(ss));
+}
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line.
+
+@c
+void mp_ps_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */
+  if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp);
+  mp_ps_print(mp, s);
+}
+
+@ An array of digits in the range |0..9| is printed by |print_the_digs|.
+
+@c
+void mp_ps_print_the_digs (MP mp, eight_bits k) {
+  /* prints |dig[k-1]|$\,\ldots\,$|dig[0]| */
+  while ( k-->0 ){ 
+    mp_ps_print_char(mp, '0'+mp->dig[k]);
+  }
+}
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+@c
+void mp_ps_print_int (MP mp,integer n) { /* prints an integer in decimal form */
+  integer m; /* used to negate |n| in possibly dangerous cases */
+  int k = 0; /* index to current digit; we assume that $|n|<10^{23}$ */
+  if ( n<0 ) { 
+    mp_ps_print_char(mp, '-');
+    if ( n>-100000000 ) {
+	  negate(n);
+    } else  { 
+	  m=-1-n; n=m / 10; m=(m % 10)+1; k=1;
+      if ( m<10 ) {
+        mp->dig[0]=m;
+      } else { 
+        mp->dig[0]=0; incr(n);
+      }
+    }
+  }
+  do {  
+    mp->dig[k]=n % 10; n=n / 10; incr(k);
+  } while (n!=0);
+  mp_ps_print_the_digs(mp, k);
+}
+
+@ @<Internal ...@>=
+void mp_ps_print_int (MP mp,integer n);
+
+@ \MP\ also makes use of a trivial procedure to print two digits. The
+following subroutine is usually called with a parameter in the range |0<=n<=99|.
+
+@c 
+void mp_ps_print_dd (MP mp,integer n) { /* prints two least significant digits */
+  n=abs(n) % 100; 
+  mp_ps_print_char(mp, '0'+(n / 10));
+  mp_ps_print_char(mp, '0'+(n % 10));
+}
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \MP\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly. A decimal point is printed only if the value is
+not an integer. If there is more than one way to print the result with
+the optimum number of digits following the decimal point, the closest
+possible value is given.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@c
+void mp_ps_print_scaled (MP mp,scaled s) { 
+  scaled delta; /* amount of allowable inaccuracy */
+  if ( s<0 ) { 
+	mp_ps_print_char(mp, '-'); 
+    negate(s); /* print the sign, if negative */
+  }
+  mp_ps_print_int(mp, s / unity); /* print the integer part */
+  s=10*(s % unity)+5;
+  if ( s!=5 ) { 
+    delta=10; 
+    mp_ps_print_char(mp, '.');
+    do {  
+      if ( delta>unity )
+        s=s+0100000-(delta / 2); /* round the final digit */
+      mp_ps_print_char(mp, '0'+(s / unity)); 
+      s=10*(s % unity); 
+      delta=delta*10;
+    } while (s>delta);
+  }
+}
+
+
+@* \[44a] Dealing with font encodings.
+
+First, here are a few helpers for parsing files
+
+@d check_buf(size, buf_size)
+    if ((unsigned)(size) > (unsigned)(buf_size)) {
+      char S[128];
+      snprintf(S,128,"buffer overflow: (%d,%d) at file %s, line %d",
+               size,buf_size, __FILE__,  __LINE__ );
+      mp_fatal_error(mp,S);
+    }
+
+@d append_char_to_buf(c, p, buf, buf_size) do {
+    if (c == 9)
+        c = 32;
+    if (c == 13 || c == EOF)
+        c = 10;
+    if (c != ' ' || (p > buf && p[-1] != 32)) {
+        check_buf(p - buf + 1, (buf_size));
+        *p++ = c; 
+    }
+} while (0)
+
+@d append_eol(p, buf, buf_size) do {
+    check_buf(p - buf + 2, (buf_size));
+    if (p - buf > 1 && p[-1] != 10)
+        *p++ = 10;
+    if (p - buf > 2 && p[-2] == 32) {
+        p[-2] = 10;
+        p--;
+    }
+    *p = 0;
+} while (0)
+
+@d remove_eol(p, buf) do {
+    p = strend(buf) - 1;
+    if (*p == 10)
+        *p = 0;
+} while (0)
+
+@d skip(p, c)   if (*p == c)  p++
+@d strend(s)    strchr(s, 0)
+@d str_prefix(s1, s2)  (strncmp((s1), (s2), strlen(s2)) == 0)
+
+
+@ @<Types...@>=
+typedef struct {
+    boolean loaded;             /* the encoding has been loaded? */
+    char *file_name;                 /* encoding file name */
+    char *enc_name;              /* encoding true name */
+    integer objnum;             /* object number */
+    char **glyph_names;
+    integer tounicode;          /* object number of associated ToUnicode entry */
+} enc_entry;
+
+
+@ 
+
+@d ENC_STANDARD  0
+@d ENC_BUILTIN   1
+
+@<Glob...@>=
+#define ENC_BUF_SIZE  0x1000
+char enc_line[ENC_BUF_SIZE];
+void * enc_file;
+
+@ 
+@d enc_eof()       (mp->eof_file)(mp,mp->ps->enc_file)
+@d enc_close()     (mp->close_file)(mp,mp->ps->enc_file)
+
+@c
+int enc_getchar(MP mp) {
+  size_t len = 1;
+  unsigned char abyte=0;
+  void *byte_ptr = &abyte;  
+  (mp->read_binary_file)(mp,mp->ps->enc_file,&byte_ptr,&len);
+  return abyte;
+}
+
+@ @c 
+static boolean mp_enc_open (MP mp, char *n) {
+  mp->ps->enc_file=(mp->open_file)(mp,n, "r", mp_filetype_encoding);
+  if (mp->ps->enc_file!=NULL)
+    return true;
+  else
+   return false;
+}
+static void mp_enc_getline (MP mp) {
+  char *p;
+  int c;
+RESTART:
+  if (enc_eof ()) {
+    print_err("unexpected end of file");
+    mp_error(mp);
+  }
+  p = mp->ps->enc_line;
+  do {
+    c = enc_getchar (mp);
+    append_char_to_buf (c, p, mp->ps->enc_line, ENC_BUF_SIZE);
+  } while (c != 10);
+  append_eol (p, mp->ps->enc_line, ENC_BUF_SIZE);
+  if (p - mp->ps->enc_line < 2 || *mp->ps->enc_line == '%')
+    goto RESTART;
+}
+static void mp_load_enc (MP mp, char *enc_name, 
+                  char **enc_encname, char **glyph_names){
+  char buf[ENC_BUF_SIZE], *p, *r;
+  int names_count;
+  char *myname;
+  int save_selector = mp->selector;
+  if (!mp_enc_open (mp,enc_name)) {
+      mp_print (mp,"cannot open encoding file for reading");
+      return;
+  }
+  mp_normalize_selector(mp);
+  mp_print (mp,"{");
+  mp_print (mp, enc_name);
+  mp_enc_getline (mp);
+  if (*mp->ps->enc_line != '/' || (r = strchr (mp->ps->enc_line, '[')) == NULL) {
+    remove_eol (r, mp->ps->enc_line);
+    print_err ("invalid encoding vector (a name or `[' missing): `");
+    mp_print(mp,mp->ps->enc_line);
+    mp_print(mp,"'");
+    mp_error(mp);
+  }
+  while (*(r-1)==' ') r--; /* strip trailing spaces from encoding name */
+  myname = mp_xmalloc(mp,r-mp->ps->enc_line,1);
+  memcpy(myname,mp->ps->enc_line+1,(r-mp->ps->enc_line)-1);
+  *(myname+(r-mp->ps->enc_line-1))=0;
+  *enc_encname = myname;
+  while (*r!='[') r++;
+  r++;                        /* skip '[' */
+  names_count = 0;
+  skip (r, ' ');
+  for (;;) {
+    while (*r == '/') {
+      for (p = buf, r++;
+           *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++);
+        *p = 0;
+      skip (r, ' ');
+      if (names_count > 256) {
+        print_err ("encoding vector contains more than 256 names");
+        mp_error(mp);
+      }
+      if (mp_xstrcmp (buf, notdef) != 0)
+        glyph_names[names_count] = mp_xstrdup (mp,buf);
+      names_count++;
+    }
+    if (*r != 10 && *r != '%') {
+      if (str_prefix (r, "] def"))
+        goto DONE;
+      else {
+        remove_eol (r, mp->ps->enc_line);
+        print_err
+          ("invalid encoding vector: a name or `] def' expected: `");
+        mp_print(mp,mp->ps->enc_line);
+        mp_print(mp,"'");
+        mp_error(mp);
+      }
+    }
+    mp_enc_getline (mp);
+    r = mp->ps->enc_line;
+  }
+DONE:
+  enc_close ();
+  mp_print (mp,"}");
+  mp->selector = save_selector;
+}
+static void mp_read_enc (MP mp, enc_entry * e) {
+    if (e->loaded)
+        return;
+    e->enc_name = NULL;
+    mp_load_enc (mp,e->file_name, &e->enc_name, e->glyph_names);
+    e->loaded = true;
+}
+
+@ |write_enc| is used to write either external encoding (given in map file) or
+ internal encoding (read from the font file); 
+ the 2nd argument is a pointer to the encoding entry; 
+ 
+@c
+static void mp_write_enc (MP mp, enc_entry * e) {
+    int i;
+    int s;
+    int foffset;
+    char **g;
+    if (e->objnum != 0)     /* the encoding has been written already */
+       return;
+     e->objnum = 1;
+     g = e->glyph_names;
+
+    mp_ps_print(mp,"\n%%%%BeginResource: encoding ");
+    mp_ps_print(mp, e->enc_name);
+    mp_ps_print_nl(mp, "/");
+    mp_ps_print(mp, e->enc_name);
+    mp_ps_print(mp, " [ ");
+    foffset = strlen(e->file_name)+3;
+    for (i = 0; i < 256; i++) {
+      s = strlen(g[i]);
+      if (s+1+foffset>=80) {
+   	    mp_ps_print_ln (mp);
+    	foffset = 0;
+      }
+      foffset += s+2;
+      mp_ps_print_char(mp,'/');
+      mp_ps_print(mp, g[i]);
+      mp_ps_print_char(mp,' ');
+    }
+    if (foffset>75)
+ 	   mp_ps_print_ln (mp);
+    mp_ps_print_nl (mp,"] def\n");
+    mp_ps_print(mp,"%%%%EndResource");
+}
+
+
+@ All encoding entries go into AVL tree for fast search by name.
+
+@<Glob...@>=
+struct avl_table *enc_tree;
+
+@ Memory management functions for avl 
+
+@<Static variables in the outer block@>=
+static const char notdef[] = ".notdef";
+
+@ @<Declarations@>=
+static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size);
+static void avl_xfree (struct libavl_allocator *allocator, void *block);
+
+@ @c
+static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size) {
+    (void)allocator;
+    return malloc (size);
+}
+static void avl_xfree (struct libavl_allocator *allocator, void *block) {
+    (void)allocator;
+    free (block);
+}
+
+@ @<Glob...@>=
+struct libavl_allocator avl_xallocator;
+
+@ @<Set initial...@>=
+mp->ps->avl_xallocator.libavl_malloc=avl_xmalloc;
+mp->ps->avl_xallocator.libavl_free= avl_xfree;
+mp->ps->enc_tree = NULL;
+
+@ @c
+static int comp_enc_entry (const void *pa, const void *pb, void *p) {
+    (void)p;
+    return strcmp (((const enc_entry *) pa)->file_name,
+                   ((const enc_entry *) pb)->file_name);
+}
+static enc_entry * mp_add_enc (MP mp, char *s) {
+    int i;
+    enc_entry tmp, *p;
+    void **aa;
+    if (mp->ps->enc_tree == NULL) {
+      mp->ps->enc_tree = avl_create (comp_enc_entry, NULL, &mp->ps->avl_xallocator);
+    }
+    tmp.file_name = s;
+    p = (enc_entry *) avl_find (mp->ps->enc_tree, &tmp);
+    if (p != NULL)              /* encoding already registered */
+        return p;
+    p = mp_xmalloc (mp,1,sizeof (enc_entry));
+    p->loaded = false;
+    p->file_name = mp_xstrdup (mp,s);
+    p->objnum = 0;
+    p->tounicode = 0;
+    p->glyph_names = mp_xmalloc (mp,256,sizeof (char *));
+    for (i = 0; i < 256; i++)
+        p->glyph_names[i] = (char *) notdef;
+    aa = avl_probe (mp->ps->enc_tree, p);
+    return p;
+}
+
+@ cleaning up... 
+
+@c 
+static void mp_destroy_enc_entry (void *pa, void *pb) {
+    enc_entry *p;
+    int i;
+    p = (enc_entry *) pa;
+    (void)pb;
+    mp_xfree (p->file_name);
+    if (p->glyph_names != NULL)
+        for (i = 0; i < 256; i++)
+            if (p->glyph_names[i] != notdef)
+                mp_xfree (p->glyph_names[i]);
+    mp_xfree (p->glyph_names);
+    mp_xfree (p);
+}
+
+@ @<Declarations@>=
+static void enc_free (MP mp);
+
+@ @c static void enc_free (MP mp) {
+    if (mp->ps->enc_tree != NULL)
+      avl_destroy (mp->ps->enc_tree, mp_destroy_enc_entry);
+}
+
+@ @<Exported function headers@>=
+void mp_reload_encodings (MP mp) ;
+
+@ @<Declarations@>=
+static void mp_font_encodings (MP mp, int lastfnum, int encodings_only) ;
+
+@ @c void mp_reload_encodings (MP mp) {
+  int f;
+  enc_entry *e;
+  fm_entry *fm_cur;
+  int lastfnum = mp->last_fnum;
+  for (f=null_font+1;f<=lastfnum;f++) {
+    if (mp->font_enc_name[f]!=NULL ) {
+       mp_xfree(mp->font_enc_name[f]);
+       mp->font_enc_name[f]=NULL;
+    }
+    if (mp_has_fm_entry (mp,f,&fm_cur)) { 
+      if (fm_cur != NULL && fm_cur->ps_name != NULL &&is_reencoded (fm_cur)) {
+	e = fm_cur->encoding;
+	mp_read_enc (mp,e);
+      }
+    }
+  }
+}
+static void mp_font_encodings (MP mp, int lastfnum, int encodings_only) {
+  int f;
+  enc_entry *e;
+  fm_entry *fm;
+  for (f=null_font+1;f<=lastfnum;f++) {
+    if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp,f, &fm)) { 
+      if (fm != NULL && (fm->ps_name != NULL)) {
+	if (is_reencoded (fm)) {
+	  if (encodings_only || (!is_subsetted (fm))) {
+	    e = fm->encoding;
+	    mp_write_enc (mp, e);
+            /* clear for next run */
+            e->objnum = 0;
+	  }
+	}
+      }
+    }
+  }
+}
+
+@* \[44b] Parsing font map files.
+
+@d FM_BUF_SIZE     1024
+
+@<Glob...@>=
+void * fm_file;
+
+@
+@d fm_close()      (mp->close_file)(mp,mp->ps->fm_file)
+@d fm_eof()        (mp->eof_file)(mp,mp->ps->fm_file)
+
+@c
+int fm_getchar(MP mp) {
+  size_t len = 1;
+  unsigned char abyte=0;
+  void *byte_ptr = &abyte;  
+  (mp->read_binary_file)(mp,mp->ps->fm_file,&byte_ptr,&len);
+  if (len==0)
+    return EOF;
+  return abyte;
+}
+
+
+@ @<Types...@>=
+enum _mode { FM_DUPIGNORE, FM_REPLACE, FM_DELETE };
+enum _ltype { MAPFILE, MAPLINE };
+enum _tfmavail { TFM_UNCHECKED, TFM_FOUND, TFM_NOTFOUND };
+typedef struct mitem {
+    int mode;                   /* |FM_DUPIGNORE| or |FM_REPLACE| or |FM_DELETE| */
+    int type;                   /* map file or map line */
+    char *map_line;              /* pointer to map file name or map line */
+    int lineno;                 /* line number in map file */
+} mapitem;
+
+@ @<Glob...@>=
+mapitem *mitem;
+fm_entry *fm_cur;
+fm_entry *loaded_tfm_found;
+fm_entry *avail_tfm_found;
+fm_entry *non_tfm_found;
+fm_entry *not_avail_tfm_found;
+
+@ @<Set initial...@>=
+mp->ps->mitem = NULL;
+
+@ @<Declarations@>=
+static const char nontfm[] = "<nontfm>";
+
+@
+@d read_field(r, q, buf) do {
+    q = buf;
+    while (*r != ' ' && *r != '\0')
+        *q++ = *r++;
+    *q = '\0';
+    skip (r, ' ');
+} while (0)
+
+@d set_field(F) do {
+    if (q > buf)
+        fm->F = mp_xstrdup(mp,buf);
+    if (*r == '\0')
+        goto DONE;
+} while (0)
+
+@d cmp_return(a, b)
+    if (a > b)
+        return 1;
+    if (a < b)
+        return -1
+
+@c
+static fm_entry *new_fm_entry (MP mp) {
+    fm_entry *fm;
+    fm = mp_xmalloc (mp,1,sizeof(fm_entry));
+    fm->tfm_name = NULL;
+    fm->ps_name = NULL;
+    fm->flags = 4;
+    fm->ff_name = NULL;
+    fm->subset_tag = NULL;
+    fm->encoding = NULL;
+    fm->tfm_num = null_font;
+    fm->tfm_avail = TFM_UNCHECKED;
+    fm->type = 0;
+    fm->slant = 0;
+    fm->extend = 0;
+    fm->ff_objnum = 0;
+    fm->fn_objnum = 0;
+    fm->fd_objnum = 0;
+    fm->charset = NULL;
+    fm->all_glyphs = false;
+    fm->links = 0;
+    fm->pid = -1;
+    fm->eid = -1;
+    return fm;
+}
+
+static void delete_fm_entry (fm_entry * fm) {
+    mp_xfree (fm->tfm_name);
+    mp_xfree (fm->ps_name);
+    mp_xfree (fm->ff_name);
+    mp_xfree (fm->subset_tag);
+    mp_xfree (fm->charset);
+    mp_xfree (fm);
+}
+
+static ff_entry *new_ff_entry (MP mp) {
+    ff_entry *ff;
+    ff = mp_xmalloc (mp,1,sizeof(ff_entry));
+    ff->ff_name = NULL;
+    ff->ff_path = NULL;
+    return ff;
+}
+
+static void delete_ff_entry (ff_entry * ff) {
+    mp_xfree (ff->ff_name);
+    mp_xfree (ff->ff_path);
+    mp_xfree (ff);
+}
+
+static char *mk_base_tfm (MP mp, char *tfmname, int *i) {
+    static char buf[SMALL_BUF_SIZE];
+    char *p = tfmname, *r = strend (p) - 1, *q = r;
+    while (q > p && isdigit (*q))
+        --q;
+    if (!(q > p) || q == r || (*q != '+' && *q != '-'))
+        return NULL;
+    check_buf (q - p + 1, SMALL_BUF_SIZE);
+    strncpy (buf, p, (size_t) (q - p));
+    buf[q - p] = '\0';
+    *i = atoi (q);
+    return buf;
+}
+
+@ @<Exported function headers@>=
+boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm);
+
+@ @c
+boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm) {
+    fm_entry *res = NULL;
+    res = mp_fm_lookup (mp, f);
+    if (fm != NULL) {
+       *fm =res;
+    }
+    return (res != NULL);
+}
+
+@ @<Glob...@>=
+struct avl_table *tfm_tree;
+struct avl_table *ps_tree;
+struct avl_table *ff_tree;
+
+@ @<Set initial...@>=
+mp->ps->tfm_tree = NULL;
+mp->ps->ps_tree = NULL;
+mp->ps->ff_tree = NULL;
+
+@ AVL sort |fm_entry| into |tfm_tree| by |tfm_name |
+
+@c
+static int comp_fm_entry_tfm (const void *pa, const void *pb, void *p) {
+    (void)p;
+    return strcmp (((const fm_entry *) pa)->tfm_name,
+                   ((const fm_entry *) pb)->tfm_name);
+}
+
+@ AVL sort |fm_entry| into |ps_tree| by |ps_name|, |slant|, and |extend|
+
+@c static int comp_fm_entry_ps (const void *pa, const void *pb, void *p) {
+    int i;
+    const fm_entry *p1 = (const fm_entry *) pa;
+    const fm_entry *p2 = (const fm_entry *) pb;
+    (void)p;
+    assert (p1->ps_name != NULL && p2->ps_name != NULL);
+    if ((i = strcmp (p1->ps_name, p2->ps_name)))
+        return i;
+    cmp_return (p1->slant, p2->slant);
+    cmp_return (p1->extend, p2->extend);
+    if (p1->tfm_name != NULL && p2->tfm_name != NULL &&
+        (i = strcmp (p1->tfm_name, p2->tfm_name)))
+        return i;
+    return 0;
+}
+
+@ AVL sort |ff_entry| into |ff_tree| by |ff_name|
+
+@c static int comp_ff_entry (const void *pa, const void *pb, void *p) {
+    (void)p;
+    return strcmp (((const ff_entry *) pa)->ff_name,
+                   ((const ff_entry *) pb)->ff_name);
+}
+
+@ @c static void create_avl_trees (MP mp) {
+    if (mp->ps->tfm_tree == NULL) {
+        mp->ps->tfm_tree = avl_create (comp_fm_entry_tfm, NULL, &mp->ps->avl_xallocator);
+        assert (mp->ps->tfm_tree != NULL);
+    }
+    if (mp->ps->ps_tree == NULL) {
+        mp->ps->ps_tree = avl_create (comp_fm_entry_ps, NULL, &mp->ps->avl_xallocator);
+        assert (mp->ps->ps_tree != NULL);
+    }
+    if (mp->ps->ff_tree == NULL) {
+        mp->ps->ff_tree = avl_create (comp_ff_entry, NULL, &mp->ps->avl_xallocator);
+        assert (mp->ps->ff_tree != NULL);
+    }
+}
+
+@ The function |avl_do_entry| is not completely symmetrical with regards
+to |tfm_name| and |ps_name handling|, e. g. a duplicate |tfm_name| gives a
+|goto exit|, and no |ps_name| link is tried. This is to keep it compatible
+with the original version.
+
+@d LINK_TFM            0x01
+@d LINK_PS             0x02
+@d set_tfmlink(fm)     ((fm)->links |= LINK_TFM)
+@d set_pslink(fm)      ((fm)->links |= LINK_PS)
+@d unset_tfmlink(fm)   ((fm)->links &= ~LINK_TFM)
+@d unset_pslink(fm)    ((fm)->links &= ~LINK_PS)
+@d has_tfmlink(fm)     ((fm)->links & LINK_TFM)
+@d has_pslink(fm)      ((fm)->links & LINK_PS)
+
+@c
+static int avl_do_entry (MP mp, fm_entry * fp, int mode) {
+    fm_entry *p;
+    void *a;
+    void **aa;
+    char s[128];
+
+    /* handle |tfm_name| link */
+
+    if (strcmp (fp->tfm_name, nontfm)) {
+        p = (fm_entry *) avl_find (mp->ps->tfm_tree, fp);
+        if (p != NULL) {
+            if (mode == FM_DUPIGNORE) {
+               snprintf(s,128,"fontmap entry for `%s' already exists, duplicates ignored",
+                     fp->tfm_name);
+                mp_warn(mp,s);
+                goto exit;
+            } else {            /* mode == |FM_REPLACE| / |FM_DELETE| */
+                if (mp_has_font_size(mp,p->tfm_num)) {
+                    snprintf(s,128,
+                        "fontmap entry for `%s' has been used, replace/delete not allowed",
+                         fp->tfm_name);
+                    mp_warn(mp,s);
+                    goto exit;
+                }
+                a = avl_delete (mp->ps->tfm_tree, p);
+                assert (a != NULL);
+                unset_tfmlink (p);
+                if (!has_pslink (p))
+                    delete_fm_entry (p);
+            }
+        }
+        if (mode != FM_DELETE) {
+            aa = avl_probe (mp->ps->tfm_tree, fp);
+            assert (aa != NULL);
+            set_tfmlink (fp);
+        }
+    }
+
+    /* handle |ps_name| link */
+
+    if (fp->ps_name != NULL) {
+        assert (fp->tfm_name != NULL);
+        p = (fm_entry *) avl_find (mp->ps->ps_tree, fp);
+        if (p != NULL) {
+            if (mode == FM_DUPIGNORE) {
+                snprintf(s,128,
+                    "ps_name entry for `%s' already exists, duplicates ignored",
+                     fp->ps_name);
+                mp_warn(mp,s);
+                goto exit;
+            } else {            /* mode == |FM_REPLACE| / |FM_DELETE| */
+                if (mp_has_font_size(mp,p->tfm_num)) {
+                    /* REPLACE/DELETE not allowed */
+                    snprintf(s,128,
+                        "fontmap entry for `%s' has been used, replace/delete not allowed",
+                         p->tfm_name);
+                    mp_warn(mp,s);
+                    goto exit;
+                }
+                a = avl_delete (mp->ps->ps_tree, p);
+                assert (a != NULL);
+                unset_pslink (p);
+                if (!has_tfmlink (p))
+                    delete_fm_entry (p);
+            }
+        }
+        if (mode != FM_DELETE) {
+            aa = avl_probe (mp->ps->ps_tree, fp);
+            assert (aa != NULL);
+            set_pslink (fp);
+        }
+    }
+  exit:
+    if (!has_tfmlink (fp) && !has_pslink (fp))  /* e. g. after |FM_DELETE| */
+        return 1;               /* deallocation of |fm_entry| structure required */
+    else
+        return 0;
+}
+
+@ consistency check for map entry, with warn flag 
+
+@c
+static int check_fm_entry (MP mp, fm_entry * fm, boolean warn) {
+    int a = 0;
+    char s[128];
+    assert (fm != NULL);
+    if (fm->ps_name != NULL) {
+        if (is_basefont (fm)) {
+            if (is_fontfile (fm) && !is_included (fm)) {
+                if (warn) {
+                    snprintf(s,128, "invalid entry for `%s': "
+                         "font file must be included or omitted for base fonts",
+                         fm->tfm_name);
+                    mp_warn(mp,s);
+                }
+                a += 1;
+            }
+        } else {                /* not a base font */
+            /* if no font file given, drop this entry */
+            /* |if (!is_fontfile (fm)) {
+	         if (warn) {
+                   snprintf(s,128, 
+                        "invalid entry for `%s': font file missing",
+						fm->tfm_name);
+                    mp_warn(mp,s);
+                 }
+                a += 2;
+            }|
+	    */
+        }
+    }
+    if (is_truetype (fm) && is_reencoded (fm) && !is_subsetted (fm)) {
+        if (warn) {
+            snprintf(s,128, 
+                "invalid entry for `%s': only subsetted TrueType font can be reencoded",
+                 fm->tfm_name);
+                    mp_warn(mp,s);
+        }
+        a += 4;
+    }
+    if ((fm->slant != 0 || fm->extend != 0) &&
+        (is_truetype (fm))) {
+        if (warn) { 
+           snprintf(s,128, 
+                 "invalid entry for `%s': " 
+                 "SlantFont/ExtendFont can be used only with embedded T1 fonts",
+                 fm->tfm_name);
+                    mp_warn(mp,s);
+        }
+        a += 8;
+    }
+    if (abs (fm->slant) > 1000) {
+        if (warn) {
+            snprintf(s,128, 
+                "invalid entry for `%s': too big value of SlantFont (%g)",
+                 fm->tfm_name, fm->slant / 1000.0);
+                    mp_warn(mp,s);
+        }
+        a += 16;
+    }
+    if (abs (fm->extend) > 2000) {
+        if (warn) {
+            snprintf(s,128, 
+                "invalid entry for `%s': too big value of ExtendFont (%g)",
+                 fm->tfm_name, fm->extend / 1000.0);
+                    mp_warn(mp,s);
+        }
+        a += 32;
+    }
+    if (fm->pid != -1 &&
+        !(is_truetype (fm) && is_included (fm) &&
+          is_subsetted (fm) && !is_reencoded (fm))) {
+        if (warn) {
+            snprintf(s,128, 
+                "invalid entry for `%s': "
+                 "PidEid can be used only with subsetted non-reencoded TrueType fonts",
+                 fm->tfm_name);
+                    mp_warn(mp,s);
+        }
+        a += 64;
+    }
+    return a;
+}
+
+@ returns true if s is one of the 14 std. font names; speed-trimmed. 
+
+@c static boolean check_basefont (char *s) {
+    static const char *basefont_names[] = {
+        "Courier",              /* 0:7 */
+        "Courier-Bold",         /* 1:12 */
+        "Courier-Oblique",      /* 2:15 */
+        "Courier-BoldOblique",  /* 3:19 */
+        "Helvetica",            /* 4:9 */
+        "Helvetica-Bold",       /* 5:14 */
+        "Helvetica-Oblique",    /* 6:17 */
+        "Helvetica-BoldOblique",        /* 7:21 */
+        "Symbol",               /* 8:6 */
+        "Times-Roman",          /* 9:11 */
+        "Times-Bold",           /* 10:10 */
+        "Times-Italic",         /* 11:12 */
+        "Times-BoldItalic",     /* 12:16 */
+        "ZapfDingbats"          /* 13:12 */
+    };
+    static const int Index[] =
+        { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6,
+        -1, 3, -1, 7
+    };
+    const size_t n = strlen (s);
+    int k = -1;
+    if (n > 21)
+        return false;
+    if (n == 12) {              /* three names have length 12 */
+        switch (*s) {
+        case 'C':
+            k = 1;              /* Courier-Bold */
+            break;
+        case 'T':
+            k = 11;             /* Times-Italic */
+            break;
+        case 'Z':
+            k = 13;             /* ZapfDingbats */
+            break;
+        default:
+            return false;
+        }
+    } else
+        k = Index[n];
+    if (k > -1 && !strcmp (basefont_names[k], s))
+        return true;
+    return false;
+}
+
+@ 
+@d is_cfg_comment(c) (c == 10 || c == '*' || c == '#' || c == ';' || c == '%')
+
+@c static void fm_scan_line (MP mp) {
+    int a, b, c, j, u = 0, v = 0;
+    float d;
+    fm_entry *fm;
+    char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE];
+    char *p, *q, *r, *s;
+    char warn_s[128];
+    switch (mp->ps->mitem->type) {
+    case MAPFILE:
+        p = fm_line;
+        do {
+            c = fm_getchar (mp);
+            append_char_to_buf (c, p, fm_line, FM_BUF_SIZE);
+        } while (c != 10);
+        *(--p) = '\0';
+        r = fm_line;
+        break;
+    case MAPLINE:
+        r = mp->ps->mitem->map_line;
+        break;
+    default:
+        assert (0);
+    }
+    if (*r == '\0' || is_cfg_comment (*r))
+        return;
+    fm = new_fm_entry (mp);
+    read_field (r, q, buf);
+    set_field (tfm_name);
+    p = r;
+    read_field (r, q, buf);
+    if (*buf != '<' && *buf != '"')
+        set_field (ps_name);
+    else
+        r = p;                  /* unget the field */
+    if (isdigit (*r)) {         /* font flags given */
+        fm->flags = atoi (r);
+        while (isdigit (*r))
+            r++;
+    }
+    while (1) {                 /* loop through "specials", encoding, font file */
+        skip (r, ' ');
+        switch (*r) {
+        case '\0':
+            goto DONE;
+        case '"':              /* opening quote */
+            r++;
+            u = v = 0;
+            do {
+                skip (r, ' ');
+                if (sscanf (r, "%f %n", &d, &j) > 0) {
+                    s = r + j;  /* jump behind number, eat also blanks, if any */
+                    if (*(s - 1) == 'E' || *(s - 1) == 'e')
+                        s--;    /* e. g. 0.5ExtendFont: \%f = 0.5E */
+                    if (str_prefix (s, "SlantFont")) {
+                        d *= 1000.0;    /* correct rounding also for neg. numbers */
+                        fm->slant = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+                        r = s + strlen ("SlantFont");
+                    } else if (str_prefix (s, "ExtendFont")) {
+                        d *= 1000.0;
+                        fm->extend = (integer) (d > 0 ? d + 0.5 : d - 0.5);
+                        if (fm->extend == 1000)
+                            fm->extend = 0;
+                        r = s + strlen ("ExtendFont");
+                    } else {    /* unknown name */
+                        for (r = s; 
+                             *r != ' ' && *r != '"' && *r != '\0'; 
+                             r++); /* jump over name */
+                        c = *r; /* remember char for temporary end of string */
+                        *r = '\0';
+                        snprintf(warn_s,128,
+                            "invalid entry for `%s': unknown name `%s' ignored",
+                             fm->tfm_name, s);
+                        mp_warn(mp,warn_s);
+                        *r = c;
+                    }
+                } else
+                    for (; *r != ' ' && *r != '"' && *r != '\0'; r++);
+            }
+            while (*r == ' ');
+            if (*r == '"')      /* closing quote */
+                r++;
+            else {
+                snprintf(warn_s,128,
+                    "invalid entry for `%s': closing quote missing",
+                     fm->tfm_name);
+                mp_warn(mp,warn_s);
+                goto bad_line;
+            }
+            break;
+        case 'P':              /* handle cases for subfonts like 'PidEid=3,1' */
+            if (sscanf (r, "PidEid=%i, %i %n", &a, &b, &c) >= 2) {
+                fm->pid = a;
+                fm->eid = b;
+                r += c;
+                break;
+            }
+        default:               /* encoding or font file specification */
+            a = b = 0;
+            if (*r == '<') {
+                a = *r++;
+                if (*r == '<' || *r == '[')
+                    b = *r++;
+            }
+            read_field (r, q, buf);
+            /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */
+            if (strlen (buf) > 4 && strcasecmp (strend (buf) - 4, ".enc") == 0) {
+                fm->encoding = mp_add_enc (mp, buf);
+                u = v = 0;      /* u, v used if intervening blank: "<< foo" */
+            } else if (strlen (buf) > 0) {      /* file name given */
+                /* font file, formats:
+                 * subsetting:    '<cmr10.pfa'
+                 * no subsetting: '<<cmr10.pfa'
+                 * no embedding:  'cmr10.pfa'
+                 */
+                if (a == '<' || u == '<') {
+		  set_included (fm);
+		  if ((a == '<' && b == 0) || (a == 0 && v == 0))
+		    set_subsetted (fm);
+		  /* otherwise b == '<' (or '[') => no subsetting */
+                }
+                set_field (ff_name);
+                u = v = 0;
+            } else {
+                u = a;
+                v = b;
+            }
+        }
+    }
+  DONE:
+    if (fm->ps_name != NULL && check_basefont (fm->ps_name))
+        set_basefont (fm);
+    if (is_fontfile (fm)
+        && strcasecmp (strend (fm_fontfile (fm)) - 4, ".ttf") == 0)
+        set_truetype (fm);
+    if (check_fm_entry (mp,fm, true) != 0)
+        goto bad_line;
+    /*
+       Until here the map line has been completely scanned without errors;
+       fm points to a valid, freshly filled-out |fm_entry| structure.
+       Now follows the actual work of registering/deleting.
+     */
+    if (avl_do_entry (mp, fm, mp->ps->mitem->mode) == 0)    /* if success */
+        return;
+  bad_line:
+    delete_fm_entry (fm);
+}
+
+@ 
+@c static void fm_read_info (MP mp) {
+    char *n;
+    char s[256];
+    if (mp->ps->tfm_tree == NULL)
+        create_avl_trees (mp);
+    if (mp->ps->mitem->map_line == NULL)    /* nothing to do */
+        return;
+    mp->ps->mitem->lineno = 1;
+    switch (mp->ps->mitem->type) {
+    case MAPFILE:
+        n = mp->ps->mitem->map_line;
+        mp->ps->fm_file = (mp->open_file)(mp, n, "r", mp_filetype_fontmap);
+        if (!mp->ps->fm_file) {
+            snprintf(s,256,"cannot open font map file %s",n);
+            mp_warn(mp,s);
+        } else {
+            int save_selector = mp->selector;
+            mp_normalize_selector(mp);
+            mp_print (mp, "{");
+            mp_print (mp, n);
+            while (!fm_eof ()) {
+                fm_scan_line (mp);
+                mp->ps->mitem->lineno++;
+            }
+            fm_close ();
+            mp_print (mp,"}");
+            mp->selector = save_selector;
+            mp->ps->fm_file = NULL;
+        }
+        mp_xfree(n);
+        break;
+    case MAPLINE:
+        fm_scan_line (mp);
+        break;
+    default:
+        assert (0);
+    }
+    mp->ps->mitem->map_line = NULL;         /* done with this line */
+    return;
+}
+
+@ @c static void init_fm (fm_entry * fm, font_number f) {
+    if (fm->tfm_num == null_font ) {
+        fm->tfm_num = f;
+        fm->tfm_avail = TFM_FOUND;
+    }
+}
+
+@ @<Declarations@>=
+static fm_entry * mp_fm_lookup (MP mp, font_number f);
+
+@ @c 
+static fm_entry * mp_fm_lookup (MP mp, font_number f) {
+    char *tfm;
+    fm_entry *fm;
+    fm_entry tmp;
+    int e;
+    if (mp->ps->tfm_tree == NULL)
+        fm_read_info (mp);        /* only to read default map file */
+    tfm = mp->font_name[f];
+    assert (strcmp (tfm, nontfm));
+    /* Look up for full <tfmname>[+-]<expand> */
+    tmp.tfm_name = tfm;
+    fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp);
+    if (fm != NULL) {
+        init_fm (fm, f);
+        return (fm_entry *) fm;
+    }
+    tfm = mk_base_tfm (mp, mp->font_name[f], &e);
+    if (tfm == NULL)            /* not an expanded font, nothing to do */
+        return NULL;
+
+    tmp.tfm_name = tfm;
+    fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp);
+    if (fm != NULL) {           /* found an entry with the base tfm name, e.g. cmr10 */
+      return (fm_entry *) fm; /* font expansion uses the base font */
+    }
+    return NULL;
+}
+
+@  Early check whether a font file exists. Used e. g. for replacing fonts
+   of embedded PDF files: Without font file, the font within the embedded
+   PDF-file is used. Search tree |ff_tree| is used in 1st instance, as it
+   may be faster than the |kpse_find_file()|, and |kpse_find_file()| is called
+   only once per font file name + expansion parameter. This might help
+   keeping speed, if many PDF pages with same fonts are to be embedded.
+
+   The |ff_tree| contains only font files, which are actually needed,
+   so this tree typically is much smaller than the |tfm_tree| or |ps_tree|.
+
+@c 
+static ff_entry *check_ff_exist (MP mp, fm_entry * fm) {
+    ff_entry *ff;
+    ff_entry tmp;
+    void **aa;
+
+    assert (fm->ff_name != NULL);
+    tmp.ff_name = fm->ff_name;
+    ff = (ff_entry *) avl_find (mp->ps->ff_tree, &tmp);
+    if (ff == NULL) {           /* not yet in database */
+        ff = new_ff_entry (mp);
+        ff->ff_name = mp_xstrdup (mp,fm->ff_name);
+        ff->ff_path = mp_xstrdup (mp,fm->ff_name);
+        aa = avl_probe (mp->ps->ff_tree, ff);
+        assert (aa != NULL);
+    }
+    return ff;
+}
+
+@ Process map file given by its name or map line contents. Items not
+beginning with [+-=] flush default map file, if it has not yet been
+read. Leading blanks and blanks immediately following [+-=] are ignored.
+
+
+@c static void mp_process_map_item (MP mp, char *s, int type) {
+    char *p;
+    int mode;
+    if (*s == ' ')
+        s++;                    /* ignore leading blank */
+    switch (*s) {
+    case '+':                  /* +mapfile.map, +mapline */
+        mode = FM_DUPIGNORE;    /* insert entry, if it is not duplicate */
+        s++;
+        break;
+    case '=':                  /* =mapfile.map, =mapline */
+        mode = FM_REPLACE;      /* try to replace earlier entry */
+        s++;
+        break;
+    case '-':                  /* -mapfile.map, -mapline */
+        mode = FM_DELETE;       /* try to delete entry */
+        s++;
+        break;
+    default:
+        mode = FM_DUPIGNORE;    /* like +, but also: */
+        mp_xfree(mp->ps->mitem->map_line);
+        mp->ps->mitem->map_line = NULL;     /* flush default map file name */
+    }
+    if (*s == ' ')
+        s++;                    /* ignore blank after [+-=] */
+    p = s;                      /* map item starts here */
+    switch (type) {
+    case MAPFILE:              /* remove blank at end */
+        while (*p != '\0' && *p != ' ')
+            p++;
+        *p = '\0';
+        break;
+    case MAPLINE:              /* blank at end allowed */
+        break;
+    default:
+        assert (0);
+    }
+    if (mp->ps->mitem->map_line != NULL)    /* read default map file first */
+        fm_read_info (mp);
+    if (*s != '\0') {           /* only if real item to process */
+        mp->ps->mitem->mode = mode;
+        mp->ps->mitem->type = type;
+        mp->ps->mitem->map_line = s;
+        fm_read_info (mp);
+    }
+}
+
+@ @<Exported function headers@>=
+void mp_map_file (MP mp, str_number t);
+void mp_map_line (MP mp, str_number t);
+void mp_init_map_file (MP mp, int is_troff);
+
+@ @c 
+void mp_map_file (MP mp, str_number t) {
+  char *s = mp_xstrdup(mp,mp_str (mp,t));
+  mp_process_map_item (mp, s, MAPFILE);
+  mp_xfree (s);
+}
+void mp_map_line (MP mp, str_number t) {
+  char *s = mp_xstrdup(mp,mp_str (mp,t));
+  mp_process_map_item (mp, s, MAPLINE);
+  mp_xfree (s);
+}
+
+@ 
+@c void mp_init_map_file (MP mp, int is_troff) {
+    char *r;
+    mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem));
+    mp->ps->mitem->mode = FM_DUPIGNORE;
+    mp->ps->mitem->type = MAPFILE;
+    mp->ps->mitem->map_line = NULL;
+    r = (mp->find_file)(mp,"mpost.map", "r", mp_filetype_fontmap);
+    if (r != NULL) {
+      mp_xfree(r);
+      mp->ps->mitem->map_line = mp_xstrdup (mp,"mpost.map");
+    } else {
+      if (is_troff) {
+	     mp->ps->mitem->map_line = mp_xstrdup (mp,"troff.map");
+      } else {
+	     mp->ps->mitem->map_line = mp_xstrdup (mp,"pdftex.map");
+      }
+    }
+}
+
+@ @<Dealloc variables@>=
+if (mp->ps->mitem!=NULL) {
+  mp_xfree(mp->ps->mitem->map_line);
+  mp_xfree(mp->ps->mitem);
+}
+
+@ cleaning up... 
+
+@c
+static void destroy_fm_entry_tfm (void *pa, void *pb) {
+    fm_entry *fm;
+    (void)pb;
+    fm = (fm_entry *) pa;
+    if (!has_pslink (fm))
+        delete_fm_entry (fm);
+    else
+        unset_tfmlink (fm);
+}
+static void destroy_fm_entry_ps (void *pa, void *pb) {
+    fm_entry *fm;
+    (void)pb;
+    fm = (fm_entry *) pa;
+    if (!has_tfmlink (fm))
+        delete_fm_entry (fm);
+    else
+        unset_pslink (fm);
+}
+static void destroy_ff_entry (void *pa, void *pb) {
+    ff_entry *ff;
+    (void)pb;
+    ff = (ff_entry *) pa;
+    delete_ff_entry (ff);
+} 
+
+@ @<Declarations@>=
+static void fm_free (MP mp);
+
+@ @c
+static void fm_free (MP mp) {
+    if (mp->ps->tfm_tree != NULL)
+        avl_destroy (mp->ps->tfm_tree, destroy_fm_entry_tfm);
+    if (mp->ps->ps_tree != NULL)
+        avl_destroy (mp->ps->ps_tree, destroy_fm_entry_ps);
+    if (mp->ps->ff_tree != NULL)
+        avl_destroy (mp->ps->ff_tree, destroy_ff_entry);
+}
+
+@ The file |ps_tab_file| gives a table of \TeX\ font names and corresponding
+PostScript names for fonts that do not have to be downloaded, i.e., fonts that
+can be used when |internal[prologues]>0|.  Each line consists of a \TeX\ name,
+one or more spaces, a PostScript name, and possibly a space and some other junk.
+This routine reads the table, updates |font_ps_name| entries starting after
+|last_ps_fnum|, and sets |last_ps_fnum:=last_fnum|.  
+
+@d ps_tab_name "psfonts.map"  /* locates font name translation table */
+
+@<Declarations@>=
+static void mp_read_psname_table (MP mp) ;
+
+@ @c 
+static void mp_read_psname_table (MP mp) {
+  font_number k;
+  if (mp->ps->mitem == NULL) {
+    mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem));
+    mp->ps->mitem->mode = FM_DUPIGNORE;
+    mp->ps->mitem->type = MAPFILE;
+    mp->ps->mitem->map_line = NULL;
+  }
+  mp->ps->mitem->map_line = mp_xstrdup (mp,ps_tab_name); 
+  fm_read_info (mp);
+  for (k=mp->last_ps_fnum+1;k<=mp->last_fnum;k++) {
+    if (mp_has_fm_entry(mp, k, NULL)) {
+      mp->font_ps_name[k] = mp_fm_font_name(mp,k);
+    }
+  }
+  mp->last_ps_fnum=mp->last_fnum;
+}
+
+
+@ The traditional function is a lot shorter now.
+
+
+
+@* \[44c] Helper functions for Type1 fonts.
+
+@<Types...@>=
+typedef char char_entry;
+typedef unsigned char  Byte;
+typedef Byte  Bytef;
+
+@ @<Glob...@>=
+char_entry *char_ptr, *char_array;
+size_t char_limit;
+char *job_id_string;
+
+@ @<Set initial...@>=
+mp->ps->char_array = NULL;
+mp->ps->job_id_string = NULL;
+
+@ 
+@d SMALL_ARRAY_SIZE    256
+@d Z_NULL  0  
+
+@c 
+void mp_set_job_id (MP mp) {
+    char *name_string, *format_string, *s;
+    size_t slen;
+    int i;
+    if (mp->ps->job_id_string != NULL)
+       return;
+    if ( mp->job_name==NULL )
+       mp->job_name = mp_xstrdup(mp,"mpout");
+    name_string = mp_xstrdup (mp,mp->job_name);
+    format_string = mp_xstrdup (mp,mp->mem_ident);
+    slen = SMALL_BUF_SIZE +
+        strlen (name_string) +
+        strlen (format_string);
+    s = mp_xmalloc (mp,slen, sizeof (char));
+    i = snprintf (s, slen,
+                  "%.4d/%.2d/%.2d %.2d:%.2d %s %s",
+                  (mp->internal[mp_year]>>16),
+                  (mp->internal[mp_month]>>16), 
+                  (mp->internal[mp_day]>>16), 
+                  (mp->internal[mp_time]>>16) / 60, 
+                  (mp->internal[mp_time]>>16) % 60,
+                  name_string, format_string);
+    mp->ps->job_id_string = mp_xstrdup (mp,s);
+    mp_xfree (s);
+    mp_xfree (name_string);
+    mp_xfree (format_string);
+}
+static void fnstr_append (MP mp, const char *s) {
+    size_t l = strlen (s) + 1;
+    alloc_array (char, l, SMALL_ARRAY_SIZE);
+    strcat (mp->ps->char_ptr, s);
+    mp->ps->char_ptr = strend (mp->ps->char_ptr);
+}
+
+@ @<Exported function headers@>=
+void mp_set_job_id (MP mp) ;
+
+@ @<Dealloc variables@>=
+mp_xfree(mp->ps->job_id_string);
+
+@ this is not really a true crc32, but it should be just enough to keep
+  subsets prefixes somewhat disjunct
+
+@c
+static unsigned long crc32 (int oldcrc, const Byte *buf, int len) {
+  unsigned long ret = 0;
+  int i;
+  if (oldcrc==0)
+	ret = (23<<24)+(45<<16)+(67<<8)+89;
+  else 
+      for (i=0;i<len;i++)
+	  ret = (ret<<2)+buf[i];
+  return ret;
+}
+static boolean mp_char_marked (MP mp,font_number f, eight_bits c) {
+  integer b; /* |char_base[f]| */
+  b=mp->char_base[f];
+  if ( (c>=mp->font_bc[f])&&(c<=mp->font_ec[f])&&(mp->font_info[b+c].qqqq.b3!=0) )
+    return true;
+  else
+    return false;
+}
+
+static void make_subset_tag (MP mp, fm_entry * fm_cur, char **glyph_names, int tex_font)
+{
+    char tag[7];
+    unsigned long crc;
+    int i;
+    size_t l ;
+    if (mp->ps->job_id_string ==NULL)
+      mp_fatal_error(mp, "no job id!");
+    l = strlen (mp->ps->job_id_string) + 1;
+    
+    alloc_array (char, l, SMALL_ARRAY_SIZE);
+    strcpy (mp->ps->char_array, mp->ps->job_id_string);
+    mp->ps->char_ptr = strend (mp->ps->char_array);
+    if (fm_cur->tfm_name != NULL) {
+        fnstr_append (mp," TFM name: ");
+        fnstr_append (mp,fm_cur->tfm_name);
+    }
+    fnstr_append (mp," PS name: ");
+    if (fm_cur->ps_name != NULL)
+        fnstr_append (mp,fm_cur->ps_name);
+    fnstr_append (mp," Encoding: ");
+    if (fm_cur->encoding != NULL && (fm_cur->encoding)->file_name != NULL)
+        fnstr_append (mp,(fm_cur->encoding)->file_name);
+    else
+        fnstr_append (mp,"built-in");
+    fnstr_append (mp," CharSet: ");
+    for (i = 0; i < 256; i++)
+        if (mp_char_marked (mp,tex_font, i) && glyph_names[i] != notdef) {
+			if (glyph_names[i]!=NULL) {
+			  fnstr_append (mp,"/");
+			  fnstr_append (mp,glyph_names[i]);
+			}
+        }
+    if (fm_cur->charset != NULL) {
+        fnstr_append (mp," Extra CharSet: ");
+        fnstr_append (mp, fm_cur->charset);
+    }
+    crc = crc32 (0L, Z_NULL, 0);
+    crc = crc32 (crc, (Bytef *) mp->ps->char_array, strlen (mp->ps->char_array));
+    /* we need to fit a 32-bit number into a string of 6 uppercase chars long;
+     * there are 26 uppercase chars ==> each char represents a number in range
+     * |0..25|. The maximal number that can be represented by the tag is
+     * $26^6 - 1$, which is a number between $2^28$ and $2^29$. Thus the bits |29..31|
+     * of the CRC must be dropped out.
+     */
+    for (i = 0; i < 6; i++) {
+        tag[i] = 'A' + crc % 26;
+        crc /= 26;
+    }
+    tag[6] = 0;
+    fm_cur->subset_tag = mp_xstrdup (mp,tag);
+}
+
+
+
+@ 
+@d external_enc()      (fm_cur->encoding)->glyph_names
+@d is_used_char(c)     mp_char_marked (mp, tex_font, c)
+@d end_last_eexec_line() 
+    mp->ps->hexline_length = HEXLINE_WIDTH;
+    end_hexline(mp); 
+    mp->ps->t1_eexec_encrypt = false
+@d t1_log(s)           mp_print(mp,(char *)s)
+@d t1_putchar(c)       wps_chr(c)
+@d embed_all_glyphs(tex_font)  false
+@d t1_char(c)          c
+@d extra_charset()     mp->ps->dvips_extra_charset
+@d update_subset_tag()
+@d fixedcontent        true
+
+@<Glob...@>=
+#define PRINTF_BUF_SIZE     1024
+char *dvips_extra_charset;
+char *cur_enc_name;
+unsigned char *grid;
+char *ext_glyph_names[256];
+char print_buf[PRINTF_BUF_SIZE];
+int t1_byte_waiting;
+
+@ @<Set initial ...@>=
+mp->ps->dvips_extra_charset=NULL;
+mp->ps->t1_byte_waiting=0;
+
+@
+@d t1_ungetchar(A) mp->ps->t1_byte_waiting=A
+@d t1_eof()        (mp->eof_file)(mp,mp->ps->t1_file)
+@d t1_close()      (mp->close_file)(mp,mp->ps->t1_file)
+@d valid_code(c)   (c >= 0 && c < 256)
+
+@c
+int t1_getchar (MP mp) {
+  size_t len = 1;
+  unsigned char abyte=0;
+  void *byte_ptr = &abyte;  
+  if (mp->ps->t1_byte_waiting) {
+    abyte = mp->ps->t1_byte_waiting;
+    mp->ps->t1_byte_waiting = 0;
+  } else {
+    (mp->read_binary_file)(mp,mp->ps->t1_file,&byte_ptr,&len);
+  }
+  return abyte;
+}
+
+@ @<Static variables in the outer block@>=
+static const char *standard_glyph_names[256] =
+    { notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    "space", "exclam", "quotedbl", "numbersign",
+    "dollar", "percent", "ampersand", "quoteright", "parenleft",
+    "parenright", "asterisk", "plus", "comma", "hyphen", "period",
+    "slash", "zero", "one", "two", "three", "four", "five", "six", "seven",
+    "eight", "nine", "colon", "semicolon", "less",
+    "equal", "greater", "question", "at", "A", "B", "C", "D", "E", "F",
+    "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q",
+    "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft",
+    "backslash", "bracketright", "asciicircum", "underscore",
+    "quoteleft", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k",
+    "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v",
+    "w", "x", "y", "z", "braceleft", "bar", "braceright", "asciitilde",
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, "exclamdown", "cent",
+    "sterling", "fraction", "yen", "florin", "section", "currency",
+    "quotesingle", "quotedblleft", "guillemotleft",
+    "guilsinglleft", "guilsinglright", "fi", "fl", notdef, "endash",
+    "dagger", "daggerdbl", "periodcentered", notdef,
+    "paragraph", "bullet", "quotesinglbase", "quotedblbase",
+    "quotedblright", "guillemotright", "ellipsis", "perthousand",
+    notdef, "questiondown", notdef, "grave", "acute", "circumflex",
+    "tilde", "macron", "breve", "dotaccent", "dieresis", notdef,
+    "ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron", "emdash",
+    notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
+    notdef, "AE", notdef, "ordfeminine", notdef, notdef,
+    notdef, notdef, "Lslash", "Oslash", "OE", "ordmasculine", notdef,
+    notdef, notdef, notdef, notdef, "ae", notdef, notdef,
+    notdef, "dotlessi", notdef, notdef, "lslash", "oslash", "oe",
+    "germandbls", notdef, notdef, notdef, notdef };
+static const char charstringname[] = "/CharStrings";
+
+@ @<Glob...@>=
+char **t1_glyph_names;
+char *t1_builtin_glyph_names[256];
+char charsetstr[0x4000];
+boolean read_encoding_only;
+int t1_encoding;
+
+@ @c
+#define T1_BUF_SIZE   0x10
+
+#define CS_HSTEM            1
+#define CS_VSTEM            3
+#define CS_VMOVETO          4
+#define CS_RLINETO          5
+#define CS_HLINETO          6
+#define CS_VLINETO          7
+#define CS_RRCURVETO        8
+#define CS_CLOSEPATH        9
+#define CS_CALLSUBR         10
+#define CS_RETURN           11
+#define CS_ESCAPE           12
+#define CS_HSBW             13
+#define CS_ENDCHAR          14
+#define CS_RMOVETO          21
+#define CS_HMOVETO          22
+#define CS_VHCURVETO        30
+#define CS_HVCURVETO        31
+#define CS_1BYTE_MAX        (CS_HVCURVETO + 1)
+
+#define CS_DOTSECTION       CS_1BYTE_MAX + 0
+#define CS_VSTEM3           CS_1BYTE_MAX + 1
+#define CS_HSTEM3           CS_1BYTE_MAX + 2
+#define CS_SEAC             CS_1BYTE_MAX + 6
+#define CS_SBW              CS_1BYTE_MAX + 7
+#define CS_DIV              CS_1BYTE_MAX + 12
+#define CS_CALLOTHERSUBR    CS_1BYTE_MAX + 16
+#define CS_POP              CS_1BYTE_MAX + 17
+#define CS_SETCURRENTPOINT  CS_1BYTE_MAX + 33
+#define CS_2BYTE_MAX        (CS_SETCURRENTPOINT + 1)
+#define CS_MAX              CS_2BYTE_MAX
+
+@ @<Types...@>=
+typedef unsigned char byte;
+typedef struct {
+    byte nargs;                 /* number of arguments */
+    boolean bottom;             /* take arguments from bottom of stack? */
+    boolean clear;              /* clear stack? */
+    boolean valid;
+} cc_entry;                     /* CharString Command */
+typedef struct {
+    char *glyph_name;                 /* glyph name (or notdef for Subrs entry) */
+    byte *data;
+    unsigned short len;         /* length of the whole string */
+    unsigned short cslen;       /* length of the encoded part of the string */
+    boolean is_used;
+    boolean valid;
+} cs_entry;
+
+@ @<Glob...@>=
+unsigned short t1_dr, t1_er;
+unsigned short t1_c1, t1_c2;
+unsigned short t1_cslen;
+short t1_lenIV;
+
+@ @<Set initial...@>=
+mp->ps->t1_c1 = 52845; 
+mp->ps->t1_c2 = 22719;
+
+@ @<Types...@>=
+typedef char t1_line_entry;
+typedef char t1_buf_entry;
+
+@ @<Glob...@>=
+t1_line_entry *t1_line_ptr, *t1_line_array;
+size_t t1_line_limit;
+t1_buf_entry *t1_buf_ptr, *t1_buf_array;
+size_t t1_buf_limit;
+int cs_start;
+cs_entry *cs_tab, *cs_ptr, *cs_notdef;
+char *cs_dict_start, *cs_dict_end;
+int cs_count, cs_size, cs_size_pos;
+cs_entry *subr_tab;
+char *subr_array_start, *subr_array_end;
+int subr_max, subr_size, subr_size_pos;
+
+@ @<Set initial...@>=
+mp->ps->t1_line_array = NULL;
+mp->ps->t1_buf_array = NULL;
+
+@ 
+ This list contains the begin/end tokens commonly used in the 
+ /Subrs array of a Type 1 font.                                
+
+@<Static variables in the outer block@>=
+static const char *cs_token_pairs_list[][2] = {
+    {" RD", "NP"},
+    {" -|", "|"},
+    {" RD", "noaccess put"},
+    {" -|", "noaccess put"},
+    {NULL, NULL}
+};
+
+@ @<Glob...@>=
+const char **cs_token_pair;
+boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic;
+int t1_in_eexec;  /* 0 before eexec-encrypted, 1 during, 2 after */
+long t1_block_length;
+int last_hexbyte;
+void *t1_file;
+int hexline_length;
+
+@ 
+@d HEXLINE_WIDTH 64
+
+@<Set initial ...@>=
+mp->ps->hexline_length = 0;
+
+@ 
+@d t1_prefix(s)        str_prefix(mp->ps->t1_line_array, s)
+@d t1_buf_prefix(s)    str_prefix(mp->ps->t1_buf_array, s)
+@d t1_suffix(s)        str_suffix(mp->ps->t1_line_array, mp->ps->t1_line_ptr, s)
+@d t1_buf_suffix(s)    str_suffix(mp->ps->t1_buf_array, mp->ps->t1_buf_ptr, s)
+@d t1_charstrings()    strstr(mp->ps->t1_line_array, charstringname)
+@d t1_subrs()          t1_prefix("/Subrs")
+@d t1_end_eexec()      t1_suffix("mark currentfile closefile")
+@d t1_cleartomark()    t1_prefix("cleartomark")
+
+@d isdigit(A) ((A)>='0'&&(A)<='9')
+
+@c
+static void end_hexline (MP mp) {
+  if (mp->ps->hexline_length >= HEXLINE_WIDTH) {
+    wps_cr; 
+    mp->ps->hexline_length = 0;
+  }
+}
+static void t1_check_pfa (MP mp) {
+    const int c = t1_getchar (mp);
+    mp->ps->t1_pfa = (c != 128) ? true : false;
+    t1_ungetchar (c);
+}
+static int t1_getbyte (MP mp)
+{
+    int c = t1_getchar (mp);
+    if (mp->ps->t1_pfa)
+        return c;
+    if (mp->ps->t1_block_length == 0) {
+        if (c != 128)
+         mp_fatal_error (mp, "invalid marker");
+        c = t1_getchar (mp);
+        if (c == 3) {
+            while (!t1_eof ())
+                t1_getchar (mp);
+            return EOF;
+        }
+        mp->ps->t1_block_length = t1_getchar (mp) & 0xff;
+        mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 8;
+        mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 16;
+        mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 24;
+        c = t1_getchar (mp);
+    }
+    mp->ps->t1_block_length--;
+    return c;
+}
+static int hexval (int c) {
+    if (c >= 'A' && c <= 'F')
+        return c - 'A' + 10;
+    else if (c >= 'a' && c <= 'f')
+        return c - 'a' + 10;
+    else if (c >= '0' && c <= '9')
+        return c - '0';
+    else
+        return -1;
+}
+static byte edecrypt (MP mp, byte cipher) {
+    byte plain;
+    if (mp->ps->t1_pfa) {
+        while (cipher == 10 || cipher == 13)
+            cipher = t1_getbyte (mp);
+        mp->ps->last_hexbyte = cipher = (hexval (cipher) << 4) + hexval (t1_getbyte (mp));
+    }
+    plain = (cipher ^ (mp->ps->t1_dr >> 8));
+    mp->ps->t1_dr = (cipher + mp->ps->t1_dr) * mp->ps->t1_c1 + mp->ps->t1_c2;
+    return plain;
+}
+static byte cdecrypt (MP mp, byte cipher, unsigned short *cr)
+{
+    const byte plain = (cipher ^ (*cr >> 8));
+    *cr = (cipher + *cr) * mp->ps->t1_c1 + mp->ps->t1_c2;
+    return plain;
+}
+static byte eencrypt (MP mp, byte plain)
+{
+    const byte cipher = (plain ^ (mp->ps->t1_er >> 8));
+    mp->ps->t1_er = (cipher + mp->ps->t1_er) * mp->ps->t1_c1 + mp->ps->t1_c2;
+    return cipher;
+}
+
+static byte cencrypt (MP mp, byte plain, unsigned short *cr)
+{
+    const byte cipher = (plain ^ (*cr >> 8));
+    *cr = (cipher + *cr) * mp->ps->t1_c1 + mp->ps->t1_c2;
+    return cipher;
+}
+
+static char *eol (char *s) {
+    char *p = strend (s);
+    if (p - s > 1 && p[-1] != 10) {
+        *p++ = 10;
+        *p = 0;
+    }
+    return p;
+}
+static float t1_scan_num (MP mp, char *p, char **r)
+{
+    float f;
+    char s[128];
+    skip (p, ' ');
+    if (sscanf (p, "%g", &f) != 1) {
+        remove_eol (p, mp->ps->t1_line_array); 
+ 	    snprintf(s,128, "a number expected: `%s'", mp->ps->t1_line_array);
+        mp_fatal_error(mp,s);
+    }
+    if (r != NULL) {
+        for (; isdigit (*p) || *p == '.' ||
+             *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++);
+        *r = p;
+    }
+    return f;
+}
+
+static boolean str_suffix (const char *begin_buf, const char *end_buf,
+                           const char *s)
+{
+    const char *s1 = end_buf - 1, *s2 = strend (s) - 1;
+    if (*s1 == 10)
+        s1--;
+    while (s1 >= begin_buf && s2 >= s) {
+        if (*s1-- != *s2--)
+            return false;
+    }
+    return s2 < s;
+}
+
+@
+
+@d alloc_array(T, n, s) do {
+    if (mp->ps->T##_array == NULL) {
+        mp->ps->T##_limit = (s);
+        if ((unsigned)(n) > mp->ps->T##_limit)
+            mp->ps->T##_limit = (n);
+        mp->ps->T##_array = mp_xmalloc (mp,mp->ps->T##_limit,sizeof(T##_entry));
+        mp->ps->T##_ptr = mp->ps->T##_array;
+    }
+    else if ((unsigned)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit) {
+        size_t last_ptr_index;
+        last_ptr_index = mp->ps->T##_ptr - mp->ps->T##_array;
+        mp->ps->T##_limit *= 2;
+        if ((unsigned)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit)
+            mp->ps->T##_limit = mp->ps->T##_ptr - mp->ps->T##_array + (n);
+        mp->ps->T##_array = mp_xrealloc(mp,mp->ps->T##_array,mp->ps->T##_limit, sizeof(T##_entry));
+        mp->ps->T##_ptr = mp->ps->T##_array + last_ptr_index;
+    }
+} while (0)
+
+@d out_eexec_char(A)      t1_outhex(mp,(A))
+ 
+@c
+static void t1_outhex (MP mp, byte b)
+{
+    static const char *hexdigits = "0123456789ABCDEF";
+    t1_putchar (hexdigits[b / 16]);
+    t1_putchar (hexdigits[b % 16]);
+    mp->ps->hexline_length += 2;
+    end_hexline (mp);
+}
+static void t1_getline (MP mp) {
+    int c, l, eexec_scan;
+    char *p;
+    static const char eexec_str[] = "currentfile eexec";
+    static int eexec_len = 17;  /* |strlen(eexec_str)| */
+  RESTART:
+    if (t1_eof ())
+        mp_fatal_error (mp,"unexpected end of file");
+    mp->ps->t1_line_ptr = mp->ps->t1_line_array;
+    alloc_array (t1_line, 1, T1_BUF_SIZE);
+    mp->ps->t1_cslen = 0;
+    eexec_scan = 0;
+    c = t1_getbyte (mp);
+    if (c == EOF)
+        goto EXIT;
+    while (!t1_eof ()) {
+        if (mp->ps->t1_in_eexec == 1)
+            c = edecrypt (mp,c);
+        alloc_array (t1_line, 1, T1_BUF_SIZE);
+        append_char_to_buf (c, mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit);
+        if (mp->ps->t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) {
+            if (mp->ps->t1_line_array[eexec_scan] == eexec_str[eexec_scan])
+                eexec_scan++;
+            else
+                eexec_scan = -1;
+        }
+        if (c == 10 || (mp->ps->t1_pfa && eexec_scan == eexec_len && c == 32))
+            break;
+        if (mp->ps->t1_cs && mp->ps->t1_cslen == 0 && 
+            (mp->ps->t1_line_ptr - mp->ps->t1_line_array > 4) &&
+            (t1_suffix (" RD ") || t1_suffix (" -| "))) {
+            p = mp->ps->t1_line_ptr - 5;
+            while (*p != ' ')
+                p--;
+            mp->ps->t1_cslen = l = t1_scan_num (mp, p + 1, 0);
+            mp->ps->cs_start = mp->ps->t1_line_ptr - mp->ps->t1_line_array;     
+                  /* |mp->ps->cs_start| is an index now */
+            alloc_array (t1_line, l, T1_BUF_SIZE);
+            while (l-- > 0)
+                *mp->ps->t1_line_ptr++ = edecrypt (mp,t1_getbyte (mp));
+        }
+        c = t1_getbyte (mp);
+    }
+    alloc_array (t1_line, 2, T1_BUF_SIZE);      /* |append_eol| can append 2 chars */
+    append_eol (mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit);
+    if (mp->ps->t1_line_ptr - mp->ps->t1_line_array < 2)
+        goto RESTART;
+    if (eexec_scan == eexec_len)
+        mp->ps->t1_in_eexec = 1;
+  EXIT:
+    /* ensure that |mp->ps->t1_buf_array| has as much room as |t1_line_array| */
+    mp->ps->t1_buf_ptr = mp->ps->t1_buf_array;
+    alloc_array (t1_buf, mp->ps->t1_line_limit, mp->ps->t1_line_limit);
+}
+
+static void t1_putline (MP mp)
+{
+    char *p = mp->ps->t1_line_array;
+    if (mp->ps->t1_line_ptr - mp->ps->t1_line_array <= 1)
+        return;
+    if (mp->ps->t1_eexec_encrypt) {
+        while (p < mp->ps->t1_line_ptr)
+            out_eexec_char (eencrypt (mp,*p++));
+    } else {
+        while (p < mp->ps->t1_line_ptr)
+            t1_putchar (*p++);
+	}
+}
+
+static void t1_puts (MP mp, const char *s)
+{
+    if (s != mp->ps->t1_line_array)
+        strcpy (mp->ps->t1_line_array, s);
+    mp->ps->t1_line_ptr = strend (mp->ps->t1_line_array);
+    t1_putline (mp);
+}
+
+static void t1_printf (MP mp, const char *fmt, ...)
+{
+    va_list args;
+    va_start (args, fmt);
+    vsprintf (mp->ps->t1_line_array, fmt, args);
+    t1_puts (mp,mp->ps->t1_line_array);
+    va_end (args);
+}
+
+static void t1_init_params (MP mp, char *open_name_prefix,
+                           char *cur_file_name) {
+  if ((open_name_prefix != NULL) && strlen(open_name_prefix)) {
+    t1_log (open_name_prefix);
+    t1_log (cur_file_name);
+  }
+    mp->ps->t1_lenIV = 4;
+    mp->ps->t1_dr = 55665;
+    mp->ps->t1_er = 55665;
+    mp->ps->t1_in_eexec = 0;
+    mp->ps->t1_cs = false;
+    mp->ps->t1_scan = true;
+    mp->ps->t1_synthetic = false;
+    mp->ps->t1_eexec_encrypt = false;
+    mp->ps->t1_block_length = 0;
+    t1_check_pfa (mp);
+}
+static void  t1_close_font_file (MP mp, const char *close_name_suffix) {
+  if ((close_name_suffix != NULL) && strlen(close_name_suffix)) {
+    t1_log (close_name_suffix);
+  }
+  t1_close ();
+}
+
+static void  t1_check_block_len (MP mp, boolean decrypt) {
+    int l, c;
+    char s[128];
+    if (mp->ps->t1_block_length == 0)
+        return;
+    c = t1_getbyte (mp);
+    if (decrypt)
+        c = edecrypt (mp,c);
+    l = mp->ps->t1_block_length;
+    if (!(l == 0 && (c == 10 || c == 13))) {
+        snprintf(s,128,"%i bytes more than expected were ignored", l+ 1);
+        mp_warn(mp,s);
+        while (l-- > 0)
+          t1_getbyte (mp);
+    }
+}
+static void  t1_start_eexec (MP mp, fm_entry *fm_cur) {
+    int i;
+    if (!mp->ps->t1_pfa)
+     t1_check_block_len (mp, false);
+    for (mp->ps->t1_line_ptr = mp->ps->t1_line_array, i = 0; i < 4; i++) {
+      edecrypt (mp, t1_getbyte (mp));
+      *mp->ps->t1_line_ptr++ = 0;
+    }
+    mp->ps->t1_eexec_encrypt = true;
+	if (!mp->ps->read_encoding_only)
+	  if (is_included (fm_cur))
+        t1_putline (mp);          /* to put the first four bytes */
+}
+static void  t1_stop_eexec (MP mp) {
+    int c;
+    end_last_eexec_line ();
+    if (!mp->ps->t1_pfa)
+      t1_check_block_len (mp,true);
+    else {
+        c = edecrypt (mp, t1_getbyte (mp));
+        if (!(c == 10 || c == 13)) {
+           if (mp->ps->last_hexbyte == 0)
+              t1_puts (mp,"00");
+           else
+              mp_warn (mp,"unexpected data after eexec");
+        }
+    }
+    mp->ps->t1_cs = false;
+    mp->ps->t1_in_eexec = 2;
+}
+static void  t1_modify_fm (MP mp) {
+  mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
+}
+
+static void  t1_modify_italic (MP mp) {
+  mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
+}
+
+@ @<Types...@>=
+typedef struct {
+    const char *pdfname;
+    const char *t1name;
+    float value;
+    boolean valid;
+} key_entry;
+
+@
+@d FONT_KEYS_NUM  11
+
+@<Declarations@>=
+static key_entry font_keys[FONT_KEYS_NUM] = {
+    {"Ascent", "Ascender", 0, false},
+    {"CapHeight", "CapHeight", 0, false},
+    {"Descent", "Descender", 0, false},
+    {"FontName", "FontName", 0, false},
+    {"ItalicAngle", "ItalicAngle", 0, false},
+    {"StemV", "StdVW", 0, false},
+    {"XHeight", "XHeight", 0, false},
+    {"FontBBox", "FontBBox", 0, false},
+    {"", "", 0, false},
+    {"", "", 0, false},
+    {"", "", 0, false}
+};
+
+
+@ 
+@d ASCENT_CODE         0
+@d CAPHEIGHT_CODE      1
+@d DESCENT_CODE        2
+@d FONTNAME_CODE       3
+@d ITALIC_ANGLE_CODE   4
+@d STEMV_CODE          5
+@d XHEIGHT_CODE        6
+@d FONTBBOX1_CODE      7
+@d FONTBBOX2_CODE      8
+@d FONTBBOX3_CODE      9
+@d FONTBBOX4_CODE      10
+@d MAX_KEY_CODE (FONTBBOX1_CODE + 1)
+
+@c
+static void  t1_scan_keys (MP mp, int tex_font,fm_entry *fm_cur) {
+    int i, k;
+    char *p, *r;
+    key_entry *key;
+    if (fm_extend (fm_cur) != 0 || fm_slant (fm_cur) != 0) {
+        if (t1_prefix ("/FontMatrix")) {
+            t1_modify_fm (mp);
+            return;
+        }
+        if (t1_prefix ("/ItalicAngle")) {
+            t1_modify_italic (mp);
+            return;
+        }
+    }
+    if (t1_prefix ("/FontType")) {
+        p = mp->ps->t1_line_array + strlen ("FontType") + 1;
+        if ((i = t1_scan_num (mp,p, 0)) != 1) {
+            char s[128];
+            snprintf(s,125,"Type%d fonts unsupported by metapost", i);
+            mp_fatal_error(mp,s);
+        }
+        return;
+    }
+    for (key = font_keys; key - font_keys < MAX_KEY_CODE; key++)
+        if (str_prefix (mp->ps->t1_line_array + 1, key->t1name))
+            break;
+    if (key - font_keys == MAX_KEY_CODE)
+        return;
+    key->valid = true;
+    p = mp->ps->t1_line_array + strlen (key->t1name) + 1;
+    skip (p, ' ');
+    if ((k = key - font_keys) == FONTNAME_CODE) {
+        if (*p != '/') {
+          char s[128];
+      	  remove_eol (p, mp->ps->t1_line_array);
+          snprintf(s,128,"a name expected: `%s'", mp->ps->t1_line_array);
+          mp_fatal_error(mp,s);
+        }
+        r = ++p;                /* skip the slash */
+        if (is_included (fm_cur)) {
+	  /* save the fontname */
+	  strncpy (mp->ps->fontname_buf, p, FONTNAME_BUF_SIZE);
+	  for (i=0; mp->ps->fontname_buf[i] != 10; i++);
+	  mp->ps->fontname_buf[i]=0;
+	  
+	  if(is_subsetted (fm_cur)) {
+	    if (fm_cur->encoding!=NULL && fm_cur->encoding->glyph_names!=NULL)
+	      make_subset_tag (mp,fm_cur, fm_cur->encoding->glyph_names, tex_font);
+	    else
+	      make_subset_tag (mp,fm_cur, mp->ps->t1_builtin_glyph_names, tex_font);
+
+	    alloc_array (t1_line, (r-mp->ps->t1_line_array+6+1+strlen(mp->ps->fontname_buf)+1), 
+	                 T1_BUF_SIZE);
+	    strncpy (r, fm_cur->subset_tag , 6);
+	    *(r+6) = '-';
+	    strncpy (r+7, mp->ps->fontname_buf, strlen(mp->ps->fontname_buf)+1);
+	    mp->ps->t1_line_ptr = eol (r);
+	  } else {
+	    /* |for (q = p; *q != ' ' && *q != 10; *q++);|*/
+	    /*|*q = 0;|*/
+	    mp->ps->t1_line_ptr = eol (r);
+	  }
+	}
+        return;
+    }
+    if ((k == STEMV_CODE || k == FONTBBOX1_CODE)
+        && (*p == '[' || *p == '{'))
+        p++;
+    if (k == FONTBBOX1_CODE) {
+        for (i = 0; i < 4; i++) {
+            key[i].value = t1_scan_num (mp, p, &r);
+            p = r;
+        }
+        return;
+    }
+    key->value = t1_scan_num (mp, p, 0);
+}
+static void  t1_scan_param (MP mp, int tex_font,fm_entry *fm_cur)
+{
+    static const char *lenIV = "/lenIV";
+    if (!mp->ps->t1_scan || *mp->ps->t1_line_array != '/')
+        return;
+    if (t1_prefix (lenIV)) {
+        mp->ps->t1_lenIV = t1_scan_num (mp,mp->ps->t1_line_array + strlen (lenIV), 0);
+        return;
+    }
+    t1_scan_keys (mp, tex_font,fm_cur);
+}
+static void  copy_glyph_names (MP mp, char **glyph_names, int a, int b) {
+    if (glyph_names[b] != notdef) {
+        mp_xfree (glyph_names[b]);
+        glyph_names[b] = (char *) notdef;
+    }
+    if (glyph_names[a] != notdef) {
+        glyph_names[b] = mp_xstrdup (mp,glyph_names[a]);
+    }
+}
+static void  t1_builtin_enc (MP mp) {
+    int i, a, b, c, counter = 0;
+    char *r, *p;
+    /*
+     * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array|
+     */
+    if (t1_suffix ("def")) {    /* predefined encoding */
+        sscanf (mp->ps->t1_line_array + strlen ("/Encoding"), "%256s", mp->ps->t1_buf_array);
+        if (strcmp (mp->ps->t1_buf_array, "StandardEncoding") == 0) {
+            for (i = 0; i < 256; i++)
+                if (standard_glyph_names[i] == notdef)
+                    mp->ps->t1_builtin_glyph_names[i] = (char *) notdef;
+                else
+                    mp->ps->t1_builtin_glyph_names[i] =
+                        mp_xstrdup (mp,standard_glyph_names[i]);
+            mp->ps->t1_encoding = ENC_STANDARD;
+        } else {
+            char s[128];
+            snprintf(s,128, "cannot subset font (unknown predefined encoding `%s')",
+                        mp->ps->t1_buf_array);
+            mp_fatal_error(mp,s);
+        }
+        return;
+    } else
+        mp->ps->t1_encoding = ENC_BUILTIN;
+    /*
+     * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array|, and the encoding is
+     * not a predefined encoding
+     *
+     * We have two possible forms of Encoding vector. The first case is
+     *
+     *     /Encoding [/a /b /c...] readonly def
+     *
+     * and the second case can look like
+     *
+     *     /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for
+     *     dup 0 /x put
+     *     dup 1 /y put
+     *     ...
+     *     readonly def
+     */
+    for (i = 0; i < 256; i++)
+        mp->ps->t1_builtin_glyph_names[i] = (char *) notdef;
+    if (t1_prefix ("/Encoding [") || t1_prefix ("/Encoding[")) {        /* the first case */
+        r = strchr (mp->ps->t1_line_array, '[') + 1;
+        skip (r, ' ');
+        for (;;) {
+            while (*r == '/') {
+                for (p = mp->ps->t1_buf_array, r++;
+                     *r != 32 && *r != 10 && *r != ']' && *r != '/';
+                     *p++ = *r++);
+                *p = 0;
+                skip (r, ' ');
+                if (counter > 255) {
+                   mp_fatal_error
+                        (mp, "encoding vector contains more than 256 names");
+                }
+                if (strcmp (mp->ps->t1_buf_array, notdef) != 0)
+                  mp->ps->t1_builtin_glyph_names[counter] = mp_xstrdup (mp,mp->ps->t1_buf_array);
+                counter++;
+            }
+            if (*r != 10 && *r != '%') {
+                if (str_prefix (r, "] def")
+                    || str_prefix (r, "] readonly def"))
+                    break;
+                else {
+                    char s[128];
+                    remove_eol (r, mp->ps->t1_line_array);
+                    snprintf(s,128,"a name or `] def' or `] readonly def' expected: `%s'",
+                                    mp->ps->t1_line_array);
+                    mp_fatal_error(mp,s);
+                }
+            }
+            t1_getline (mp);
+            r = mp->ps->t1_line_array;
+        }
+    } else {                    /* the second case */
+        p = strchr (mp->ps->t1_line_array, 10);
+        for (;;) {
+            if (*p == 10) {
+                t1_getline (mp);
+                p = mp->ps->t1_line_array;
+            }
+            /*
+               check for `dup <index> <glyph> put'
+             */
+            if (sscanf (p, "dup %i%256s put", &i, mp->ps->t1_buf_array) == 2 &&
+                *mp->ps->t1_buf_array == '/' && valid_code (i)) {
+                if (strcmp (mp->ps->t1_buf_array + 1, notdef) != 0)
+                    mp->ps->t1_builtin_glyph_names[i] = 
+                      mp_xstrdup (mp,mp->ps->t1_buf_array + 1);
+                p = strstr (p, " put") + strlen (" put");
+                skip (p, ' ');
+            }
+            /*
+               check for `dup dup <to> exch <from> get put'
+             */
+            else if (sscanf (p, "dup dup %i exch %i get put", &b, &a) == 2
+                     && valid_code (a) && valid_code (b)) {
+                copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a, b);
+                p = strstr (p, " get put") + strlen (" get put");
+                skip (p, ' ');
+            }
+            /*
+               check for `dup dup <from> <size> getinterval <to> exch putinterval'
+             */
+            else if (sscanf
+                     (p, "dup dup %i %i getinterval %i exch putinterval",
+                      &a, &c, &b) == 3 && valid_code (a) && valid_code (b)
+                     && valid_code (c)) {
+                for (i = 0; i < c; i++)
+                    copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a + i, b + i);
+                p = strstr (p, " putinterval") + strlen (" putinterval");
+                skip (p, ' ');
+            }
+            /*
+               check for `def' or `readonly def'
+             */
+            else if ((p == mp->ps->t1_line_array || (p > mp->ps->t1_line_array && p[-1] == ' '))
+                     && strcmp (p, "def\n") == 0)
+                return;
+            /*
+               skip an unrecognizable word
+             */
+            else {
+                while (*p != ' ' && *p != 10)
+                    p++;
+                skip (p, ' ');
+            }
+        }
+    }
+}
+
+static void  t1_check_end (MP mp) {
+    if (t1_eof ())
+        return;
+    t1_getline (mp);
+    if (t1_prefix ("{restore}"))
+        t1_putline (mp);
+}
+
+@ @<Types...@>=
+typedef struct {
+    char *ff_name;              /* base name of font file */
+    char *ff_path;              /* full path to font file */
+} ff_entry;
+
+@ @c
+static boolean t1_open_fontfile (MP mp, fm_entry *fm_cur,const char *open_name_prefix) {
+    ff_entry *ff;
+    ff = check_ff_exist (mp, fm_cur);
+    if (ff->ff_path != NULL) {
+        mp->ps->t1_file = (mp->open_file)(mp,ff->ff_path, "r", mp_filetype_font);
+    } else {
+        mp_warn (mp, "cannot open Type 1 font file for reading");
+        return false;
+    }
+    t1_init_params (mp,(char *)open_name_prefix,fm_cur->ff_name);
+    mp->ps->fontfile_found = true;
+    return true;
+}
+
+static void  t1_scan_only (MP mp, int tex_font, fm_entry *fm_cur) {
+    do {
+        t1_getline (mp);
+        t1_scan_param (mp,tex_font, fm_cur);
+    }
+    while (mp->ps->t1_in_eexec == 0);
+    t1_start_eexec (mp,fm_cur);
+    do {
+        t1_getline (mp);
+        t1_scan_param (mp,tex_font, fm_cur);
+    }
+    while (!(t1_charstrings () || t1_subrs ()));
+}
+
+static void  t1_include (MP mp, int tex_font, fm_entry *fm_cur) {
+    do {
+        t1_getline (mp);
+        t1_scan_param (mp,tex_font, fm_cur);
+        t1_putline (mp);
+    }
+    while (mp->ps->t1_in_eexec == 0);
+    t1_start_eexec (mp,fm_cur);
+    do {
+        t1_getline (mp);
+        t1_scan_param (mp,tex_font, fm_cur);
+        t1_putline (mp);
+    }
+    while (!(t1_charstrings () || t1_subrs ()));
+    mp->ps->t1_cs = true;
+    do {
+        t1_getline (mp);
+        t1_putline (mp);
+    }
+    while (!t1_end_eexec ());
+    t1_stop_eexec (mp);
+    if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
+        do {
+            t1_getline (mp);
+            t1_putline (mp);
+        }
+        while (!t1_cleartomark ());
+        t1_check_end (mp);        /* write "{restore}if" if found */
+    }
+}
+
+@
+@d check_subr(SUBR) if (SUBR >= mp->ps->subr_size || SUBR < 0) {
+        char s[128];
+        snprintf(s,128,"Subrs array: entry index out of range (%i)",SUBR);
+        mp_fatal_error(mp,s);
+  }
+
+@c
+static const char **check_cs_token_pair (MP mp) {
+    const char **p = (const char **) cs_token_pairs_list;
+    for (; p[0] != NULL; ++p)
+        if (t1_buf_prefix (p[0]) && t1_buf_suffix (p[1]))
+            return p;
+    return NULL;
+}
+
+static void cs_store (MP mp, boolean is_subr) {
+    char *p;
+    cs_entry *ptr;
+    int subr;
+    for (p = mp->ps->t1_line_array, mp->ps->t1_buf_ptr = mp->ps->t1_buf_array; *p != ' ';
+         *mp->ps->t1_buf_ptr++ = *p++);
+    *mp->ps->t1_buf_ptr = 0;
+    if (is_subr) {
+        subr = t1_scan_num (mp, p + 1, 0);
+        check_subr (subr);
+        ptr = mp->ps->subr_tab + subr;
+    } else {
+        ptr = mp->ps->cs_ptr++;
+        if (mp->ps->cs_ptr - mp->ps->cs_tab > mp->ps->cs_size) {
+          char s[128];
+          snprintf(s,128,"CharStrings dict: more entries than dict size (%i)",mp->ps->cs_size);
+          mp_fatal_error(mp,s);
+        }
+        if (strcmp (mp->ps->t1_buf_array + 1, notdef) == 0)     /* skip the slash */
+            ptr->glyph_name = (char *) notdef;
+        else
+            ptr->glyph_name = mp_xstrdup (mp,mp->ps->t1_buf_array + 1);
+    }
+    /* copy " RD " + cs data to |mp->ps->t1_buf_array| */
+    memcpy (mp->ps->t1_buf_array, mp->ps->t1_line_array + mp->ps->cs_start - 4,
+            (unsigned) (mp->ps->t1_cslen + 4));
+    /* copy the end of cs data to |mp->ps->t1_buf_array| */
+    for (p = mp->ps->t1_line_array + mp->ps->cs_start + mp->ps->t1_cslen, mp->ps->t1_buf_ptr =
+         mp->ps->t1_buf_array + mp->ps->t1_cslen + 4; *p != 10; *mp->ps->t1_buf_ptr++ = *p++);
+    *mp->ps->t1_buf_ptr++ = 10;
+    if (is_subr && mp->ps->cs_token_pair == NULL)
+        mp->ps->cs_token_pair = check_cs_token_pair (mp);
+    ptr->len = mp->ps->t1_buf_ptr - mp->ps->t1_buf_array;
+    ptr->cslen = mp->ps->t1_cslen;
+    ptr->data = mp_xmalloc (mp,ptr->len , sizeof (byte));
+    memcpy (ptr->data, mp->ps->t1_buf_array, ptr->len);
+    ptr->valid = true;
+}
+
+#define store_subr(mp)    cs_store(mp,true)
+#define store_cs(mp)      cs_store(mp,false)
+
+#define CC_STACK_SIZE       24
+
+static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack;
+static cc_entry cc_tab[CS_MAX];
+static boolean is_cc_init = false;
+
+
+#define cc_pop(N)                       \
+    if (stack_ptr - cc_stack < (N))     \
+        stack_error(N);                 \
+    stack_ptr -= N
+
+#define stack_error(N) {                \
+    char s[256];                        \
+    snprintf(s,255,"CharString: invalid access (%i) to stack (%i entries)", \
+                 (int) N, (int)(stack_ptr - cc_stack));                  \
+    mp_warn(mp,s);                    \
+    goto cs_error;                    \
+}
+
+
+#define cc_get(N)   ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N)))
+
+#define cc_push(V)  *stack_ptr++ = V
+#define cc_clear()  stack_ptr = cc_stack
+
+#define set_cc(N, B, A, C) \
+    cc_tab[N].nargs = A;   \
+    cc_tab[N].bottom = B;  \
+    cc_tab[N].clear = C;   \
+    cc_tab[N].valid = true
+
+static void cc_init (void) {
+    int i;
+    if (is_cc_init)
+        return;
+    for (i = 0; i < CS_MAX; i++)
+        cc_tab[i].valid = false;
+    set_cc (CS_HSTEM, true, 2, true);
+    set_cc (CS_VSTEM, true, 2, true);
+    set_cc (CS_VMOVETO, true, 1, true);
+    set_cc (CS_RLINETO, true, 2, true);
+    set_cc (CS_HLINETO, true, 1, true);
+    set_cc (CS_VLINETO, true, 1, true);
+    set_cc (CS_RRCURVETO, true, 6, true);
+    set_cc (CS_CLOSEPATH, false, 0, true);
+    set_cc (CS_CALLSUBR, false, 1, false);
+    set_cc (CS_RETURN, false, 0, false);
+    /*
+       |set_cc(CS_ESCAPE,          false,  0, false);|
+     */
+    set_cc (CS_HSBW, true, 2, true);
+    set_cc (CS_ENDCHAR, false, 0, true);
+    set_cc (CS_RMOVETO, true, 2, true);
+    set_cc (CS_HMOVETO, true, 1, true);
+    set_cc (CS_VHCURVETO, true, 4, true);
+    set_cc (CS_HVCURVETO, true, 4, true);
+    set_cc (CS_DOTSECTION, false, 0, true);
+    set_cc (CS_VSTEM3, true, 6, true);
+    set_cc (CS_HSTEM3, true, 6, true);
+    set_cc (CS_SEAC, true, 5, true);
+    set_cc (CS_SBW, true, 4, true);
+    set_cc (CS_DIV, false, 2, false);
+    set_cc (CS_CALLOTHERSUBR, false, 0, false);
+    set_cc (CS_POP, false, 0, false);
+    set_cc (CS_SETCURRENTPOINT, true, 2, true);
+    is_cc_init = true;
+}
+
+@
+
+@d cs_getchar(mp)    cdecrypt(mp,*data++, &cr)
+
+@d mark_subr(mp,n)    cs_mark(mp,0, n)
+@d mark_cs(mp,s)      cs_mark(mp,s, 0)
+@d SMALL_BUF_SIZE      256
+
+@c
+static void cs_warn (MP mp, const char *cs_name, int subr, const char *fmt, ...) {
+    char buf[SMALL_BUF_SIZE];
+    char s[300];
+    va_list args;
+    va_start (args, fmt);
+    vsprintf (buf, fmt, args);
+    va_end (args);
+    if (cs_name == NULL) {
+        snprintf(s,299,"Subr (%i): %s", (int) subr, buf);
+    } else {
+       snprintf(s,299,"CharString (/%s): %s", cs_name, buf);
+    }
+    mp_warn(mp,s);
+}
+
+static void cs_mark (MP mp, const char *cs_name, int subr)
+{
+    byte *data;
+    int i, b, cs_len;
+    integer a, a1, a2;
+    unsigned short cr;
+    static integer lastargOtherSubr3 = 3;       /* the argument of last call to
+                                                   OtherSubrs[3] */
+    cs_entry *ptr;
+    cc_entry *cc;
+    if (cs_name == NULL) {
+        check_subr (subr);
+        ptr = mp->ps->subr_tab + subr;
+        if (!ptr->valid)
+          return;
+    } else {
+        if (mp->ps->cs_notdef != NULL &&
+            (cs_name == notdef || strcmp (cs_name, notdef) == 0))
+            ptr = mp->ps->cs_notdef;
+        else {
+            for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
+                if (strcmp (ptr->glyph_name, cs_name) == 0)
+                    break;
+            if (ptr == mp->ps->cs_ptr) {
+                char s[128];
+                snprintf (s,128,"glyph `%s' undefined", cs_name);
+                mp_warn(mp,s);
+                return;
+            }
+            if (ptr->glyph_name == notdef)
+                mp->ps->cs_notdef = ptr;
+        }
+    }
+    /* only marked CharString entries and invalid entries can be skipped;
+       valid marked subrs must be parsed to keep the stack in sync */
+    if (!ptr->valid || (ptr->is_used && cs_name != NULL))
+        return;
+    ptr->is_used = true;
+    cr = 4330;
+    cs_len = ptr->cslen;
+    data = ptr->data + 4;
+    for (i = 0; i < mp->ps->t1_lenIV; i++, cs_len--)
+        cs_getchar (mp);
+    while (cs_len > 0) {
+        --cs_len;
+        b = cs_getchar (mp);
+        if (b >= 32) {
+            if (b <= 246)
+                a = b - 139;
+            else if (b <= 250) {
+                --cs_len;
+                a = ((b - 247) << 8) + 108 + cs_getchar (mp);
+            } else if (b <= 254) {
+                --cs_len;
+                a = -((b - 251) << 8) - 108 - cs_getchar (mp);
+            } else {
+                cs_len -= 4;
+                a = (cs_getchar (mp) & 0xff) << 24;
+                a |= (cs_getchar (mp) & 0xff) << 16;
+                a |= (cs_getchar (mp) & 0xff) << 8;
+                a |= (cs_getchar (mp) & 0xff) << 0;
+                if (sizeof (integer) > 4 && (a & 0x80000000))
+                    a |= ~0x7FFFFFFF;
+            }
+            cc_push (a);
+        } else {
+            if (b == CS_ESCAPE) {
+                b = cs_getchar (mp) + CS_1BYTE_MAX;
+                cs_len--;
+            }
+            if (b >= CS_MAX) {
+                cs_warn (mp,cs_name, subr, "command value out of range: %i",
+                         (int) b);
+                goto cs_error;
+            }
+            cc = cc_tab + b;
+            if (!cc->valid) {
+                cs_warn (mp,cs_name, subr, "command not valid: %i", (int) b);
+                goto cs_error;
+            }
+            if (cc->bottom) {
+                if (stack_ptr - cc_stack < cc->nargs)
+                    cs_warn (mp,cs_name, subr,
+                             "less arguments on stack (%i) than required (%i)",
+                             (int) (stack_ptr - cc_stack), (int) cc->nargs);
+                else if (stack_ptr - cc_stack > cc->nargs)
+                    cs_warn (mp,cs_name, subr,
+                             "more arguments on stack (%i) than required (%i)",
+                             (int) (stack_ptr - cc_stack), (int) cc->nargs);
+            }
+            switch (cc - cc_tab) {
+            case CS_CALLSUBR:
+                a1 = cc_get (-1);
+                cc_pop (1);
+                mark_subr (mp,a1);
+                if (!mp->ps->subr_tab[a1].valid) {
+                    cs_warn (mp,cs_name, subr, "cannot call subr (%i)", (int) a1);
+                    goto cs_error;
+                }
+                break;
+            case CS_DIV:
+                cc_pop (2);
+                cc_push (0);
+                break;
+            case CS_CALLOTHERSUBR:
+                if (cc_get (-1) == 3)
+                    lastargOtherSubr3 = cc_get (-3);
+                a1 = cc_get (-2) + 2;
+                cc_pop (a1);
+                break;
+            case CS_POP:
+                cc_push (lastargOtherSubr3);
+                /* the only case when we care about the value being pushed onto
+                   stack is when POP follows CALLOTHERSUBR (changing hints by
+                   OtherSubrs[3])
+                 */
+                break;
+            case CS_SEAC:
+                a1 = cc_get (3);
+                a2 = cc_get (4);
+                cc_clear ();
+                mark_cs (mp,standard_glyph_names[a1]);
+                mark_cs (mp,standard_glyph_names[a2]);
+                break;
+            default:
+                if (cc->clear)
+                    cc_clear ();
+            }
+        }
+    }
+    return;
+  cs_error:                    /* an error occured during parsing */
+    cc_clear ();
+    ptr->valid = false;
+    ptr->is_used = false;
+}
+
+static void t1_subset_ascii_part (MP mp, int tex_font, fm_entry *fm_cur)
+{
+    int i, j;
+    t1_getline (mp);
+    while (!t1_prefix ("/Encoding")) {
+	  t1_scan_param (mp,tex_font, fm_cur);
+        t1_putline (mp);
+        t1_getline (mp);
+    }
+    t1_builtin_enc (mp);
+    if (is_reencoded (fm_cur))
+        mp->ps->t1_glyph_names = external_enc ();
+    else
+        mp->ps->t1_glyph_names = mp->ps->t1_builtin_glyph_names;
+	/* 
+    |if (is_included (fm_cur) && is_subsetted (fm_cur)) {
+	    make_subset_tag (fm_cur, t1_glyph_names, tex_font);
+        update_subset_tag ();
+    }|
+    */
+    if ((!is_subsetted (fm_cur)) && mp->ps->t1_encoding == ENC_STANDARD)
+        t1_puts (mp,"/Encoding StandardEncoding def\n");
+    else {
+        t1_puts
+            (mp,"/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n");
+        for (i = 0, j = 0; i < 256; i++) {
+            if (is_used_char (i) && mp->ps->t1_glyph_names[i] != notdef) {
+                j++;
+                t1_printf (mp,"dup %i /%s put\n", (int) t1_char (i),
+                           mp->ps->t1_glyph_names[i]);
+            }
+        }
+        /* We didn't mark anything for the Encoding array. */
+        /* We add "dup 0 /.notdef put" for compatibility   */
+        /* with Acrobat 5.0.                               */
+        if (j == 0)
+            t1_puts (mp,"dup 0 /.notdef put\n");
+        t1_puts (mp,"readonly def\n");
+    }
+    do {
+        t1_getline (mp);
+        t1_scan_param (mp,tex_font, fm_cur);
+        if (!t1_prefix ("/UniqueID"))   /* ignore UniqueID for subsetted fonts */
+            t1_putline (mp);
+    }
+    while (mp->ps->t1_in_eexec == 0);
+}
+
+#define t1_subr_flush(mp)  t1_flush_cs(mp,true)
+#define t1_cs_flush(mp)    t1_flush_cs(mp,false)
+
+static void cs_init (MP mp) {
+    mp->ps->cs_ptr = mp->ps->cs_tab = NULL;
+    mp->ps->cs_dict_start = mp->ps->cs_dict_end = NULL;
+    mp->ps->cs_count = mp->ps->cs_size = mp->ps->cs_size_pos = 0;
+    mp->ps->cs_token_pair = NULL;
+    mp->ps->subr_tab = NULL;
+    mp->ps->subr_array_start = mp->ps->subr_array_end = NULL;
+    mp->ps->subr_max = mp->ps->subr_size = mp->ps->subr_size_pos = 0;
+}
+
+static void init_cs_entry ( cs_entry * cs) {
+    cs->data = NULL;
+    cs->glyph_name = NULL;
+    cs->len = 0;
+    cs->cslen = 0;
+    cs->is_used = false;
+    cs->valid = false;
+}
+
+static void t1_mark_glyphs (MP mp, int tex_font);
+
+static void t1_read_subrs (MP mp, int tex_font, fm_entry *fm_cur)
+{
+    int i, s;
+    cs_entry *ptr;
+    t1_getline (mp);
+    while (!(t1_charstrings () || t1_subrs ())) {
+        t1_scan_param (mp,tex_font, fm_cur);
+        t1_putline (mp);
+        t1_getline (mp);
+    }
+  FOUND:
+    mp->ps->t1_cs = true;
+    mp->ps->t1_scan = false;
+    if (!t1_subrs ())
+        return;
+    mp->ps->subr_size_pos = strlen ("/Subrs") + 1;
+    /* |subr_size_pos| points to the number indicating dict size after "/Subrs" */
+    mp->ps->subr_size = t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->subr_size_pos, 0);
+    if (mp->ps->subr_size == 0) {
+        while (!t1_charstrings ())
+            t1_getline (mp);
+        return;
+    }
+	/*    |subr_tab = xtalloc (subr_size, cs_entry);| */
+	mp->ps->subr_tab = (cs_entry *)mp_xmalloc (mp,mp->ps->subr_size, sizeof (cs_entry));
+    for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
+        init_cs_entry (ptr);
+    mp->ps->subr_array_start = mp_xstrdup (mp,mp->ps->t1_line_array);
+    t1_getline (mp);
+    while (mp->ps->t1_cslen) {
+        store_subr (mp);
+        t1_getline (mp);
+    }
+    /* mark the first four entries without parsing */
+    for (i = 0; i < mp->ps->subr_size && i < 4; i++)
+        mp->ps->subr_tab[i].is_used = true;
+    /* the end of the Subrs array might have more than one line so we need to
+       concatnate them to |subr_array_end|. Unfortunately some fonts don't have
+       the Subrs array followed by the CharStrings dict immediately (synthetic
+       fonts). If we cannot find CharStrings in next |POST_SUBRS_SCAN| lines then
+       we will treat the font as synthetic and ignore everything until next
+       Subrs is found
+     */
+#define POST_SUBRS_SCAN     5
+    s = 0;
+    *mp->ps->t1_buf_array = 0;
+    for (i = 0; i < POST_SUBRS_SCAN; i++) {
+        if (t1_charstrings ())
+            break;
+        s += mp->ps->t1_line_ptr - mp->ps->t1_line_array;
+        alloc_array (t1_buf, s, T1_BUF_SIZE);
+        strcat (mp->ps->t1_buf_array, mp->ps->t1_line_array);
+        t1_getline (mp);
+    }
+    mp->ps->subr_array_end = mp_xstrdup (mp,mp->ps->t1_buf_array);
+    if (i == POST_SUBRS_SCAN) { /* CharStrings not found;
+                                   suppose synthetic font */
+        for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
+            if (ptr->valid)
+                mp_xfree (ptr->data);
+        mp_xfree (mp->ps->subr_tab);
+        mp_xfree (mp->ps->subr_array_start);
+        mp_xfree (mp->ps->subr_array_end);
+        cs_init (mp);
+        mp->ps->t1_cs = false;
+        mp->ps->t1_synthetic = true;
+        while (!(t1_charstrings () || t1_subrs ()))
+            t1_getline (mp);
+        goto FOUND;
+    }
+}
+
+@ @c
+static void t1_flush_cs (MP mp, boolean is_subr)
+{
+    char *p;
+    byte *r, *return_cs = NULL;
+    cs_entry *tab, *end_tab, *ptr;
+    char *start_line, *line_end;
+    int count, size_pos;
+    unsigned short cr, cs_len = 0; /* to avoid warning about uninitialized use of |cs_len| */
+    if (is_subr) {
+        start_line = mp->ps->subr_array_start;
+        line_end =  mp->ps->subr_array_end;
+        size_pos =  mp->ps->subr_size_pos;
+        tab =  mp->ps->subr_tab;
+        count =  mp->ps->subr_max + 1;
+        end_tab =  mp->ps->subr_tab + count;
+    } else {
+        start_line =  mp->ps->cs_dict_start;
+        line_end =  mp->ps->cs_dict_end;
+        size_pos =  mp->ps->cs_size_pos;
+        tab =  mp->ps->cs_tab;
+        end_tab =  mp->ps->cs_ptr;
+        count =  mp->ps->cs_count;
+    }
+    mp->ps->t1_line_ptr = mp->ps->t1_line_array;
+    for (p = start_line; p - start_line < size_pos;)
+        *mp->ps->t1_line_ptr++ = *p++;
+    while (isdigit (*p))
+        p++;
+    sprintf (mp->ps->t1_line_ptr, "%u", count);
+    strcat (mp->ps->t1_line_ptr, p);
+    mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
+    t1_putline (mp);
+
+    /* create |return_cs| to replace unsused subr's */
+    if (is_subr) {
+        cr = 4330;
+        cs_len = 0;
+        return_cs = mp_xmalloc (mp, (mp->ps->t1_lenIV + 1) , sizeof(byte));
+        if ( mp->ps->t1_lenIV > 0) {
+            for (cs_len = 0, r = return_cs; cs_len <  mp->ps->t1_lenIV; cs_len++, r++)
+                *r = cencrypt (mp,0x00, &cr);
+            *r = cencrypt (mp,CS_RETURN, &cr);
+        } else {
+            *return_cs = CS_RETURN;
+        }
+        cs_len++;
+    }
+
+    for (ptr = tab; ptr < end_tab; ptr++) {
+        if (ptr->is_used) {
+            if (is_subr)
+                sprintf (mp->ps->t1_line_array, "dup %i %u", (int) (ptr - tab),
+                         ptr->cslen);
+            else
+                sprintf (mp->ps->t1_line_array, "/%s %u", ptr->glyph_name, ptr->cslen);
+            p = strend (mp->ps->t1_line_array);
+            memcpy (p, ptr->data, ptr->len);
+            mp->ps->t1_line_ptr = p + ptr->len;
+            t1_putline (mp);
+        } else {
+            /* replace unsused subr's by |return_cs| */
+            if (is_subr) {
+                sprintf (mp->ps->t1_line_array, "dup %i %u%s ", (int) (ptr - tab),
+                         cs_len,  mp->ps->cs_token_pair[0]);
+                p = strend (mp->ps->t1_line_array);
+                memcpy (p, return_cs, cs_len);
+                mp->ps->t1_line_ptr = p + cs_len;
+                t1_putline (mp);
+                sprintf (mp->ps->t1_line_array, " %s",  mp->ps->cs_token_pair[1]);
+                mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
+                t1_putline (mp);
+            }
+        }
+        mp_xfree (ptr->data);
+        if (ptr->glyph_name != notdef)
+            mp_xfree (ptr->glyph_name);
+    }
+    sprintf (mp->ps->t1_line_array, "%s", line_end);
+    mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
+    t1_putline (mp);
+    if (is_subr)
+        mp_xfree (return_cs);
+    mp_xfree (tab);
+    mp_xfree (start_line);
+    mp_xfree (line_end);
+}
+
+static void t1_mark_glyphs (MP mp, int tex_font)
+{
+    int i;
+    char *charset = extra_charset ();
+    char *g, *s, *r;
+    cs_entry *ptr;
+    if (mp->ps->t1_synthetic || embed_all_glyphs (tex_font)) {  /* mark everything */
+        if (mp->ps->cs_tab != NULL)
+            for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
+                if (ptr->valid)
+                    ptr->is_used = true;
+        if (mp->ps->subr_tab != NULL) {
+            for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
+                if (ptr->valid)
+                    ptr->is_used = true;
+            mp->ps->subr_max = mp->ps->subr_size - 1;
+        }
+        return;
+    }
+    mark_cs (mp,notdef);
+    for (i = 0; i < 256; i++)
+        if (is_used_char (i)) {
+            if (mp->ps->t1_glyph_names[i] == notdef) {
+                char S[128];
+                snprintf(S,128, "character %i is mapped to %s", i, notdef);
+                mp_warn(mp,S);
+            } else
+                mark_cs (mp,mp->ps->t1_glyph_names[i]);
+        }
+    if (charset == NULL)
+        goto SET_SUBR_MAX;
+    g = s = charset + 1;        /* skip the first '/' */
+    r = strend (g);
+    while (g < r) {
+        while (*s != '/' && s < r)
+            s++;
+        *s = 0;                 /* terminate g by rewriting '/' to 0 */
+        mark_cs (mp,g);
+        g = s + 1;
+    }
+  SET_SUBR_MAX:
+    if (mp->ps->subr_tab != NULL)
+        for (mp->ps->subr_max = -1, ptr = mp->ps->subr_tab; 
+	         ptr - mp->ps->subr_tab < mp->ps->subr_size; 
+             ptr++)
+            if (ptr->is_used && ptr - mp->ps->subr_tab > mp->ps->subr_max)
+                mp->ps->subr_max = ptr - mp->ps->subr_tab;
+}
+
+static void t1_subset_charstrings (MP mp, int tex_font) 
+{
+    cs_entry *ptr;
+    mp->ps->cs_size_pos =
+        strstr (mp->ps->t1_line_array, charstringname) + strlen (charstringname)
+        - mp->ps->t1_line_array + 1;
+    /* |cs_size_pos| points to the number indicating
+       dict size after "/CharStrings" */
+    mp->ps->cs_size = t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->cs_size_pos, 0);
+    mp->ps->cs_ptr = mp->ps->cs_tab = mp_xmalloc (mp,mp->ps->cs_size, sizeof(cs_entry));
+    for (ptr = mp->ps->cs_tab; ptr - mp->ps->cs_tab < mp->ps->cs_size; ptr++)
+        init_cs_entry (ptr);
+    mp->ps->cs_notdef = NULL;
+    mp->ps->cs_dict_start = mp_xstrdup (mp,mp->ps->t1_line_array);
+    t1_getline (mp);
+    while (mp->ps->t1_cslen) {
+        store_cs (mp);
+        t1_getline (mp);
+    }
+    mp->ps->cs_dict_end = mp_xstrdup (mp,mp->ps->t1_line_array);
+    t1_mark_glyphs (mp,tex_font);
+    if (mp->ps->subr_tab != NULL) {
+        if (mp->ps->cs_token_pair == NULL) 
+            mp_fatal_error
+                (mp, "This Type 1 font uses mismatched subroutine begin/end token pairs.");
+        t1_subr_flush (mp);
+    }
+    for (mp->ps->cs_count = 0, ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
+        if (ptr->is_used)
+            mp->ps->cs_count++;
+    t1_cs_flush (mp);
+}
+
+static void t1_subset_end (MP mp)
+{
+    if (mp->ps->t1_synthetic) {         /* copy to "dup /FontName get exch definefont pop" */
+        while (!strstr (mp->ps->t1_line_array, "definefont")) {
+            t1_getline (mp);
+            t1_putline (mp);
+        }
+        while (!t1_end_eexec ())
+            t1_getline (mp);      /* ignore the rest */
+        t1_putline (mp);          /* write "mark currentfile closefile" */
+    } else
+        while (!t1_end_eexec ()) {      /* copy to "mark currentfile closefile" */
+            t1_getline (mp);
+            t1_putline (mp);
+        }
+    t1_stop_eexec (mp);
+    if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
+        while (!t1_cleartomark ()) {
+            t1_getline (mp);
+            t1_putline (mp);
+        }
+        if (!mp->ps->t1_synthetic)      /* don't check "{restore}if" for synthetic fonts */
+            t1_check_end (mp);    /* write "{restore}if" if found */
+    }
+}
+
+static int t1_updatefm (MP mp, int f, fm_entry *fm)
+{
+  char *s, *p;
+  mp->ps->read_encoding_only = true;
+  if (!t1_open_fontfile (mp,fm,NULL)) {
+	return 0;
+  }
+  t1_scan_only (mp,f, fm);
+  s = mp_xstrdup(mp,mp->ps->fontname_buf);
+  p = s;
+  while (*p != ' ' && *p != 0) 
+     p++;
+  *p=0;
+  fm->ps_name = s;
+  t1_close_font_file (mp,"");
+  return 1;
+}
+
+
+static void  writet1 (MP mp, int tex_font, fm_entry *fm_cur) {
+	int save_selector = mp->selector;
+    mp_normalize_selector(mp);
+    mp->ps->read_encoding_only = false;
+    if (!is_included (fm_cur)) {        /* scan parameters from font file */
+      if (!t1_open_fontfile (mp,fm_cur,"{"))
+            return;
+   	    t1_scan_only (mp,tex_font, fm_cur);
+        t1_close_font_file (mp,"}");
+        return;
+    }
+    if (!is_subsetted (fm_cur)) {       /* include entire font */
+      if (!t1_open_fontfile (mp,fm_cur,"<<"))
+            return;
+	  t1_include (mp,tex_font,fm_cur);
+        t1_close_font_file (mp,">>");
+        return;
+    }
+    /* partial downloading */
+    if (!t1_open_fontfile (mp,fm_cur,"<"))
+        return;
+    t1_subset_ascii_part (mp,tex_font,fm_cur);
+    t1_start_eexec (mp,fm_cur);
+    cc_init ();
+    cs_init (mp);
+    t1_read_subrs (mp,tex_font, fm_cur);
+    t1_subset_charstrings (mp,tex_font);
+    t1_subset_end (mp);
+    t1_close_font_file (mp,">");
+    mp->selector = save_selector; 
+}
+
+@ @<Declarations@>=
+static void t1_free (MP mp);
+
+@ @c
+static void  t1_free (MP mp) {
+  mp_xfree (mp->ps->t1_line_array);
+  mp_xfree (mp->ps->t1_buf_array);
+}
+
+
+@* \[44d] Embedding fonts.
+
+@ The |tfm_num| is officially of type |font_number|, but that
+type does not exist yet at this point in the output order.
+
+@<Types...@>=
+typedef struct {
+    char *tfm_name;             /* TFM file name */
+    char *ps_name;              /* PostScript name */
+    integer flags;              /* font flags */
+    char *ff_name;              /* font file name */
+    char *subset_tag;           /* pseudoUniqueTag for subsetted font */
+    enc_entry *encoding;        /* pointer to corresponding encoding */
+    unsigned int tfm_num;       /* number of the TFM refering this entry */
+    unsigned short type;        /* font type (T1/TTF/...) */
+    short slant;                /* SlantFont */
+    short extend;               /* ExtendFont */
+    integer ff_objnum;          /* FontFile object number */
+    integer fn_objnum;          /* FontName/BaseName object number */
+    integer fd_objnum;          /* FontDescriptor object number */
+    char *charset;              /* string containing used glyphs */
+    boolean all_glyphs;         /* embed all glyphs? */
+    unsigned short links;       /* link flags from |tfm_tree| and |ps_tree| */
+    short tfm_avail;            /* flags whether a tfm is available */
+    short pid;                  /* Pid for truetype fonts */
+    short eid;                  /* Eid for truetype fonts */
+} fm_entry;
+
+
+@ 
+@<Glob...@>=
+#define FONTNAME_BUF_SIZE 128
+boolean fontfile_found;
+boolean is_otf_font;
+char fontname_buf[FONTNAME_BUF_SIZE];
+
+@ 
+@d F_INCLUDED          0x01
+@d F_SUBSETTED         0x02
+@d F_TRUETYPE          0x04
+@d F_BASEFONT          0x08
+
+@d set_included(fm)    ((fm)->type |= F_INCLUDED)
+@d set_subsetted(fm)   ((fm)->type |= F_SUBSETTED)
+@d set_truetype(fm)    ((fm)->type |= F_TRUETYPE)
+@d set_basefont(fm)    ((fm)->type |= F_BASEFONT)
+
+@d is_included(fm)     ((fm)->type & F_INCLUDED)
+@d is_subsetted(fm)    ((fm)->type & F_SUBSETTED)
+@d is_truetype(fm)     ((fm)->type & F_TRUETYPE)
+@d is_basefont(fm)     ((fm)->type & F_BASEFONT)
+@d is_reencoded(fm)    ((fm)->encoding != NULL)
+@d is_fontfile(fm)     (fm_fontfile(fm) != NULL)
+@d is_t1fontfile(fm)   (is_fontfile(fm) && !is_truetype(fm))
+
+@d fm_slant(fm)        (fm)->slant
+@d fm_extend(fm)       (fm)->extend
+@d fm_fontfile(fm)     (fm)->ff_name
+
+@<Declarations@>=
+static boolean mp_font_is_reencoded (MP mp, int f);
+static boolean mp_font_is_included (MP mp, int f);
+static boolean mp_font_is_subsetted (MP mp, int f);
+
+@ @c
+static boolean mp_font_is_reencoded (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL 
+	&& (fm->ps_name != NULL)
+	&& is_reencoded (fm))
+      return 1;
+  }
+  return 0;
+}
+static boolean mp_font_is_included (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL 
+	&& (fm->ps_name != NULL && fm->ff_name != NULL) 
+	&& is_included (fm))
+      return 1;
+  }
+  return 0;
+}
+static boolean mp_font_is_subsetted (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f,&fm)) { 
+    if (fm != NULL 
+  	  && (fm->ps_name != NULL && fm->ff_name != NULL) 
+	  && is_included (fm) && is_subsetted (fm))
+      return 1;
+  }
+  return 0;
+}
+
+@ @<Exported function headers@>=
+char * mp_fm_encoding_name (MP mp, int f);
+char * mp_fm_font_name (MP mp, int f);
+
+@ @<Declarations@>=
+static char * mp_fm_font_subset_name (MP mp, int f);
+
+@ 
+@c char * mp_fm_encoding_name (MP mp, int f) {
+  enc_entry *e;
+  fm_entry *fm;
+  if (mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL && (fm->ps_name != NULL)) {
+      if (is_reencoded (fm)) {
+   	    e = fm->encoding;
+      	if (e->enc_name!=NULL)
+     	  return mp_xstrdup(mp,e->enc_name);
+      } else {
+	    return NULL;
+      }
+    }
+  }
+  print_err ("fontmap encoding problems for font ");
+  mp_print(mp,mp->font_name[f]);
+  mp_error(mp); 
+  return NULL;
+}
+char * mp_fm_font_name (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_fm_entry (mp, f,&fm)) { 
+    if (fm != NULL && (fm->ps_name != NULL)) {
+      if (mp_font_is_included(mp, f) && !mp->font_ps_name_fixed[f]) {
+	/* find the real fontname, and update |ps_name| and |subset_tag| if needed */
+        if (t1_updatefm(mp,f,fm)) {
+	  mp->font_ps_name_fixed[f] = true;
+	} else {
+	  print_err ("font loading problems for font ");
+          mp_print(mp,mp->font_name[f]);
+          mp_error(mp);
+	}
+      }
+      return mp_xstrdup(mp,fm->ps_name);
+    }
+  }
+  print_err ("fontmap name problems for font ");
+  mp_print(mp,mp->font_name[f]);
+  mp_error(mp); 
+  return NULL;
+}
+
+static char * mp_fm_font_subset_name (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL && (fm->ps_name != NULL)) {
+      if (is_subsetted(fm)) {
+  	    char *s = mp_xmalloc(mp,strlen(fm->ps_name)+8,1);
+       	snprintf(s,strlen(fm->ps_name)+8,"%s-%s",fm->subset_tag,fm->ps_name);
+ 	    return s;
+      } else {
+        return mp_xstrdup(mp,fm->ps_name);
+      }
+    }
+  }
+  print_err ("fontmap name problems for font ");
+  mp_print(mp,mp->font_name[f]);
+  mp_error(mp); 
+  return NULL;
+}
+
+@ @<Declarations@>=
+static integer mp_fm_font_slant (MP mp, int f);
+static integer mp_fm_font_extend (MP mp, int f);
+
+@ 
+@c static integer mp_fm_font_slant (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL && (fm->ps_name != NULL)) {
+      return fm->slant;
+    }
+  }
+  return 0;
+}
+static integer mp_fm_font_extend (MP mp, int f) {
+  fm_entry *fm;
+  if (mp_has_fm_entry (mp, f, &fm)) { 
+    if (fm != NULL && (fm->ps_name != NULL)) {
+      return fm->extend;
+    }
+  }
+  return 0;
+}
+
+@ @<Declarations@>=
+static boolean mp_do_ps_font (MP mp, font_number f);
+
+@ @c static boolean mp_do_ps_font (MP mp, font_number f) {
+  fm_entry *fm_cur;
+  (void)mp_has_fm_entry (mp, f, &fm_cur); /* for side effects */
+  if (fm_cur == NULL)
+    return 1;
+  if (is_truetype(fm_cur) ||
+	 (fm_cur->ps_name == NULL && fm_cur->ff_name == NULL)) {
+    return 0;
+  }
+  if (is_included(fm_cur)) {
+    mp_ps_print_nl(mp,"%%BeginResource: font ");
+    if (is_subsetted(fm_cur)) {
+      mp_ps_print(mp, fm_cur->subset_tag);
+      mp_ps_print_char(mp,'-');
+    }
+    mp_ps_print(mp, fm_cur->ps_name);
+    mp_ps_print_ln(mp);
+    writet1 (mp,f,fm_cur);
+    mp_ps_print_nl(mp,"%%EndResource");
+    mp_ps_print_ln(mp);
+  }
+  return 1;
+}
+
+@ Included subset fonts do not need and encoding vector, make
+sure we skip that case.
+
+@<Declarations@>=
+static void mp_list_used_resources (MP mp, int prologues, int procset);
+
+@ @c static void mp_list_used_resources (MP mp, int prologues, int procset) {
+  font_number f; /* fonts used in a text node or as loop counters */
+  int ff;  /* a loop counter */
+  font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
+  boolean firstitem;
+  if ( procset>0 )
+    mp_ps_print_nl(mp, "%%DocumentResources: procset mpost");
+  else
+    mp_ps_print_nl(mp, "%%DocumentResources: procset mpost-minimal");
+  ldf=null_font;
+  firstitem=true;
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) ) {
+	  for (ff=ldf;ff>=null_font;ff--) {
+        if ( mp_has_font_size(mp,ff) )
+          if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 )
+            goto FOUND;
+      }
+      if ( mp_font_is_subsetted(mp,f) )
+        goto FOUND;
+      if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])>
+           (unsigned)mp->max_print_line )
+        mp_ps_print_nl(mp, "%%+ encoding");
+      if ( firstitem ) {
+        firstitem=false;
+        mp_ps_print_nl(mp, "%%+ encoding");
+      }
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print(mp, mp->font_enc_name[f]);
+      ldf=f;
+    }
+  FOUND:
+    ;
+  }
+  ldf=null_font;
+  firstitem=true;
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    if ( mp_has_font_size(mp,f) ) {
+      for (ff=ldf;ff>=null_font;ff--) {
+        if ( mp_has_font_size(mp,ff) )
+          if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
+            goto FOUND2;
+      }
+      if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>
+	       (unsigned)mp->max_print_line )
+        mp_ps_print_nl(mp, "%%+ font");
+      if ( firstitem ) {
+        firstitem=false;
+        mp_ps_print_nl(mp, "%%+ font");
+      }
+      mp_ps_print_char(mp, ' ');
+	  if ( (prologues==3)&&
+           (mp_font_is_subsetted(mp,f)) )
+        mp_ps_print(mp, mp_fm_font_subset_name(mp,f));
+      else
+        mp_ps_print(mp, mp->font_ps_name[f]);
+      ldf=f;
+    }
+  FOUND2:
+    ;
+  }
+  mp_ps_print_ln(mp);
+} 
+
+@ @<Declarations@>=
+static void mp_list_supplied_resources (MP mp, int prologues, int procset);
+
+@ @c static void mp_list_supplied_resources (MP mp, int prologues, int procset) {
+  font_number f; /* fonts used in a text node or as loop counters */
+  int ff; /* a loop counter */
+  font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
+  boolean firstitem;
+  if ( procset>0 )
+    mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost");
+  else
+    mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost-minimal");
+  ldf=null_font;
+  firstitem=true;
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) )  {
+       for (ff=ldf;ff>= null_font;ff++) {
+         if ( mp_has_font_size(mp,ff) )
+           if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 )
+             goto FOUND;
+        }
+      if ( (prologues==3)&&(mp_font_is_subsetted(mp,f)))
+        goto FOUND;
+      if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])>(unsigned)mp->max_print_line )
+        mp_ps_print_nl(mp, "%%+ encoding");
+      if ( firstitem ) {
+        firstitem=false;
+        mp_ps_print_nl(mp, "%%+ encoding");
+      }
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print(mp, mp->font_enc_name[f]);
+      ldf=f;
+    }
+  FOUND:
+    ;
+  }
+  ldf=null_font;
+  firstitem=true;
+  if (prologues==3) {
+    for (f=null_font+1;f<=mp->last_fnum;f++) {
+      if ( mp_has_font_size(mp,f) ) {
+        for (ff=ldf;ff>= null_font;ff--) {
+          if ( mp_has_font_size(mp,ff) )
+            if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
+               goto FOUND2;
+        }
+        if ( ! mp_font_is_included(mp,f) )
+          goto FOUND2;
+        if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
+          mp_ps_print_nl(mp, "%%+ font");
+        if ( firstitem ) {
+          firstitem=false;
+          mp_ps_print_nl(mp, "%%+ font");
+        }
+        mp_ps_print_char(mp, ' ');
+	    if ( mp_font_is_subsetted(mp,f) ) 
+          mp_ps_print(mp, mp_fm_font_subset_name(mp,f));
+        else
+          mp_ps_print(mp, mp->font_ps_name[f]);
+        ldf=f;
+      }
+    FOUND2:
+      ;
+    }
+    mp_ps_print_ln(mp);
+  }
+}
+
+@ @<Declarations...@>=
+static void mp_list_needed_resources (MP mp, int prologues);
+
+@ @c static void mp_list_needed_resources (MP mp, int prologues) {
+  font_number f; /* fonts used in a text node or as loop counters */
+  int ff; /* a loop counter */
+  font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
+  boolean firstitem;
+  ldf=null_font;
+  firstitem=true;
+  for (f=null_font+1;f<=mp->last_fnum;f++ ) {
+    if ( mp_has_font_size(mp,f)) {
+      for (ff=ldf;ff>=null_font;ff--) {
+        if ( mp_has_font_size(mp,ff) )
+          if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
+             goto FOUND;
+      };
+      if ((prologues==3)&&(mp_font_is_included(mp,f)) )
+        goto FOUND;
+      if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
+        mp_ps_print_nl(mp, "%%+ font");
+      if ( firstitem ) {
+        firstitem=false;
+        mp_ps_print_nl(mp, "%%DocumentNeededResources: font");
+      }
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print(mp, mp->font_ps_name[f]);
+      ldf=f;
+    }
+  FOUND:
+    ;
+  }
+  if ( ! firstitem ) {
+    mp_ps_print_ln(mp);
+    ldf=null_font;
+    firstitem=true;
+    for (f=null_font+1;f<= mp->last_fnum;f++) {
+      if ( mp_has_font_size(mp,f) ) {
+        for (ff=ldf;ff>=null_font;ff-- ) {
+          if ( mp_has_font_size(mp,ff) )
+            if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
+              goto FOUND2;
+        }
+        if ((prologues==3)&&(mp_font_is_included(mp,f)) )
+          goto FOUND2;
+        mp_ps_print(mp, "%%IncludeResource: font ");
+        mp_ps_print(mp, mp->font_ps_name[f]);
+        mp_ps_print_ln(mp);
+        ldf=f;
+      }
+    FOUND2:
+      ;
+    }
+  }
+}
+
+@ @<Declarations@>=
+static void mp_write_font_definition (MP mp, font_number f, int prologues);
+
+@ 
+
+@d applied_reencoding(A) ((mp_font_is_reencoded(mp,(A)))&&
+    ((! mp_font_is_subsetted(mp,(A)))||(prologues==2)))
+
+@c static void mp_write_font_definition(MP mp, font_number f, int prologues) {
+  if ( (applied_reencoding(f))||(mp_fm_font_slant(mp,f)!=0)||
+       (mp_fm_font_extend(mp,f)!=0)||
+       (mp_xstrcmp(mp->font_name[f],"psyrgo")==0)||
+       (mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0) ) {
+    if ( (mp_font_is_subsetted(mp,f))&&
+	 (mp_font_is_included(mp,f))&&(prologues==3))
+      mp_ps_name_out(mp, mp_fm_font_subset_name(mp,f),true);
+    else 
+      mp_ps_name_out(mp, mp->font_ps_name[f],true);
+    mp_ps_print(mp, " fcp");
+    mp_ps_print_ln(mp);
+    if ( applied_reencoding(f) ) {
+      mp_ps_print(mp, "/Encoding ");
+      mp_ps_print(mp, mp->font_enc_name[f]);
+      mp_ps_print(mp, " def ");
+    };
+    if ( mp_fm_font_slant(mp,f)!=0 ) {
+      mp_ps_print_int(mp, mp_fm_font_slant(mp,f));
+      mp_ps_print(mp, " SlantFont ");
+    };
+    if ( mp_fm_font_extend(mp,f)!=0 ) {
+      mp_ps_print_int(mp, mp_fm_font_extend(mp,f));
+      mp_ps_print(mp, " ExtendFont ");
+    };
+    if ( mp_xstrcmp(mp->font_name[f],"psyrgo")==0 ) {
+      mp_ps_print(mp, " 890 ScaleFont ");
+      mp_ps_print(mp, " 277 SlantFont ");
+    };
+    if ( mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0 ) {
+      mp_ps_print(mp, " FontMatrix [-1 0 0 1 0 0] matrix concatmatrix /FontMatrix exch def ");
+      mp_ps_print(mp, "/Metrics 2 dict dup begin ");
+      mp_ps_print(mp, "/space[0 -278]def ");
+      mp_ps_print(mp, "/a12[-904 -939]def ");
+      mp_ps_print(mp, "end def ");
+    };  
+    mp_ps_print(mp, "currentdict end");
+    mp_ps_print_ln(mp);
+    mp_ps_print_defined_name(mp,f,prologues);
+    mp_ps_print(mp, " exch definefont pop");
+    mp_ps_print_ln(mp);
+  }
+}
+
+@ @<Declarations@>=
+static void mp_ps_print_defined_name (MP mp, font_number f, int prologues);
+
+@ 
+@c static void mp_ps_print_defined_name(MP mp, font_number A, int prologues) {
+  mp_ps_print(mp, " /");
+  if ((mp_font_is_subsetted(mp,(A)))&&
+      (mp_font_is_included(mp,(A)))&&(prologues==3))
+    mp_ps_print(mp, mp_fm_font_subset_name(mp,(A)));
+  else 
+    mp_ps_print(mp, mp->font_ps_name[(A)]);
+  if ( mp_xstrcmp(mp->font_name[(A)],"psyrgo")==0 )
+    mp_ps_print(mp, "-Slanted");
+  if ( mp_xstrcmp(mp->font_name[(A)],"zpzdr-reversed")==0 ) 
+    mp_ps_print(mp, "-Reverse");
+  if ( applied_reencoding((A)) ) { 
+    mp_ps_print(mp, "-");
+    mp_ps_print(mp, mp->font_enc_name[(A)]); 
+  }
+  if ( mp_fm_font_slant(mp,(A))!=0 ) {
+    mp_ps_print(mp, "-Slant_"); mp_ps_print_int(mp, mp_fm_font_slant(mp,(A))) ;
+  }
+  if ( mp_fm_font_extend(mp,(A))!=0 ) {
+    mp_ps_print(mp, "-Extend_"); mp_ps_print_int(mp, mp_fm_font_extend(mp,(A))); 
+  }
+}
+
+@ @<Include encodings and fonts for edge structure~|h|@>=
+mp_font_encodings(mp,mp->last_fnum,(prologues==2));
+@<Embed fonts that are available@>
+
+@ @<Embed fonts that are available@>=
+{ 
+next_size=0;
+@<Make |cur_fsize| a copy of the |font_sizes| array@>;
+do {  
+  done_fonts=true;
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    if ( cur_fsize[f]!=null ) {
+      if (prologues==3 ) {
+        if ( ! mp_do_ps_font(mp,f) ) {
+	      if ( mp_has_fm_entry(mp,f, NULL) ) {
+            print_err("Font embedding failed");
+            mp_error(mp);
+          }
+        }
+      }
+      cur_fsize[f]=link(cur_fsize[f]);
+      if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false; }
+    }
+  }
+  if ( ! done_fonts )
+    @<Increment |next_size| and apply |mark_string_chars| to all text nodes with
+      that size index@>;
+} while (! done_fonts);
+}
+
+@ @<Increment |next_size| and apply |mark_string_chars| to all text nodes...@>=
+{ 
+  next_size++;
+  mp_apply_mark_string_chars(mp, h, next_size);
+}
+
+@ We also need to keep track of which characters are used in text nodes
+in the edge structure that is being shipped out.  This is done by procedures
+that use the left-over |b3| field in the |char_info| words; i.e.,
+|char_info(f)(c).b3| gives the status of character |c| in font |f|.
+
+@<Types...@>=
+enum mp_char_mark_state {mp_unused=0, mp_used};
+
+@ @<Exported...@>=
+void mp_mark_string_chars (MP mp,font_number f, char *s) ;
+
+@ @c
+void mp_mark_string_chars (MP mp,font_number f, char *s) {
+  integer b; /* |char_base[f]| */
+  ASCII_code bc,ec; /* only characters between these bounds are marked */
+  char *k; /* an index into string |s| */
+  b=mp->char_base[f];
+  bc=mp->font_bc[f];
+  ec=mp->font_ec[f];
+  k=s; /* str_stop */
+  while (*k){ 
+    if ( (*k>=bc)&&(*k<=ec) )
+      mp->font_info[b+*k].qqqq.b3=mp_used;
+    k++;
+  }
+}
+
+
+@ @<Exported ...@>=
+void mp_unmark_font (MP mp,font_number f) ;
+
+@ @c
+void mp_unmark_font (MP mp,font_number f) {
+  int k; /* an index into |font_info| */
+  for (k= mp->char_base[f]+mp->font_bc[f];
+       k<=mp->char_base[f]+mp->font_ec[f];
+       k++)
+    mp->font_info[k].qqqq.b3=mp_unused;
+}
+
+
+@ @<Exported...@>=
+void mp_print_improved_prologue (MP mp, mp_edge_object *h, int prologues, int procset) ;
+
+@ @c
+void mp_print_improved_prologue (MP mp, mp_edge_object *h, int prologues, int procset) {
+  quarterword next_size; /* the size index for fonts being listed */
+  pointer *cur_fsize; /* current positions in |font_sizes| */
+  boolean done_fonts; /* have we finished listing the fonts in the header? */
+  font_number f; /* a font number for loops */
+  cur_fsize = mp_xmalloc(mp,(mp->font_max+1),sizeof(pointer));
+  mp_list_used_resources(mp, prologues, procset);
+  mp_list_supplied_resources(mp, prologues, procset);
+  mp_list_needed_resources(mp, prologues);
+  mp_ps_print_nl(mp, "%%EndComments");
+  mp_ps_print_nl(mp, "%%BeginProlog");
+  if ( procset>0 )
+    mp_ps_print_nl(mp, "%%BeginResource: procset mpost");
+  else
+    mp_ps_print_nl(mp, "%%BeginResource: procset mpost-minimal");
+  mp_ps_print_nl(mp, "/bd{bind def}bind def"
+                  "/fshow {exch findfont exch scalefont setfont show}bd");
+  if ( procset>0 ) @<Print the procset@>;
+  mp_ps_print_nl(mp, "/fcp{findfont dup length dict begin"
+                  "{1 index/FID ne{def}{pop pop}ifelse}forall}bd");
+  mp_ps_print_nl(mp, "/fmc{FontMatrix dup length array copy dup dup}bd"
+                   "/fmd{/FontMatrix exch def}bd");
+  mp_ps_print_nl(mp, "/Amul{4 -1 roll exch mul 1000 div}bd"
+                  "/ExtendFont{fmc 0 get Amul 0 exch put fmd}bd");
+  mp_ps_print_nl(mp, "/ScaleFont{dup fmc 0 get"
+                  " Amul 0 exch put dup dup 3 get Amul 3 exch put fmd}bd");
+  mp_ps_print_nl(mp, "/SlantFont{fmc 2 get dup 0 eq{pop 1}if"
+	              " Amul FontMatrix 0 get mul 2 exch put fmd}bd");
+  mp_ps_print_nl(mp, "%%EndResource");
+  @<Include encodings and fonts  for edge structure~|h|@>;
+  mp_ps_print_nl(mp, "%%EndProlog");
+  mp_ps_print_nl(mp, "%%BeginSetup");
+  mp_ps_print_ln(mp);
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    if ( mp_has_font_size(mp,f) ) {
+      if ( mp_has_fm_entry(mp,f,NULL) ) {
+        mp_write_font_definition(mp,f, prologues);
+        mp_ps_name_out(mp, mp->font_name[f],true);
+        mp_ps_print_defined_name(mp,f, prologues);
+        mp_ps_print(mp, " def");
+      } else {
+	    char s[256];
+        snprintf(s,256,"font %s cannot be found in any fontmapfile!", mp->font_name[f]);
+      	mp_warn(mp,s);
+        mp_ps_name_out(mp, mp->font_name[f],true);
+        mp_ps_name_out(mp, mp->font_name[f],true);
+        mp_ps_print(mp, " def");
+      }
+      mp_ps_print_ln(mp);
+    }
+  }
+  mp_ps_print_nl(mp, "%%EndSetup");
+  mp_ps_print_nl(mp, "%%Page: 1 1");
+  mp_ps_print_ln(mp);
+  mp_xfree(cur_fsize);
+}
+
+@ @<Declarations@>=
+static font_number mp_print_font_comments (MP mp , mp_edge_object *h, int prologues);
+
+
+@ 
+@c 
+static font_number mp_print_font_comments (MP mp , mp_edge_object *h, int prologues) {
+  quarterword next_size; /* the size index for fonts being listed */
+  pointer *cur_fsize; /* current positions in |font_sizes| */
+  int ff; /* a loop counter */
+  boolean done_fonts; /* have we finished listing the fonts in the header? */
+  font_number f; /* a font number for loops */
+  scaled ds; /* design size and scale factor for a text node */
+  font_number ldf=0; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
+  cur_fsize = mp_xmalloc(mp,(mp->font_max+1),sizeof(pointer));
+  if ( prologues>0 ) {
+    @<Give a \.{DocumentFonts} comment listing all fonts with non-null
+      |font_sizes| and eliminate duplicates@>;
+  } else { 
+    next_size=0;
+    @<Make |cur_fsize| a copy of the |font_sizes| array@>;
+    do {  done_fonts=true;
+      for (f=null_font+1;f<=mp->last_fnum;f++) {
+        if ( cur_fsize[f]!=null ) {
+          @<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>;
+        }
+        if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false;  };
+      }
+      if ( ! done_fonts ) {
+        @<Increment |next_size| and apply |mark_string_chars| to all text nodes with
+          that size index@>;
+      }
+    } while (! done_fonts);
+  }
+  mp_xfree(cur_fsize);
+  return ldf;
+}
+
+@ @<Make |cur_fsize| a copy of the |font_sizes| array@>=
+for (f=null_font+1;f<= mp->last_fnum;f++)
+  cur_fsize[f]=mp->font_sizes[f]
+
+@ It's not a good idea to make any assumptions about the |font_ps_name| entries,
+so we carefully remove duplicates.  There is no harm in using a slow, brute-force
+search.
+
+@<Give a \.{DocumentFonts} comment listing all fonts with non-null...@>=
+{ 
+  ldf=null_font;
+  for (f=null_font+1;f<= mp->last_fnum;f++) {
+    if ( mp->font_sizes[f]!=null ) {
+      if ( ldf==null_font ) 
+        mp_ps_print_nl(mp, "%%DocumentFonts:");
+      for (ff=ldf;ff>=null_font;ff--) {
+        if ( mp->font_sizes[ff]!=null )
+          if ( mp_xstrcmp(mp->font_ps_name[f],mp->font_ps_name[ff])==0 )
+            goto FOUND;
+      }
+      if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
+        mp_ps_print_nl(mp, "%%+");
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print(mp, mp->font_ps_name[f]);
+      ldf=f;
+    FOUND:
+      ;
+    }
+  }
+}
+
+@ @c
+static void mp_hex_digit_out (MP mp,small_number d) { 
+  if ( d<10 ) mp_ps_print_char(mp, d+'0');
+  else mp_ps_print_char(mp, d+'a'-10);
+}
+
+@ We output the marks as a hexadecimal bit string starting at |c| or
+|font_bc[f]|, whichever is greater.  If the output has to be truncated
+to avoid exceeding |emergency_line_length| the return value says where to
+start scanning next time.
+
+@<Declarations@>=
+static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c);
+
+@ 
+@d emergency_line_length 255
+  /* \ps\ output lines can be this long in unusual circumstances */
+
+@c
+static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c) {
+  eight_bits bc,ec; /* only encode characters between these bounds */
+  integer lim; /* the maximum number of marks to encode before truncating */
+  int p; /* |font_info| index for the current character */
+  int d,b; /* used to construct a hexadecimal digit */
+  lim=4*(emergency_line_length-mp->ps->ps_offset-4);
+  bc=mp->font_bc[f];
+  ec=mp->font_ec[f];
+  if ( c>bc ) bc=c;
+  @<Restrict the range |bc..ec| so that it contains no unused characters
+    at either end and has length at most |lim|@>;
+  @<Print the initial label indicating that the bitmap starts at |bc|@>;
+  @<Print a hexadecimal encoding of the marks for characters |bc..ec|@>;
+  while ( (ec<mp->font_ec[f])&&(mp->font_info[p].qqqq.b3==mp_unused) ) {
+    p++; ec++;
+  }
+  return (ec+1);
+}
+
+@ We could save time by setting the return value before the loop that
+decrements |ec|, but there is no point in being so tricky.
+
+@<Restrict the range |bc..ec| so that it contains no unused characters...@>=
+p=mp->char_base[f]+bc;
+while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) {
+  p++; bc++;
+}
+if ( ec>=bc+lim ) ec=bc+lim-1;
+p=mp->char_base[f]+ec;
+while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) { 
+  p--; ec--;
+}
+
+@ @<Print the initial label indicating that the bitmap starts at |bc|@>=
+mp_ps_print_char(mp, ' ');
+mp_hex_digit_out(mp, bc / 16);
+mp_hex_digit_out(mp, bc % 16);
+mp_ps_print_char(mp, ':')
+
+@ 
+
+@<Print a hexadecimal encoding of the marks for characters |bc..ec|@>=
+b=8; d=0;
+for (p=mp->char_base[f]+bc;p<=mp->char_base[f]+ec;p++) {
+  if ( b==0 ) {
+    mp_hex_digit_out(mp, d);
+    d=0; b=8;
+  }
+  if ( mp->font_info[p].qqqq.b3!=mp_unused ) d=d+b;
+  b=b>>1;
+}
+mp_hex_digit_out(mp, d)
+
+
+@ Here is a simple function that determines whether there are any marked
+characters in font~|f| with character code at least~|c|.
+
+@<Declarations@>=
+static boolean mp_check_ps_marks (MP mp,font_number f, integer  c) ;
+
+@ @c
+static boolean mp_check_ps_marks (MP mp,font_number f, integer  c) {
+  int p; /* |font_info| index for the current character */
+  for (p=mp->char_base[f]+c;p<=mp->char_base[f]+mp->font_ec[f];p++) {
+    if ( mp->font_info[p].qqqq.b3==mp_used ) 
+       return true;
+  }
+  return false;
+}
+
+
+@ If the file name is so long that it can't be printed without exceeding
+|emergency_line_length| then there will be missing items in the \.{\%*Font:}
+line.  We might have to repeat line in order to get the character usage
+information to fit within |emergency_line_length|.
+
+TODO: these two defines are also defined in mp.w!
+
+@d link(A)   mp->mem[(A)].hh.rh /* the |link| field of a memory word */
+@d sc_factor(A) mp->mem[(A)+1].cint /* the scale factor stored in a font size node */
+
+@<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>=
+{ integer t=0;
+  while ( mp_check_ps_marks(mp, f,t) ) {
+    mp_ps_print_nl(mp, "%*Font: ");
+    if ( mp->ps->ps_offset+strlen(mp->font_name[f])+12>emergency_line_length )
+      break;
+    mp_ps_print(mp, mp->font_name[f]);
+    mp_ps_print_char(mp, ' ');
+    ds=(mp->font_dsize[f] + 8) / 16;
+    mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,sc_factor(cur_fsize[f])));
+    if ( mp->ps->ps_offset+12>emergency_line_length ) break;
+    mp_ps_print_char(mp, ' ');
+    mp_ps_print_scaled(mp, ds);
+    if ( mp->ps->ps_offset+5>emergency_line_length ) break;
+    t=mp_ps_marks_out(mp, f,t);
+  }
+  cur_fsize[f]=link(cur_fsize[f]);
+}
+
+@ @<Print the procset@>=
+{
+  mp_ps_print_nl(mp, "/hlw{0 dtransform exch truncate exch idtransform pop setlinewidth}bd");
+  mp_ps_print_nl(mp, "/vlw{0 exch dtransform truncate idtransform setlinewidth pop}bd");
+  mp_ps_print_nl(mp, "/l{lineto}bd/r{rlineto}bd/c{curveto}bd/m{moveto}bd"
+                  "/p{closepath}bd/n{newpath}bd");
+  mp_ps_print_nl(mp, "/C{setcmykcolor}bd/G{setgray}bd/R{setrgbcolor}bd"
+                  "/lj{setlinejoin}bd/ml{setmiterlimit}bd");
+  mp_ps_print_nl(mp, "/lc{setlinecap}bd/S{stroke}bd/F{fill}bd/q{gsave}bd"
+                  "/Q{grestore}bd/s{scale}bd/t{concat}bd");
+  mp_ps_print_nl(mp, "/sd{setdash}bd/rd{[] 0 setdash}bd/P{showpage}bd/B{q F Q}bd/W{clip}bd");
+}
+
+
+@ The prologue defines \.{fshow} and corrects for the fact that \.{fshow}
+arguments use |font_name| instead of |font_ps_name|.  Downloaded bitmap fonts
+might not have reasonable |font_ps_name| entries, but we just charge ahead
+anyway.  The user should not make \&{prologues} positive if this will cause
+trouble.
+@:prologues_}{\&{prologues} primitive@>
+
+@<Exported...@>=
+void mp_print_prologue (MP mp, mp_edge_object *h, int prologues, int procset);
+
+@ @c 
+void mp_print_prologue (MP mp, mp_edge_object *h, int prologues, int procset) {
+  font_number f;
+  font_number ldf ;
+  ldf = mp_print_font_comments (mp, h, prologues);
+  mp_ps_print_ln(mp);
+  if ( (prologues==1) && (mp->last_ps_fnum<mp->last_fnum) )
+    mp_read_psname_table(mp);
+  mp_ps_print(mp, "%%BeginProlog"); mp_ps_print_ln(mp);
+  if ( (prologues>0)||(procset>0) ) {
+    if ( ldf!=null_font ) {
+      if ( prologues>0 ) {
+        for (f=null_font+1;f<=mp->last_fnum;f++) {
+          if ( mp_has_font_size(mp,f) ) {
+            mp_ps_name_out(mp, mp->font_name[f],true);
+            mp_ps_name_out(mp, mp->font_ps_name[f],true);
+            mp_ps_print(mp, " def");
+            mp_ps_print_ln(mp);
+          }
+        }
+        if ( procset==0 ) {
+          mp_ps_print(mp, "/fshow {exch findfont exch scalefont setfont show}bind def");
+          mp_ps_print_ln(mp);
+        }
+      }
+    }
+    if (procset>0 ) {
+      mp_ps_print_nl(mp, "%%BeginResource: procset mpost");
+      if ( (prologues>0)&&(ldf!=null_font) )
+        mp_ps_print_nl(mp, 
+        "/bd{bind def}bind def/fshow {exch findfont exch scalefont setfont show}bd");
+      else
+        mp_ps_print_nl(mp, "/bd{bind def}bind def");
+      @<Print the procset@>;
+      mp_ps_print_nl(mp, "%%EndResource");
+      mp_ps_print_ln(mp);
+    }
+  }
+  mp_ps_print(mp, "%%EndProlog");
+  mp_ps_print_nl(mp, "%%Page: 1 1"); mp_ps_print_ln(mp);
+}
+
+@ \MP\ used to have one single routine to print to both `write' files
+and the PostScript output. Web2c redefines ``Character |k| cannot be
+printed'', and that resulted in some bugs where 8-bit characters were
+written to the PostScript file (reported by Wlodek Bzyl).
+
+Also, Hans Hagen requested spaces to be output as "\\040" instead of
+a plain space, since that makes it easier to parse the result file
+for postprocessing.
+
+@<Character |k| is not allowed in PostScript output@>=
+  (k<=' ')||(k>'~')
+
+@ We often need to print a pair of coordinates.
+
+@c
+void mp_ps_pair_out (MP mp,scaled x, scaled y) { 
+  ps_room(26);
+  mp_ps_print_scaled(mp, x); mp_ps_print_char(mp, ' ');
+  mp_ps_print_scaled(mp, y); mp_ps_print_char(mp, ' ');
+}
+
+@ @<Exported...@>=
+void mp_ps_pair_out (MP mp,scaled x, scaled y) ;
+
+@ @c
+void mp_ps_print_cmd (MP mp, const char *l, const char *s) {
+  if ( mp->internal[mp_procset]>0 ) { ps_room(strlen(s)); mp_ps_print(mp,s); }
+  else { ps_room(strlen(l)); mp_ps_print(mp, l); };
+}
+
+@ @<Exported...@>=
+void mp_ps_print_cmd (MP mp, const char *l, const char *s) ;
+
+@ @c
+void mp_ps_string_out (MP mp, const char *s) {
+  ASCII_code k; /* bits to be converted to octal */
+  mp_ps_print(mp, "(");
+  while ((k=*s++)) {
+    if ( mp->ps->ps_offset+5>mp->max_print_line ) {
+      mp_ps_print_char(mp, '\\');
+      mp_ps_print_ln(mp);
+    }
+    if ( (@<Character |k| is not allowed in PostScript output@>) ) {
+      mp_ps_print_char(mp, '\\');
+      mp_ps_print_char(mp, '0'+(k / 64));
+      mp_ps_print_char(mp, '0'+((k / 8) % 8));
+      mp_ps_print_char(mp, '0'+(k % 8));
+    } else { 
+      if ( (k=='(')||(k==')')||(k=='\\') ) 
+        mp_ps_print_char(mp, '\\');
+      mp_ps_print_char(mp, k);
+    }
+  }
+  mp_ps_print_char(mp, ')');
+}
+
+@ @<Exported...@>=
+void mp_ps_string_out (MP mp, const char *s) ;
+
+@ This is a define because the function does not use its |mp| argument.
+
+@d mp_is_ps_name(M,A) mp_do_is_ps_name(A)
+
+@c
+static boolean mp_do_is_ps_name (char *s) {
+  ASCII_code k; /* the character being checked */
+  while ((k=*s++)) {
+    if ( (k<=' ')||(k>'~') ) return false;
+    if ( (k=='(')||(k==')')||(k=='<')||(k=='>')||
+       (k=='{')||(k=='}')||(k=='/')||(k=='%') ) return false;
+  }
+  return true;
+}
+
+@ @<Exported...@>=
+void mp_ps_name_out (MP mp, char *s, boolean lit) ;
+
+@ @c
+void mp_ps_name_out (MP mp, char *s, boolean lit) {
+  ps_room(strlen(s)+2);
+  mp_ps_print_char(mp, ' ');
+  if ( mp_is_ps_name(mp, s) ) {
+    if ( lit ) mp_ps_print_char(mp, '/');
+      mp_ps_print(mp, s);
+  } else { 
+    mp_ps_string_out(mp, s);
+    if ( ! lit ) mp_ps_print(mp, "cvx ");
+      mp_ps_print(mp, "cvn");
+  }
+}
+
+
+@ These special comments described in the {\sl PostScript Language Reference
+Manual}, 2nd.~edition are understood by some \ps-reading programs.
+We can't normally output ``conforming'' \ps\ because
+the structuring conventions don't allow us to say ``Please make sure the
+following characters are downloaded and define the \.{fshow} macro to access
+them.''
+
+The exact bounding box is written out if |mp_prologues<0|, although this
+is not standard \ps, since it allows \TeX\ to calculate the box dimensions
+accurately. (Overfull boxes are avoided if an illustration is made to
+match a given \.{\char`\\hsize}.)
+
+@<Exported...@>=
+void mp_print_initial_comment(MP mp,mp_edge_object *hh, int prologues);
+
+@ @c
+void mp_print_initial_comment(MP mp,mp_edge_object *hh, int prologues) {
+  scaled t;
+  mp_ps_print(mp, "%!PS");
+  if ( prologues>0 ) 
+    mp_ps_print(mp, "-Adobe-3.0 EPSF-3.0");
+  mp_ps_print_nl(mp, "%%BoundingBox: ");
+  if ( hh->_minx>hh->_maxx) {
+     mp_ps_print(mp, "0 0 0 0");
+  } else if ( prologues<0 ) {
+    mp_ps_pair_out(mp, hh->_minx,hh->_miny);
+    mp_ps_pair_out(mp, hh->_maxx,hh->_maxy);
+  } else { 
+    mp_ps_pair_out(mp, mp_floor_scaled(mp, hh->_minx),mp_floor_scaled(mp, hh->_miny));
+    mp_ps_pair_out(mp, -mp_floor_scaled(mp, -hh->_maxx),-mp_floor_scaled(mp, -hh->_maxy));
+  }
+  mp_ps_print_nl(mp, "%%HiResBoundingBox: ");
+  if ( hh->_minx>hh->_maxx ) {
+    mp_ps_print(mp, "0 0 0 0");
+  } else {
+    mp_ps_pair_out(mp, hh->_minx,hh->_miny);
+    mp_ps_pair_out(mp, hh->_maxx,hh->_maxy);
+  }
+  mp_ps_print_nl(mp, "%%Creator: MetaPost ");
+  mp_ps_print(mp, mp_metapost_version(mp));
+  mp_ps_print_nl(mp, "%%CreationDate: ");
+  mp_ps_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_year])); 
+  mp_ps_print_char(mp, '.');
+  mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_month])); 
+  mp_ps_print_char(mp, '.');
+  mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_day])); 
+  mp_ps_print_char(mp, ':');
+  t=mp_round_unscaled(mp, mp->internal[mp_time]);
+  mp_ps_print_dd(mp, t / 60); 
+  mp_ps_print_dd(mp, t % 60);
+  mp_ps_print_nl(mp, "%%Pages: 1");
+}
+
+@ The most important output procedure is the one that gives the \ps\ version of
+a \MP\ path.
+
+@<Types...@>=
+#define gr_left_type(A)  (A)->left_type_field 
+#define gr_right_type(A) (A)->right_type_field
+#define gr_x_coord(A)    (A)->x_coord_field   
+#define gr_y_coord(A)    (A)->y_coord_field   
+#define gr_left_x(A)     (A)->left_x_field    
+#define gr_left_y(A)     (A)->left_y_field    
+#define gr_right_x(A)    (A)->right_x_field   
+#define gr_right_y(A)    (A)->right_y_field   
+#define gr_next_knot(A)  (A)->next_field
+#define gr_originator(A) (A)->originator_field
+typedef struct mp_knot {
+  unsigned short left_type_field;
+  unsigned short right_type_field;
+  scaled x_coord_field;
+  scaled y_coord_field;
+  scaled left_x_field;
+  scaled left_y_field;
+  scaled right_x_field;
+  scaled right_y_field;
+  struct mp_knot * next_field;
+  quarterword originator_field;
+} mp_knot;
+
+@ @c
+mp_knot * mp_gr_insert_knot (MP mp, mp_knot *q, scaled x, scaled y) {
+  /* returns the inserted knot */
+  mp_knot *r; /* the new knot */
+  r= mp_xmalloc(mp, 1, sizeof (mp_knot));
+  gr_next_knot(r)=gr_next_knot(q); gr_next_knot(q)=r;
+  gr_right_x(r)=gr_right_x(q);
+  gr_right_y(r)=gr_right_y(q);
+  gr_x_coord(r)=x;
+  gr_y_coord(r)=y;
+  gr_right_x(q)=gr_x_coord(q);
+  gr_right_y(q)=gr_y_coord(q);
+  gr_left_x(r)=gr_x_coord(r);
+  gr_left_y(r)=gr_y_coord(r);
+  gr_left_type(r)=mp_explicit;
+  gr_right_type(r)=mp_explicit;
+  gr_originator(r)=mp_program_code;
+  return r;
+}
+
+
+@ If we want to duplicate a knot node, we can say |copy_knot|:
+
+@c 
+mp_knot *mp_gr_copy_knot (MP mp,  mp_knot *p) {
+  mp_knot *q; /* the copy */
+  q = mp_xmalloc(mp, 1, sizeof (mp_knot));
+  memcpy(q,p,sizeof (mp_knot));
+  gr_next_knot(q)=NULL;
+  return q;
+}
+
+@ The |copy_path| routine makes a clone of a given path.
+
+@c 
+mp_knot *mp_gr_copy_path (MP mp,  mp_knot *p) {
+  mp_knot *q, *pp, *qq; /* for list manipulation */
+  if (p==NULL) 
+    return NULL;
+  q=mp_gr_copy_knot(mp, p);
+  qq=q; 
+  pp=gr_next_knot(p);
+  while ( pp!=p ) { 
+    gr_next_knot(qq)=mp_gr_copy_knot(mp, pp);
+    qq=gr_next_knot(qq);
+    pp=gr_next_knot(pp);
+  }
+  gr_next_knot(qq)=q;
+  return q;
+}
+
+@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
+returns a pointer to the first node of the copy, if the path is a cycle,
+but to the final node of a non-cyclic copy. The global
+variable |path_tail| will point to the final node of the original path;
+this trick makes it easier to implement `\&{doublepath}'.
+
+All node types are assumed to be |endpoint| or |explicit| only.
+
+This function is currenly unused.
+
+@c 
+mp_knot * mp_gr_htap_ypoc (MP mp,  mp_knot *p) {
+  mp_knot *q, *pp, *qq, *rr; /* for list manipulation */
+  q=mp_xmalloc(mp, 1, sizeof (mp_knot)); /* this will correspond to |p| */
+  qq=q; pp=p;
+  while (1) { 
+    gr_right_type(qq)=gr_left_type(pp); 
+    gr_left_type(qq)=gr_right_type(pp);
+    gr_x_coord(qq)=gr_x_coord(pp); 
+    gr_y_coord(qq)=gr_y_coord(pp);
+    gr_right_x(qq)=gr_left_x(pp); 
+    gr_right_y(qq)=gr_left_y(pp);
+    gr_left_x(qq)=gr_right_x(pp); 
+    gr_left_y(qq)=gr_right_y(pp);
+    gr_originator(qq)=gr_originator(pp);
+    if ( gr_next_knot(pp)==p ) { 
+      gr_next_knot(q)=qq; 
+      /* mp->path_tail=pp; */ /* ? */
+      return q;
+    }
+    rr=mp_xmalloc(mp, 1, sizeof (mp_knot));
+    gr_next_knot(rr)=qq; 
+    qq=rr; 
+    pp=gr_next_knot(pp);
+  }
+}
+
+@ When a cyclic list of knot nodes is no longer needed, it can be recycled by
+calling the following subroutine.
+
+@<Declarations@>=
+void mp_do_gr_toss_knot_list (mp_knot *p) ;
+
+@ 
+@d mp_gr_toss_knot_list(B,A) mp_do_gr_toss_knot_list(A)
+
+@c
+void mp_do_gr_toss_knot_list (mp_knot * p) {
+  mp_knot *q; /* the node being freed */
+  mp_knot *r; /* the next node */
+  if (p==NULL)
+    return;
+  q=p;
+  do {  
+    r=gr_next_knot(q); 
+    mp_xfree(q); q=r;
+  } while (q!=p);
+}
+
+
+
+@ @c
+void mp_gr_ps_path_out (MP mp, mp_knot *h) {
+  mp_knot *p, *q; /* for scanning the path */
+  scaled d; /* a temporary value */
+  boolean curved; /* |true| unless the cubic is almost straight */
+  ps_room(40);
+  mp_ps_print_cmd(mp, "newpath ","n ");
+  mp_ps_pair_out(mp, gr_x_coord(h),gr_y_coord(h));
+  mp_ps_print_cmd(mp, "moveto","m");
+  p=h;
+  do {  
+    if ( gr_right_type(p)==mp_endpoint ) { 
+      if ( p==h ) mp_ps_print_cmd(mp, " 0 0 rlineto"," 0 0 r");
+      return;
+    }
+    q=gr_next_knot(p);
+    @<Start a new line and print the \ps\ commands for the curve from
+      |p| to~|q|@>;
+    p=q;
+  } while (p!=h);
+  mp_ps_print_cmd(mp, " closepath"," p");
+}
+
+@ @<Start a new line and print the \ps\ commands for the curve from...@>=
+curved=true;
+@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>;
+mp_ps_print_ln(mp);
+if ( curved ){ 
+  mp_ps_pair_out(mp, gr_right_x(p),gr_right_y(p));
+  mp_ps_pair_out(mp, gr_left_x(q),gr_left_y(q));
+  mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q));
+  mp_ps_print_cmd(mp, "curveto","c");
+} else if ( q!=h ){ 
+  mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q));
+  mp_ps_print_cmd(mp, "lineto","l");
+}
+
+@ Two types of straight lines come up often in \MP\ paths:
+cubics with zero initial and final velocity as created by |make_path| or
+|make_envelope|, and cubics with control points uniformly spaced on a line
+as created by |make_choices|.
+
+@d bend_tolerance 131 /* allow rounding error of $2\cdot10^{-3}$ */
+
+@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>=
+if ( gr_right_x(p)==gr_x_coord(p) )
+  if ( gr_right_y(p)==gr_y_coord(p) )
+    if ( gr_left_x(q)==gr_x_coord(q) )
+      if ( gr_left_y(q)==gr_y_coord(q) ) curved=false;
+d=gr_left_x(q)-gr_right_x(p);
+if ( abs(gr_right_x(p)-gr_x_coord(p)-d)<=bend_tolerance )
+  if ( abs(gr_x_coord(q)-gr_left_x(q)-d)<=bend_tolerance )
+    { d=gr_left_y(q)-gr_right_y(p);
+    if ( abs(gr_right_y(p)-gr_y_coord(p)-d)<=bend_tolerance )
+      if ( abs(gr_y_coord(q)-gr_left_y(q)-d)<=bend_tolerance ) curved=false;
+    }
+
+@ The colored objects use a struct with anonymous fields to express the color parts:
+
+@<Types...@>=
+typedef struct {
+   scaled _a_val, _b_val, _c_val, _d_val;
+} mp_color;
+
+@ The exported form of a dash pattern is simpler than the internal
+format, it is closely modelled to the PostScript model. The array of
+dashes is ended by a single negative value, because this is not
+allowed in PostScript.
+
+@d gr_dash_scale(A) (gr_dash_p(A))->scale_field
+
+@<Types...@>=
+typedef struct {
+  scaled offset_field;
+  scaled scale_field;
+  scaled *array_field;
+} mp_dash_object ;
+
+
+@ 
+@d mp_gr_toss_dashes(A,B) mp_do_gr_toss_dashes(B) 
+
+@<Declarations@>=
+void mp_do_gr_toss_dashes(mp_dash_object *dl);
+
+@ @c
+void mp_do_gr_toss_dashes(mp_dash_object *dl) {
+  if (dl==NULL)   
+    return;
+  mp_xfree(dl->array_field);  
+  mp_xfree(dl);
+}
+
+
+@ @c
+mp_dash_object *mp_gr_copy_dashes(MP mp, mp_dash_object *dl) {
+	mp_dash_object *q = NULL;
+    (void)mp;
+	if (dl==NULL)
+      return NULL;
+	q = mp_xmalloc(mp, 1, sizeof (mp_dash_object));
+	memcpy (q,dl,sizeof(mp_dash_object));
+	if (dl->array_field != NULL) {
+  	  int i = 0;
+      while (*(dl->array_field+i) != -1) i++;
+   	  q->array_field = mp_xmalloc(mp, i, sizeof (scaled));
+	  memcpy(q->array_field,dl->array_field, (i*sizeof(scaled)));
+    }
+	return q;
+}
+
+
+@ Now for outputting the actual graphic objects. First, set up some 
+structures and access macros.
+
+@d gr_has_color(A) (gr_type((A))<mp_start_clip_code)
+
+@<Types...@>=
+#define gr_type(A)         (A)->_type_field
+#define gr_link(A)         (A)->_link_field
+#define gr_color_model(A)  (A)->color_model_field
+#define gr_red_val(A)      (A)->color_field._a_val
+#define gr_green_val(A)    (A)->color_field._b_val
+#define gr_blue_val(A)     (A)->color_field._c_val
+#define gr_cyan_val(A)     (A)->color_field._a_val
+#define gr_magenta_val(A)  (A)->color_field._b_val
+#define gr_yellow_val(A)   (A)->color_field._c_val
+#define gr_black_val(A)    (A)->color_field._d_val
+#define gr_grey_val(A)     (A)->color_field._a_val
+#define gr_path_p(A)       (A)->path_p_field 
+#define gr_htap_p(A)       ((mp_fill_object *)A)->htap_p_field 
+#define gr_pen_p(A)        (A)->pen_p_field 
+#define gr_ljoin_val(A)    (A)->ljoin_field
+#define gr_lcap_val(A)     ((mp_stroked_object *)A)->lcap_field
+#define gr_miterlim_val(A) (A)->miterlim_field
+#define gr_pre_script(A)   (A)->pre_script_field
+#define gr_post_script(A)  (A)->post_script_field
+#define gr_dash_p(A)       ((mp_stroked_object *)A)->dash_p_field
+#define gr_name_type(A)    ((mp_text_object *)A)->name_type_field
+#define gr_text_p(A)       ((mp_text_object *)A)->text_p_field 
+#define gr_font_n(A)       ((mp_text_object *)A)->font_n_field 
+#define gr_font_name(A)    ((mp_text_object *)A)->font_name_field 
+#define gr_font_dsize(A)   ((mp_text_object *)A)->font_dsize_field 
+#define gr_width_val(A)    ((mp_text_object *)A)->width_field
+#define gr_height_val(A)   ((mp_text_object *)A)->height_field
+#define gr_depth_val(A)    ((mp_text_object *)A)->depth_field
+#define gr_tx_val(A)       ((mp_text_object *)A)->tx_field
+#define gr_ty_val(A)       ((mp_text_object *)A)->ty_field
+#define gr_txx_val(A)      ((mp_text_object *)A)->txx_field
+#define gr_txy_val(A)      ((mp_text_object *)A)->txy_field
+#define gr_tyx_val(A)      ((mp_text_object *)A)->tyx_field
+#define gr_tyy_val(A)      ((mp_text_object *)A)->tyy_field
+
+#define GRAPHIC_BODY                      \
+  halfword _type_field;                   \
+  struct mp_graphic_object * _link_field
+
+typedef struct mp_graphic_object {
+  GRAPHIC_BODY;
+} mp_graphic_object;
+
+typedef struct mp_text_object {
+  GRAPHIC_BODY;
+  char *pre_script_field;
+  char *post_script_field;
+  mp_color color_field;
+  quarterword color_model_field;
+  quarterword name_type_field;
+  char *text_p_field;
+  char *font_name_field ;   
+  scaled font_dsize_field ;
+  font_number font_n_field ;   
+  scaled width_field ;
+  scaled height_field ;
+  scaled depth_field ;
+  scaled tx_field ;
+  scaled ty_field ;
+  scaled txx_field ;
+  scaled txy_field ;
+  scaled tyx_field ;
+  scaled tyy_field ;
+} mp_text_object;
+
+typedef struct mp_fill_object {
+  GRAPHIC_BODY;
+  char *pre_script_field;
+  char *post_script_field;
+  mp_color color_field;
+  quarterword color_model_field;
+  quarterword ljoin_field ;   
+  mp_knot * path_p_field;
+  mp_knot * htap_p_field;
+  mp_knot * pen_p_field;
+  scaled miterlim_field ;
+} mp_fill_object;
+
+typedef struct mp_stroked_object {
+  GRAPHIC_BODY;
+  char *pre_script_field;
+  char *post_script_field;
+  mp_color color_field;
+  quarterword color_model_field;
+  quarterword ljoin_field ;   
+  quarterword lcap_field ;   
+  mp_knot * path_p_field;
+  mp_knot * pen_p_field;
+  scaled miterlim_field ;
+  mp_dash_object *dash_p_field;
+} mp_stroked_object;
+
+typedef struct mp_clip_object {
+  GRAPHIC_BODY;
+  mp_knot * path_p_field;
+} mp_clip_object;
+
+typedef struct mp_bounds_object {
+  GRAPHIC_BODY;
+  mp_knot * path_p_field;
+} mp_bounds_object;
+
+typedef struct mp_special_object {
+  GRAPHIC_BODY;
+  char *pre_script_field;
+} mp_special_object ;
+
+typedef struct mp_edge_object {
+  struct mp_graphic_object * body;
+  struct mp_edge_object * _next;
+  char * _filename;
+  MP _parent;
+  scaled _minx, _miny, _maxx, _maxy;
+} mp_edge_object;
+
+@ @<Exported function headers@>=
+mp_graphic_object *mp_new_graphic_object(MP mp, int type);
+
+@ @c
+mp_graphic_object *mp_new_graphic_object (MP mp, int type) {
+  mp_graphic_object *p;
+  int size ;
+  switch (type) {
+  case mp_fill_code:         size = sizeof(mp_fill_object);    break;
+  case mp_stroked_code:      size = sizeof(mp_stroked_object); break;
+  case mp_text_code:         size = sizeof(mp_text_object);    break;
+  case mp_start_clip_code:   size = sizeof(mp_clip_object);    break;
+  case mp_start_bounds_code: size = sizeof(mp_bounds_object);  break;
+  case mp_special_code:      size = sizeof(mp_special_object); break;
+  default:                   size = sizeof(mp_graphic_object); break;
+  }  
+  p = (mp_graphic_object *)mp_xmalloc(mp,1,size);
+  memset(p,0,size);
+  gr_type(p) = type;
+  return p;
+}
+
+@ We need to keep track of several parameters from the \ps\ graphics state.
+@^graphics state@>
+This allows us to be sure that \ps\ has the correct values when they are
+needed without wasting time and space setting them unnecessarily.
+
+@d gs_red        mp->ps->gs_state->red_field         
+@d gs_green      mp->ps->gs_state->green_field	     
+@d gs_blue       mp->ps->gs_state->blue_field	     
+@d gs_black      mp->ps->gs_state->black_field	     
+@d gs_colormodel mp->ps->gs_state->colormodel_field  
+@d gs_ljoin      mp->ps->gs_state->ljoin_field	     
+@d gs_lcap       mp->ps->gs_state->lcap_field	     
+@d gs_adj_wx     mp->ps->gs_state->adj_wx_field	     
+@d gs_miterlim   mp->ps->gs_state->miterlim_field    
+@d gs_dash_p     mp->ps->gs_state->dash_p_field	     
+@d gs_dash_init_done mp->ps->gs_state->dash_done_field
+@d gs_previous   mp->ps->gs_state->previous_field    
+@d gs_width      mp->ps->gs_state->width_field	     
+
+@<Types...@>=
+typedef struct _gs_state {
+  scaled red_field ;
+  scaled green_field ; 
+  scaled blue_field ;
+  scaled black_field ;
+  /* color from the last \&{setcmykcolor} or \&{setrgbcolor} or \&{setgray} command */
+  quarterword colormodel_field ;
+   /* the current colormodel */
+  quarterword ljoin_field ;   
+  quarterword lcap_field ;     
+   /* values from the last \&{setlinejoin} and \&{setlinecap} commands */
+  quarterword adj_wx_field ;
+   /* what resolution-dependent adjustment applies to the width */
+  scaled miterlim_field ;
+   /* the value from the last \&{setmiterlimit} command */
+  mp_dash_object * dash_p_field ;
+   /* edge structure for last \&{setdash} command */
+  boolean dash_done_field ; /* to test for initial \&{setdash} */
+  struct _gs_state * previous_field ;
+   /* backlink to the previous |_gs_state| structure */
+  scaled width_field ;
+   /* width setting or $-1$ if no \&{setlinewidth} command so far */
+} _gs_state;
+
+   
+@ @<Glob...@>=
+struct _gs_state * gs_state;
+
+@ @<Set init...@>=
+mp->ps->gs_state=NULL;
+
+@ @<Dealloc variables@>=
+mp_xfree(mp->ps->gs_state);
+
+@ To avoid making undue assumptions about the initial graphics state, these
+parameters are given special values that are guaranteed not to match anything
+in the edge structure being shipped out.  On the other hand, the initial color
+should be black so that the translation of an all-black picture will have no
+\&{setcolor} commands.  (These would be undesirable in a font application.)
+Hence we use |c=0| when initializing the graphics state and we use |c<0|
+to recover from a situation where we have lost track of the graphics state.
+
+@c
+void mp_gs_unknown_graphics_state (MP mp,scaled c) ;
+
+@ 
+@d mp_void (null+1) /* a null pointer different from |null| */
+
+@c void mp_gs_unknown_graphics_state (MP mp,scaled c) {
+  struct _gs_state *p; /* to shift graphic states around */
+  if ( (c==0)||(c==-1) ) {
+    if ( mp->ps->gs_state==NULL ) {
+      mp->ps->gs_state = mp_xmalloc(mp,1,sizeof(struct _gs_state));
+      gs_previous=NULL;
+    } else {
+      while ( gs_previous!=NULL ) {
+        p = gs_previous;
+        mp_xfree(mp->ps->gs_state);
+        mp->ps->gs_state=p;
+      }
+    }
+    gs_red=c; gs_green=c; gs_blue=c; gs_black=c;
+    gs_colormodel=mp_uninitialized_model;
+    gs_ljoin=3;
+    gs_lcap=3;
+    gs_miterlim=0;
+    gs_dash_p=NULL;
+    gs_dash_init_done=false;
+    gs_width=-1;
+  } else if ( c==1 ) {
+    p= mp->ps->gs_state;
+    mp->ps->gs_state =  mp_xmalloc(mp,1,sizeof(struct _gs_state));
+    memcpy(mp->ps->gs_state,p,sizeof(struct _gs_state));
+    gs_previous = p;
+  } else if ( c==2 ) {
+    p = gs_previous;
+    mp_xfree(mp->ps->gs_state);
+    mp->ps->gs_state=p;
+  }
+}
+
+
+@ When it is time to output a graphical object, |fix_graphics_state| ensures
+that \ps's idea of the graphics state agrees with what is stored in the object.
+
+@<Declarations@>=
+void mp_gr_fix_graphics_state (MP mp, mp_graphic_object *p) ;
+
+@ @c 
+void mp_gr_fix_graphics_state (MP mp, mp_graphic_object *p) {
+  /* get ready to output graphical object |p| */
+  mp_knot *pp, *path_p; /* for list manipulation */
+  mp_dash_object *hh;
+  scaled wx,wy,ww; /* dimensions of pen bounding box */
+  boolean adj_wx; /* whether pixel rounding should be based on |wx| or |wy| */
+  integer tx,ty; /* temporaries for computing |adj_wx| */
+  scaled scf; /* a scale factor for the dash pattern */
+  if ( gr_has_color(p) )
+    @<Make sure \ps\ will use the right color for object~|p|@>;
+  if ( (gr_type(p)==mp_fill_code)||(gr_type(p)==mp_stroked_code) ) {
+    if (gr_type(p)==mp_fill_code) {
+      pp = gr_pen_p((mp_fill_object *)p);
+      path_p = gr_path_p((mp_fill_object *)p);
+    } else {
+      pp = gr_pen_p((mp_stroked_object *)p);
+      path_p = gr_path_p((mp_stroked_object *)p);
+    }
+    if ( pp!=NULL )
+      if ( pen_is_elliptical(pp) ) {
+        @<Generate \ps\ code that sets the stroke width to the
+          appropriate rounded value@>;
+        @<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>;
+        @<Decide whether the line cap parameter matters and set it if necessary@>;
+        @<Set the other numeric parameters as needed for object~|p|@>;
+      }
+  }
+  if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp);
+}
+
+@ @<Decide whether the line cap parameter matters and set it if necessary@>=
+if ( gr_type(p)==mp_stroked_code ) {
+  mp_stroked_object *ts = (mp_stroked_object *)p;
+  if ( (gr_left_type(gr_path_p(ts))==mp_endpoint)||(gr_dash_p(ts)!=NULL) )
+    if ( gs_lcap!=gr_lcap_val(ts) ) {
+      ps_room(13);
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print_char(mp, '0'+gr_lcap_val(ts)); 
+      mp_ps_print_cmd(mp, " setlinecap"," lc");
+      gs_lcap=gr_lcap_val(ts);
+    }
+}
+
+@ 
+@d set_ljoin_miterlim(p) 
+  if ( gs_ljoin!=gr_ljoin_val(p) ) {
+    ps_room(14);
+    mp_ps_print_char(mp, ' ');
+    mp_ps_print_char(mp, '0'+gr_ljoin_val(p)); 
+    mp_ps_print_cmd(mp, " setlinejoin"," lj");
+    gs_ljoin=gr_ljoin_val(p);
+  }
+  if ( gs_miterlim!=gr_miterlim_val(p) ) {
+    ps_room(27);
+    mp_ps_print_char(mp, ' ');
+    mp_ps_print_scaled(mp, gr_miterlim_val(p)); 
+    mp_ps_print_cmd(mp, " setmiterlimit"," ml");
+    gs_miterlim=gr_miterlim_val(p);
+  }
+
+@<Set the other numeric parameters as needed for object~|p|@>=
+if ( gr_type(p)==mp_stroked_code ) {
+  mp_stroked_object *ts = (mp_stroked_object *)p;
+  set_ljoin_miterlim(ts);
+} else {
+  mp_fill_object *ts = (mp_fill_object *)p;
+  set_ljoin_miterlim(ts);
+}
+
+@ 
+@d set_color_objects(pq)
+  object_color_model = pq->color_model_field;
+  object_color_a = pq->color_field._a_val;
+  object_color_b = pq->color_field._b_val;
+  object_color_c = pq->color_field._c_val;
+  object_color_d = pq->color_field._d_val; 
+
+@<Make sure \ps\ will use the right color for object~|p|@>=
+{  
+  int object_color_model;
+  int object_color_a, object_color_b, object_color_c, object_color_d ; 
+  if (gr_type(p) == mp_fill_code) {
+    mp_fill_object *pq = (mp_fill_object *)p;
+    set_color_objects(pq);
+  } else if (gr_type(p) == mp_stroked_code) {
+    mp_stroked_object *pq = (mp_stroked_object *)p;
+    set_color_objects(pq);
+  } else {
+    mp_text_object *pq = (mp_text_object *)p;
+    set_color_objects(pq);
+  }
+
+  if ( object_color_model==mp_rgb_model) {
+  	if ( (gs_colormodel!=mp_rgb_model)||(gs_red!=object_color_a)||
+      (gs_green!=object_color_b)||(gs_blue!=object_color_c) ) {
+      gs_red   = object_color_a;
+      gs_green = object_color_b;
+      gs_blue  = object_color_c;
+      gs_black = -1;
+      gs_colormodel=mp_rgb_model;
+      { ps_room(36);
+        mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_red); mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_green); mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_blue);
+        mp_ps_print_cmd(mp, " setrgbcolor", " R");
+      }
+    }
+  } else if ( object_color_model==mp_cmyk_model) {
+   if ( (gs_red!=object_color_a)||(gs_green!=object_color_b)||
+      (gs_blue!=object_color_c)||(gs_black!=object_color_d)||
+      (gs_colormodel!=mp_cmyk_model) ) {
+      gs_red   = object_color_a;
+      gs_green = object_color_b;
+      gs_blue  = object_color_c;
+      gs_black = object_color_d;
+      gs_colormodel=mp_cmyk_model;
+      { ps_room(45);
+        mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_red); 
+        mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_green); 
+        mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_blue); 
+	    mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_black);
+        mp_ps_print_cmd(mp, " setcmykcolor"," C");
+      }
+    }
+  } else if ( object_color_model==mp_grey_model ) {
+   if ( (gs_red!=object_color_a)||(gs_colormodel!=mp_grey_model) ) {
+      gs_red   = object_color_a;
+      gs_green = -1;
+      gs_blue  = -1;
+      gs_black = -1;
+      gs_colormodel=mp_grey_model;
+      { ps_room(16);
+        mp_ps_print_char(mp, ' ');
+        mp_ps_print_scaled(mp, gs_red);
+        mp_ps_print_cmd(mp, " setgray"," G");
+      }
+    }
+  } else if ( object_color_model==mp_no_model ) {
+    gs_colormodel=mp_no_model;
+  }
+}
+
+@ In order to get consistent widths for horizontal and vertical pen strokes, we
+want \ps\ to use an integer number of pixels for the \&{setwidth} parameter.
+@:setwidth}{\&{setwidth}command@>
+We set |gs_width| to the ideal horizontal or vertical stroke width and then
+generate \ps\ code that computes the rounded value.  For non-circular pens, the
+pen shape will be rescaled so that horizontal or vertical parts of the stroke
+have the computed width.
+
+Rounding the width to whole pixels is not likely to improve the appearance of
+diagonal or curved strokes, but we do it anyway for consistency.  The
+\&{truncate} command generated here tends to make all the strokes a little
+@:truncate}{\&{truncate} command@>
+thinner, but this is appropriate for \ps's scan-conversion rules.  Even with
+truncation, an ideal with of $w$~pixels gets mapped into $\lfloor w\rfloor+1$.
+It would be better to have $\lceil w\rceil$ but that is ridiculously expensive
+to compute in \ps.
+
+@<Generate \ps\ code that sets the stroke width...@>=
+@<Set |wx| and |wy| to the width and height of the bounding box for
+  |pen_p(p)|@>;
+@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more
+  important and set |adj_wx| and |ww| accordingly@>;
+if ( (ww!=gs_width) || (adj_wx!=gs_adj_wx) ) {
+  if ( adj_wx ) {
+    ps_room(13);
+    mp_ps_print_char(mp, ' '); mp_ps_print_scaled(mp, ww);
+    mp_ps_print_cmd(mp, 
+      " 0 dtransform exch truncate exch idtransform pop setlinewidth"," hlw");
+  } else {
+    if ( mp->internal[mp_procset]>0 ) {
+      ps_room(13);
+      mp_ps_print_char(mp, ' ');
+      mp_ps_print_scaled(mp, ww);
+      mp_ps_print(mp, " vlw");
+    } else { 
+      ps_room(15);
+      mp_ps_print(mp, " 0 "); mp_ps_print_scaled(mp, ww);
+      mp_ps_print(mp, " dtransform truncate idtransform setlinewidth pop");
+    }
+  }
+  gs_width = ww;
+  gs_adj_wx = adj_wx;
+}
+
+@ @<Set |wx| and |wy| to the width and height of the bounding box for...@>=
+if ( (gr_right_x(pp)==gr_x_coord(pp)) && (gr_left_y(pp)==gr_y_coord(pp)) ) {
+  wx = abs(gr_left_x(pp) - gr_x_coord(pp));
+  wy = abs(gr_right_y(pp) - gr_y_coord(pp));
+} else {
+  wx = mp_pyth_add(mp, gr_left_x(pp)-gr_x_coord(pp), gr_right_x(pp)-gr_x_coord(pp));
+  wy = mp_pyth_add(mp, gr_left_y(pp)-gr_y_coord(pp), gr_right_y(pp)-gr_y_coord(pp));
+}
+
+@ The path is considered ``essentially horizontal'' if its range of
+$y$~coordinates is less than the $y$~range |wy| for the pen.  ``Essentially
+vertical'' paths are detected similarly.  This code ensures that no component
+of the pen transformation is more that |aspect_bound*(ww+1)|.
+
+@d aspect_bound 10 /* ``less important'' of |wx|, |wy| cannot exceed the other by
+    more than this factor */
+
+@d do_x_loc 1
+@d do_y_loc 2
+
+@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more...@>=
+tx=1; ty=1;
+if ( mp_gr_coord_rangeOK(path_p, do_y_loc, wy) ) tx=aspect_bound;
+else if ( mp_gr_coord_rangeOK(path_p, do_x_loc, wx) ) ty=aspect_bound;
+if ( wy / ty>=wx / tx ) { ww=wy; adj_wx=false; }
+else { ww=wx; adj_wx=true;  }
+
+@ This routine quickly tests if path |h| is ``essentially horizontal'' or
+``essentially vertical,'' where |zoff| is |x_loc(0)| or |y_loc(0)| and |dz| is
+allowable range for $x$ or~$y$.  We do not need and cannot afford a full
+bounding-box computation.
+
+@<Declarations@>=
+boolean mp_gr_coord_rangeOK (mp_knot *h, 
+                          small_number  zoff, scaled dz);
+
+@ @c
+boolean mp_gr_coord_rangeOK (mp_knot *h, 
+                          small_number  zoff, scaled dz) {
+  mp_knot *p; /* for scanning the path form |h| */
+  scaled zlo,zhi; /* coordinate range so far */
+  scaled z; /* coordinate currently being tested */
+  if (zoff==do_x_loc) {
+    zlo=gr_x_coord(h);
+    zhi=zlo;
+    p=h;
+    while ( gr_right_type(p)!=mp_endpoint ) {
+      z=gr_right_x(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      p=gr_next_knot(p);  z=gr_left_x(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      z=gr_x_coord(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      if ( p==h ) break;
+    }
+  } else {
+    zlo=gr_y_coord(h);
+    zhi=zlo;
+    p=h;
+    while ( gr_right_type(p)!=mp_endpoint ) {
+      z=gr_right_y(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      p=gr_next_knot(p); z=gr_left_y(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      z=gr_y_coord(p);
+      @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
+      if ( p==h ) break;
+    }
+  }
+  return true;
+}
+
+@ @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>=
+if ( z<zlo ) zlo=z;
+else if ( z>zhi ) zhi=z;
+if ( zhi-zlo>dz ) return false
+
+@ Filling with an elliptical pen is implemented via a combination of \&{stroke}
+and \&{fill} commands and a nontrivial dash pattern would interfere with this.
+@:stroke}{\&{stroke} command@>
+@:fill}{\&{fill} command@>
+Note that we don't use |delete_edge_ref| because |gs_dash_p| is not counted as
+a reference.
+
+@<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>=
+if ( gr_type(p)==mp_fill_code || gr_dash_p(p) == NULL) {
+  hh=NULL;
+} else { 
+  hh=gr_dash_p(p);
+  scf=mp_gr_get_pen_scale(mp, gr_pen_p((mp_fill_object *)p));
+  if ( scf==0 ) {
+    if ( gs_width==0 ) scf=hh->scale_field;  else hh=NULL;
+  } else { 
+    scf=mp_make_scaled(mp, gs_width,scf);
+    scf=mp_take_scaled(mp, scf, (hh == NULL ? unity : gr_dash_scale(p)));
+  }
+}
+if ( hh==NULL ) {
+  if ( gs_dash_p!=NULL || gs_dash_init_done == false) {
+    mp_ps_print_cmd(mp, " [] 0 setdash"," rd");
+    gs_dash_p=NULL;
+	gs_dash_init_done=true;
+  }
+} else if ( ! mp_gr_same_dashes(gs_dash_p,hh) ) {
+  @<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>;
+}
+
+@ @<Declarations@>=
+scaled mp_gr_get_pen_scale (MP mp, mp_knot *p) ;
+
+
+@ @c
+scaled mp_gr_get_pen_scale (MP mp, mp_knot *p) { 
+  return mp_sqrt_det(mp, 
+    gr_left_x(p)-gr_x_coord(p), gr_right_x(p)-gr_x_coord(p),
+    gr_left_y(p)-gr_y_coord(p), gr_right_y(p)-gr_y_coord(p));
+}
+
+
+@ The original code had a check here to ensure that the result from
+|mp_take_scaled| did not go out of bounds.
+
+@<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>=
+{ gs_dash_p=hh;
+  if ( (gr_dash_p(p)==NULL) || (hh==NULL) || (hh->array_field==NULL)) {
+    mp_ps_print_cmd(mp, " [] 0 setdash"," rd");
+  } else { 
+	int i;
+    ps_room(28);
+    mp_ps_print(mp, " [");
+    for (i=0; *(hh->array_field+i) != -1;i++) {
+      ps_room(13);
+      mp_ps_print_scaled(mp, *(hh->array_field+i)); 
+ 	  mp_ps_print_char(mp, ' ')	;
+    }
+    ps_room(22);
+    mp_ps_print(mp, "] ");
+    mp_ps_print_scaled(mp, hh->offset_field);
+    mp_ps_print_cmd(mp, " setdash"," sd");
+  }
+}
+
+@ @<Declarations@>=
+boolean mp_gr_same_dashes (mp_dash_object *h, mp_dash_object *hh) ;
+
+@ This function test if |h| and |hh| represent the same dash pattern.
+
+The |scale_field| is ignored in this test because it is not really
+a property of the PostScript format of a dash pattern.
+
+@c
+boolean mp_gr_same_dashes (mp_dash_object *h, mp_dash_object *hh) {
+  boolean ret=false;
+  int i = 0; 
+  if ( h==hh ) ret=true;
+  else if ( (h==NULL)||(hh==NULL) ) ret=false;
+  else if ( h->offset_field!=hh->offset_field ) ret=false;
+  else if ( h->array_field == hh->array_field) ret=true;
+  else if ( h->array_field == NULL || hh->array_field == NULL) ret=false;
+  else { @<Compare |dash_list(h)| and |dash_list(hh)|@>; }
+  return ret;
+}
+
+@ @<Compare |dash_list(h)| and |dash_list(hh)|@>=
+{
+  while (*(h->array_field+i)!=-1 && 
+	     *(hh->array_field+i)!=-1 &&
+	     *(h->array_field+i) == *(hh->array_field+i)) i++;
+  if (i>0) {
+    if (*(h->array_field+(i))==-1 && *(hh->array_field+(i)) == -1) 
+      ret=true;
+  }
+}
+
+@ When stroking a path with an elliptical pen, it is necessary to transform
+the coordinate system so that a unit circular pen will have the desired shape.
+To keep this transformation local, we enclose it in a
+$$\&{gsave}\ldots\&{grestore}$$
+block. Any translation component must be applied to the path being stroked
+while the rest of the transformation must apply only to the pen.
+If |fill_also=true|, the path is to be filled as well as stroked so we must
+insert commands to do this after giving the path.
+
+@<Declarations@>=
+void mp_gr_stroke_ellipse (MP mp,  mp_graphic_object *h, boolean fill_also) ;
+
+@ 
+@c void mp_gr_stroke_ellipse (MP mp,  mp_graphic_object *h, boolean fill_also) {
+  /* generate an elliptical pen stroke from object |h| */
+  scaled txx,txy,tyx,tyy; /* transformation parameters */
+  mp_knot *p; /* the pen to stroke with */
+  scaled d1,det; /* for tweaking transformation parameters */
+  integer s; /* also for tweaking transformation paramters */
+  boolean transformed; /* keeps track of whether gsave/grestore are needed */
+  transformed=false;
+  @<Use |pen_p(h)| to set the transformation parameters and give the initial
+    translation@>;
+  @<Tweak the transformation parameters so the transformation is nonsingular@>;
+  if (gr_type(h)==mp_fill_code) {
+    mp_gr_ps_path_out(mp, gr_path_p((mp_fill_object *)h));
+  } else {
+    mp_gr_ps_path_out(mp, gr_path_p((mp_stroked_object *)h));
+  }
+  if ( mp->internal[mp_procset]==0 ) {
+    if ( fill_also ) mp_ps_print_nl(mp, "gsave fill grestore");
+    @<Issue \ps\ commands to transform the coordinate system@>;
+    mp_ps_print(mp, " stroke");
+    if ( transformed ) mp_ps_print(mp, " grestore");
+  } else {
+    if ( fill_also ) mp_ps_print_nl(mp, "B"); else mp_ps_print_ln(mp);
+    if ( (txy!=0)||(tyx!=0) ) {
+      mp_ps_print(mp, " [");
+      mp_ps_pair_out(mp, txx,tyx);
+      mp_ps_pair_out(mp, txy,tyy);
+      mp_ps_print(mp, "0 0] t");
+    } else if ((txx!=unity)||(tyy!=unity) )  {
+      mp_ps_pair_out(mp,txx,tyy);
+      mp_ps_print(mp, " s");
+    };
+    mp_ps_print(mp, " S");
+    if ( transformed ) mp_ps_print(mp, " Q");
+  }
+  mp_ps_print_ln(mp);
+}
+
+@ @<Use |pen_p(h)| to set the transformation parameters and give the...@>=
+if (gr_type(h)==mp_fill_code) {
+  p=gr_pen_p((mp_fill_object *)h);
+} else {
+  p=gr_pen_p((mp_stroked_object *)h);
+}
+txx=gr_left_x(p);
+tyx=gr_left_y(p);
+txy=gr_right_x(p);
+tyy=gr_right_y(p);
+if ( (gr_x_coord(p)!=0)||(gr_y_coord(p)!=0) ) {
+  mp_ps_print_nl(mp, ""); 
+  mp_ps_print_cmd(mp, "gsave ","q ");
+  mp_ps_pair_out(mp, gr_x_coord(p), gr_y_coord(p));
+  mp_ps_print(mp, "translate ");
+  txx-=gr_x_coord(p);
+  tyx-=gr_y_coord(p);
+  txy-=gr_x_coord(p);
+  tyy-=gr_y_coord(p);
+  transformed=true;
+} else {
+  mp_ps_print_nl(mp, "");
+}
+@<Adjust the transformation to account for |gs_width| and output the
+  initial \&{gsave} if |transformed| should be |true|@>
+
+@ @<Adjust the transformation to account for |gs_width| and output the...@>=
+if ( gs_width!=unity ) {
+  if ( gs_width==0 ) { 
+    txx=unity; tyy=unity;
+  } else { 
+    txx=mp_make_scaled(mp, txx,gs_width);
+    txy=mp_make_scaled(mp, txy,gs_width);
+    tyx=mp_make_scaled(mp, tyx,gs_width);
+    tyy=mp_make_scaled(mp, tyy,gs_width);
+  };
+}
+if ( (txy!=0)||(tyx!=0)||(txx!=unity)||(tyy!=unity) ) {
+  if ( (! transformed) ){ 
+    mp_ps_print_cmd(mp, "gsave ","q ");
+    transformed=true;
+  }
+}
+
+@ @<Issue \ps\ commands to transform the coordinate system@>=
+if ( (txy!=0)||(tyx!=0) ){ 
+  mp_ps_print_ln(mp);
+  mp_ps_print_char(mp, '[');
+  mp_ps_pair_out(mp, txx,tyx);
+  mp_ps_pair_out(mp, txy,tyy);
+  mp_ps_print(mp, "0 0] concat");
+} else if ( (txx!=unity)||(tyy!=unity) ){ 
+  mp_ps_print_ln(mp);
+  mp_ps_pair_out(mp, txx,tyy);
+  mp_ps_print(mp, "scale");
+}
+
+@ The \ps\ interpreter will probably abort if it encounters a singular
+transformation matrix.  The determinant must be large enough to ensure that
+the printed representation will be nonsingular.  Since the printed
+representation is always within $2^{-17}$ of the internal |scaled| value, the
+total error is at most $4T_{\rm max}2^{-17}$, where $T_{\rm max}$ is a bound on
+the magnitudes of |txx/65536|, |txy/65536|, etc.
+
+The |aspect_bound*(gs_width+1)| bound on the components of the pen
+transformation allows $T_{\rm max}$ to be at most |2*aspect_bound|.
+
+@<Tweak the transformation parameters so the transformation is nonsingular@>=
+det=mp_take_scaled(mp, txx,tyy) - mp_take_scaled(mp, txy,tyx);
+d1=4*aspect_bound+1;
+if ( abs(det)<d1 ) { 
+  if ( det>=0 ) { d1=d1-det; s=1;  }
+  else { d1=-d1-det; s=-1;  };
+  d1=d1*unity;
+  if ( abs(txx)+abs(tyy)>=abs(txy)+abs(tyy) ) {
+    if ( abs(txx)>abs(tyy) ) tyy=tyy+(d1+s*abs(txx)) / txx;
+    else txx=txx+(d1+s*abs(tyy)) / tyy;
+  } else {
+    if ( abs(txy)>abs(tyx) ) tyx=tyx+(d1+s*abs(txy)) / txy;
+    else txy=txy+(d1+s*abs(tyx)) / tyx;
+  }
+}
+
+@ Here is a simple routine that just fills a cycle.
+
+@<Declarations@>=
+void mp_gr_ps_fill_out (MP mp, mp_knot *p);
+
+@ @c
+void mp_gr_ps_fill_out (MP mp, mp_knot *p) { /* fill cyclic path~|p| */
+  mp_gr_ps_path_out(mp, p);
+  mp_ps_print_cmd(mp, " fill"," F");
+  mp_ps_print_ln(mp);
+}
+
+@ A text node may specify an arbitrary transformation but the usual case
+involves only shifting, scaling, and occasionally rotation.  The purpose
+of |choose_scale| is to select a scale factor so that the remaining
+transformation is as ``nice'' as possible.  The definition of ``nice''
+is somewhat arbitrary but shifting and $90^\circ$ rotation are especially
+nice because they work out well for bitmap fonts.  The code here selects
+a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the
+non-shifting part of the transformation matrix.  It is careful to avoid
+additions that might cause undetected overflow.
+
+@<Declarations@>=
+scaled mp_gr_choose_scale (MP mp, mp_graphic_object *p) ;
+
+@ @c scaled mp_gr_choose_scale (MP mp, mp_graphic_object *p) {
+  /* |p| should point to a text node */
+  scaled a,b,c,d,ad,bc; /* temporary values */
+  a=gr_txx_val(p);
+  b=gr_txy_val(p);
+  c=gr_tyx_val(p);
+  d=gr_tyy_val(p);
+  if ( a<0 ) negate(a);
+  if ( b<0 ) negate(b);
+  if ( c<0 ) negate(c);
+  if ( d<0 ) negate(d);
+  ad=half(a-d);
+  bc=half(b-c);
+  return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc));
+}
+
+@ The potential overflow here is caused by the fact the returned value
+has to fit in a |name_type|, which is a quarterword. 
+
+@d fscale_tolerance 65 /* that's $.001\times2^{16}$ */
+
+@<Declarations@>=
+quarterword mp_size_index (MP mp, font_number f, scaled s) ;
+
+@ @c
+quarterword mp_size_index (MP mp, font_number f, scaled s) {
+  pointer p,q; /* the previous and current font size nodes */
+  quarterword i; /* the size index for |q| */
+  q=mp->font_sizes[f];
+  i=0;
+  while ( q!=null ) {
+    if ( abs(s-sc_factor(q))<=fscale_tolerance ) 
+      return i;
+    else 
+      { p=q; q=link(q); incr(i); };
+    if ( i==max_quarterword )
+      mp_overflow(mp, "sizes per font",max_quarterword);
+@:MetaPost capacity exceeded sizes per font}{\quad sizes per font@>
+  }
+  q=mp_get_node(mp, font_size_size);
+  sc_factor(q)=s;
+  if ( i==0 ) mp->font_sizes[f]=q;  else link(p)=q;
+  return i;
+}
+
+@ @<Declarations@>=
+scaled mp_indexed_size (MP mp,font_number f, quarterword j);
+
+@ @c
+scaled mp_indexed_size (MP mp,font_number f, quarterword j) {
+  pointer p; /* a font size node */
+  quarterword i; /* the size index for |p| */
+  p=mp->font_sizes[f];
+  i=0;
+  if ( p==null ) mp_confusion(mp, "size");
+  while ( (i!=j) ) { 
+    incr(i); p=link(p);
+    if ( p==null ) mp_confusion(mp, "size");
+  }
+  return sc_factor(p);
+}
+
+@ @<Declarations@>=
+void mp_clear_sizes (MP mp) ;
+
+@ @c void mp_clear_sizes (MP mp) {
+  font_number f;  /* the font whose size list is being cleared */
+  pointer p;  /* current font size nodes */
+  for (f=null_font+1;f<=mp->last_fnum;f++) {
+    while ( mp->font_sizes[f]!=null ) {
+      p=mp->font_sizes[f];
+      mp->font_sizes[f]=link(p);
+      mp_free_node(mp, p,font_size_size);
+    }
+  }
+}
+
+@ A text node may specify an arbitrary transformation but the usual case
+involves only shifting, scaling, and occasionally rotation.  The purpose
+of |choose_scale| is to select a scale factor so that the remaining
+transformation is as ``nice'' as possible.  The definition of ``nice''
+is somewhat arbitrary but shifting and $90^\circ$ rotation are especially
+nice because they work out well for bitmap fonts.  The code here selects
+a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the
+non-shifting part of the transformation matrix.  It is careful to avoid
+additions that might cause undetected overflow.
+
+@<Declare the \ps\ output procedures@>=
+scaled mp_choose_scale (MP mp, mp_graphic_object *p) ;
+
+@ @c scaled mp_choose_scale (MP mp, mp_graphic_object *p) {
+  /* |p| should point to a text node */
+  scaled a,b,c,d,ad,bc; /* temporary values */
+  a=gr_txx_val(p);
+  b=gr_txy_val(p);
+  c=gr_tyx_val(p);
+  d=gr_tyy_val(p);
+  if ( (a<0) ) negate(a);
+  if ( (b<0) ) negate(b);
+  if ( (c<0) ) negate(c);
+  if ( (d<0) ) negate(d);
+  ad=half(a-d);
+  bc=half(b-c);
+  return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc));
+}
+
+@ There may be many sizes of one font and we need to keep track of the
+characters used for each size.  This is done by keeping a linked list of
+sizes for each font with a counter in each text node giving the appropriate
+position in the size list for its font.
+
+@d font_size_size 2 /* size of a font size node */
+
+
+@ @<Declarations@>=
+void mp_apply_mark_string_chars(MP mp, mp_edge_object *h, int next_size);
+
+@ @c
+void mp_apply_mark_string_chars(MP mp, mp_edge_object *h, int next_size) {
+  mp_graphic_object * p;
+  p=h->body;
+  while ( p!= NULL ) {
+    if ( gr_type(p)==mp_text_code ) {
+      if ( gr_font_n(p)!=null_font ) { 
+        if ( gr_name_type(p)==next_size )
+          mp_mark_string_chars(mp, gr_font_n(p),gr_text_p(p));
+      }
+    }
+    p=gr_link(p);
+  }
+}
+
+@ @<Unmark all marked characters@>=
+for (f=null_font+1;f<=mp->last_fnum;f++) {
+  if ( mp->font_sizes[f]!=null ) {
+    mp_unmark_font(mp, f);
+    mp->font_sizes[f]=null;
+  }
+}
+
+@ @<Scan all the text nodes and mark the used ...@>=
+p=hh->body;
+while ( p!=null ) {
+  if ( gr_type(p)==mp_text_code ) {
+    f = gr_font_n(p);
+    if (f!=null_font ) {
+      switch (prologues) {
+      case 2:
+      case 3:
+        mp->font_sizes[f] = mp_void;
+        mp_mark_string_chars(mp, f, gr_text_p(p));
+   	    if (mp_has_fm_entry(mp,f,NULL) ) {
+          if (mp->font_enc_name[f]==NULL )
+            mp->font_enc_name[f] = mp_fm_encoding_name(mp,f);
+          mp->font_ps_name[f] = mp_fm_font_name(mp,f);
+        }
+        break;
+      case 1:
+        mp->font_sizes[f]=mp_void;
+        break;
+      default: 
+        gr_name_type(p)=mp_size_index(mp, f,mp_choose_scale(mp, p));
+        if ( gr_name_type(p)==0 )
+          mp_mark_string_chars(mp, f, gr_text_p(p));
+      }
+    }
+  }
+  p=gr_link(p);
+}
+
+
+@ 
+@d pen_is_elliptical(A) ((A)==gr_next_knot((A)))
+
+@<Exported function headers@>=
+void mp_gr_ship_out (mp_edge_object *hh, int prologues, int procset) ;
+
+@ @c 
+void mp_gr_ship_out (mp_edge_object *hh, int prologues, int procset) {
+  mp_graphic_object *p;
+  scaled ds,scf; /* design size and scale factor for a text node */
+  font_number f; /* for loops over fonts while (un)marking characters */
+  boolean transformed; /* is the coordinate system being transformed? */
+  MP mp = hh->_parent;
+  if (mp->history >= mp_fatal_error_stop ) return;
+  if (prologues<0) 
+	prologues = (mp->internal[mp_prologues]>>16);
+  if (procset<0) 
+	procset = (mp->internal[mp_procset]>>16);
+  mp_open_output_file(mp);
+  mp_print_initial_comment(mp, hh, prologues);
+  p = hh->body;
+  @<Unmark all marked characters@>;
+  if ( prologues==2 || prologues==3 ) {
+    mp_reload_encodings(mp);
+  }
+  @<Scan all the text nodes and mark the used characters@>;
+  if ( prologues==2 || prologues==3 ) {
+    mp_print_improved_prologue(mp, hh, prologues, procset);
+  } else {
+    mp_print_prologue(mp, hh, prologues, procset);
+  }
+  mp_gs_unknown_graphics_state(mp, 0);
+  p = hh->body;
+  while ( p!=NULL ) { 
+    if ( gr_has_color(p) ) {
+      @<Write |pre_script| of |p|@>;
+    }
+    mp_gr_fix_graphics_state(mp, p);
+    switch (gr_type(p)) {
+    case mp_fill_code: 
+      if ( gr_pen_p((mp_fill_object *)p)==NULL ) {
+        mp_gr_ps_fill_out(mp, gr_path_p((mp_fill_object *)p));
+      } else if ( pen_is_elliptical(gr_pen_p((mp_fill_object *)p)) )  {
+        mp_gr_stroke_ellipse(mp, p,true);
+      } else { 
+        mp_gr_ps_fill_out(mp, gr_path_p((mp_fill_object *)p));
+        mp_gr_ps_fill_out(mp, gr_htap_p(p));
+      }
+      if ( gr_post_script((mp_fill_object *)p)!=NULL ) {
+         mp_ps_print_nl (mp, gr_post_script((mp_fill_object *)p)); 
+	     mp_ps_print_ln(mp);
+      }
+      break;
+    case mp_stroked_code:
+      if ( pen_is_elliptical(gr_pen_p((mp_stroked_object *)p)) ) 
+	    mp_gr_stroke_ellipse(mp, p,false);
+      else { 
+        mp_gr_ps_fill_out(mp, gr_path_p((mp_stroked_object *)p));
+      }
+      if ( gr_post_script((mp_stroked_object *)p)!=NULL ) {
+        mp_ps_print_nl (mp, gr_post_script((mp_stroked_object *)p)); 
+        mp_ps_print_ln(mp);
+      }
+      break;
+    case mp_text_code: 
+      if ( (gr_font_n(p)!=null_font) && (strlen(gr_text_p(p))>0) ) {
+        if ( prologues>0 )
+          scf=mp_gr_choose_scale(mp, p);
+        else 
+          scf=mp_indexed_size(mp, gr_font_n(p), gr_name_type(p));
+        @<Shift or transform as necessary before outputting text node~|p| at scale
+          factor~|scf|; set |transformed:=true| if the original transformation must
+          be restored@>;
+        mp_ps_string_out(mp, gr_text_p(p));
+        mp_ps_name_out(mp, mp->font_name[gr_font_n(p)],false);
+        @<Print the size information and \ps\ commands for text node~|p|@>;
+        mp_ps_print_ln(mp);
+      }
+      if ( gr_post_script((mp_text_object *)p)!=NULL ) {
+        mp_ps_print_nl (mp, gr_post_script((mp_text_object *)p)); mp_ps_print_ln(mp);
+      }
+      break;
+    case mp_start_clip_code: 
+      mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "gsave ","q ");
+      mp_gr_ps_path_out(mp, gr_path_p((mp_clip_object *)p));
+      mp_ps_print_cmd(mp, " clip"," W");
+      mp_ps_print_ln(mp);
+      if ( mp->internal[mp_restore_clip_color]>0 )
+        mp_gs_unknown_graphics_state(mp, 1);
+      break;
+    case mp_stop_clip_code: 
+      mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "grestore","Q");
+      mp_ps_print_ln(mp);
+      if ( mp->internal[mp_restore_clip_color]>0 )
+        mp_gs_unknown_graphics_state(mp, 2);
+      else
+        mp_gs_unknown_graphics_state(mp, -1);
+      break;
+    case mp_start_bounds_code:
+    case mp_stop_bounds_code:
+	  break;
+    case mp_special_code: 
+      mp_ps_print_nl (mp, gr_pre_script((mp_special_object *)p)); 
+ 	  mp_ps_print_ln (mp);
+      break;
+    } /* all cases are enumerated */
+    p=gr_link(p);
+  }
+  mp_ps_print_cmd(mp, "showpage","P"); mp_ps_print_ln(mp);
+  mp_ps_print(mp, "%%EOF"); mp_ps_print_ln(mp);
+  (mp->close_file)(mp,mp->ps_file);
+  if ( prologues<=0 ) 
+    mp_clear_sizes(mp);
+}
+
+@ 
+@d do_write_prescript(a,b) {
+  if ( (gr_pre_script((b *)a))!=NULL ) {
+    mp_ps_print_nl (mp, gr_pre_script((b *)a)); 
+    mp_ps_print_ln(mp);
+  }
+}
+
+@<Write |pre_script| of |p|@>=
+{
+  if (gr_type(p)==mp_fill_code) { do_write_prescript(p,mp_fill_object); }
+  else if (gr_type(p)==mp_stroked_code) { do_write_prescript(p,mp_stroked_object); }
+  else if (gr_type(p)==mp_text_code) { do_write_prescript(p,mp_text_object); }
+}
+
+@ The envelope of a cyclic path~|q| could be computed by calling
+|make_envelope| once for |q| and once for its reversal.  We don't do this
+because it would fail color regions that are covered by the pen regardless
+of where it is placed on~|q|.
+
+@<Break the cycle and set |t:=1| if path |q| is cyclic@>=
+if ( gr_left_type(q)!=mp_endpoint ) { 
+  gr_left_type(mp_gr_insert_knot(mp, q,gr_x_coord(q),gr_y_coord(q)))=mp_endpoint;
+  gr_right_type(q)=mp_endpoint;
+  q=gr_next_knot(q);
+  t=1;
+}
+
+@ @<Print the size information and \ps\ commands for text node~|p|@>=
+ps_room(18);
+mp_ps_print_char(mp, ' ');
+ds=(mp->font_dsize[gr_font_n(p)]+8) / 16;
+mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,scf));
+mp_ps_print(mp, " fshow");
+if ( transformed ) 
+   mp_ps_print_cmd(mp, " grestore"," Q")
+
+
+
+@ @<Shift or transform as necessary before outputting text node~|p| at...@>=
+transformed=(gr_txx_val(p)!=scf)||(gr_tyy_val(p)!=scf)||
+            (gr_txy_val(p)!=0)||(gr_tyx_val(p)!=0);
+if ( transformed ) {
+  mp_ps_print_cmd(mp, "gsave [", "q [");
+  mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txx_val(p),scf),
+                     mp_make_scaled(mp, gr_tyx_val(p),scf));
+  mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txy_val(p),scf),
+                     mp_make_scaled(mp, gr_tyy_val(p),scf));
+  mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p));
+  mp_ps_print_cmd(mp, "] concat 0 0 moveto","] t 0 0 m");
+} else { 
+  mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p));
+  mp_ps_print_cmd(mp, "moveto","m");
+}
+mp_ps_print_ln(mp)
+
+
+@ @<Exported function headers@>=
+void mp_gr_toss_objects ( mp_edge_object *hh) ;
+void mp_gr_toss_object (mp_graphic_object *p) ;
+
+@ @c
+void mp_gr_toss_object (mp_graphic_object *p) {
+    mp_fill_object *tf;
+    mp_stroked_object *ts;
+    mp_text_object *tt;
+    switch (gr_type(p)) {	
+    case mp_fill_code: 
+      tf = (mp_fill_object *)p;
+      mp_xfree(gr_pre_script(tf));
+      mp_xfree(gr_post_script(tf));
+      mp_gr_toss_knot_list(mp,gr_pen_p(tf));
+      mp_gr_toss_knot_list(mp,gr_path_p(tf));
+      mp_gr_toss_knot_list(mp,gr_htap_p(p));
+	  break;
+    case mp_stroked_code:
+      ts = (mp_stroked_object *)p;
+      mp_xfree(gr_pre_script(ts));
+      mp_xfree(gr_post_script(ts));
+      mp_gr_toss_knot_list(mp,gr_pen_p(ts));
+      mp_gr_toss_knot_list(mp,gr_path_p(ts));
+      if (gr_dash_p(p)!=NULL) 
+        mp_gr_toss_dashes   (mp,gr_dash_p(p));
+      break;
+    case mp_text_code: 
+      tt = (mp_text_object *)p;
+      mp_xfree(gr_pre_script(tt));
+      mp_xfree(gr_post_script(tt));
+      mp_xfree(gr_text_p(p));
+      mp_xfree(gr_font_name(p));
+      break;
+    case mp_start_clip_code: 
+      mp_gr_toss_knot_list(mp,gr_path_p((mp_clip_object *)p));
+      break;
+    case mp_start_bounds_code:
+      mp_gr_toss_knot_list(mp,gr_path_p((mp_bounds_object *)p));
+      break;
+    case mp_stop_clip_code: 
+    case mp_stop_bounds_code:
+	  break;
+    case mp_special_code: 
+      mp_xfree(gr_pre_script((mp_special_object *)p));
+	  break;
+    } /* all cases are enumerated */
+    mp_xfree(p);
+}
+
+
+@ @c
+void mp_gr_toss_objects (mp_edge_object *hh) {
+  mp_graphic_object *p, *q;
+  p = hh->body;
+  while ( p!=NULL ) { 
+    q = gr_link(p);
+    mp_gr_toss_object(p);
+    p=q;
+  }
+  mp_xfree(hh);
+}
+
+@ @<Exported function headers@>=
+mp_graphic_object *mp_gr_copy_object (MP mp, mp_graphic_object *p) ;
+
+@ @c
+mp_graphic_object * 
+mp_gr_copy_object (MP mp, mp_graphic_object *p) {
+  mp_fill_object *tf;
+  mp_stroked_object *ts;
+  mp_text_object *tt;
+  mp_clip_object *tc;
+  mp_bounds_object *tb;
+  mp_special_object *tp;
+  mp_graphic_object *q = NULL;
+  switch (gr_type(p)) {	
+  case mp_fill_code: 
+    tf = (mp_fill_object *)mp_new_graphic_object(mp, mp_fill_code);
+    gr_pre_script(tf)  = mp_xstrdup(mp, gr_pre_script((mp_fill_object *)p));
+    gr_post_script(tf) = mp_xstrdup(mp, gr_post_script((mp_fill_object *)p));
+    gr_path_p(tf)      = mp_gr_copy_path(mp,gr_path_p((mp_fill_object *)p));
+    gr_htap_p(tf)      = mp_gr_copy_path(mp,gr_htap_p(p));
+    gr_pen_p(tf)       = mp_gr_copy_path(mp,gr_pen_p((mp_fill_object *)p));
+    q = (mp_graphic_object *)tf;
+    break;
+  case mp_stroked_code:
+    ts = (mp_stroked_object *)mp_new_graphic_object(mp, mp_stroked_code);
+    gr_pre_script(ts)  = mp_xstrdup(mp, gr_pre_script((mp_stroked_object *)p));
+    gr_post_script(ts) = mp_xstrdup(mp, gr_post_script((mp_stroked_object *)p));
+    gr_path_p(ts)      = mp_gr_copy_path(mp,gr_path_p((mp_stroked_object *)p));
+    gr_pen_p(ts)       = mp_gr_copy_path(mp,gr_pen_p((mp_stroked_object *)p));
+    gr_dash_p(ts)      = mp_gr_copy_dashes(mp,gr_dash_p(p));
+    q = (mp_graphic_object *)ts;
+    break;
+  case mp_text_code: 
+    tt = (mp_text_object *)mp_new_graphic_object(mp, mp_text_code);
+    gr_pre_script(tt)  = mp_xstrdup(mp, gr_pre_script((mp_text_object *)p));
+    gr_post_script(tt) = mp_xstrdup(mp, gr_post_script((mp_text_object *)p));
+    gr_text_p(tt)      = mp_xstrdup(mp, gr_text_p(p));
+    gr_font_name(tt)   = mp_xstrdup(mp, gr_font_name(p));
+    q = (mp_graphic_object *)tt;
+    break;
+  case mp_start_clip_code: 
+    tc = (mp_clip_object *)mp_new_graphic_object(mp, mp_start_clip_code);
+    gr_path_p(tc)      = mp_gr_copy_path(mp,gr_path_p((mp_clip_object *)p));
+    q = (mp_graphic_object *)tc;
+    break;
+  case mp_start_bounds_code:
+    tb = (mp_bounds_object *)mp_new_graphic_object(mp, mp_start_bounds_code);
+    gr_path_p(tb)      = mp_gr_copy_path(mp,gr_path_p((mp_bounds_object *)p));
+    q = (mp_graphic_object *)tb;
+    break;
+  case mp_special_code: 
+    tp = (mp_special_object *)mp_new_graphic_object(mp, mp_special_code);
+    gr_pre_script(tp)  = mp_xstrdup(mp, gr_pre_script((mp_special_object *)p));
+    q = (mp_graphic_object *)tp;
+    break;
+  case mp_stop_clip_code: 
+    q = mp_new_graphic_object(mp, mp_stop_clip_code);
+    break;
+  case mp_stop_bounds_code:
+    q = mp_new_graphic_object(mp, mp_stop_bounds_code);
+    break;
+  } /* all cases are enumerated */
+  return q;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/lua/texluac.c b/Build/source/texk/web2c/luatexdir/lua/texluac.c
new file mode 100644
index 00000000000..4bc13458d13
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/lua/texluac.c
@@ -0,0 +1,199 @@
+/*
+** $Id: texluac.c 1013 2008-02-14 00:09:02Z oneiros $
+** Lua compiler (saves bytecodes to files; also list bytecodes)
+** See Copyright Notice in lua.h
+*/
+
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define luac_c
+#define LUA_CORE
+
+#include <../lua51/lua.h>
+#include <../lua51/lauxlib.h>
+
+#include <../lua51/ldo.h>
+#include <../lua51/lfunc.h>
+#include <../lua51/lmem.h>
+#include <../lua51/lobject.h>
+#include <../lua51/lopcodes.h>
+#include <../lua51/lstring.h>
+#include <../lua51/lundump.h>
+
+#define PROGNAME	"texluac"		/* default program name */
+#define	OUTPUT		PROGNAME ".out"	/* default output file */
+
+static int dumping=1;			/* dump bytecodes? */
+static int stripping=0;			/* strip debug information? */
+static char Output[]={ OUTPUT };	/* default output file name */
+static const char* output=Output;	/* actual output file name */
+static const char* progname=PROGNAME;	/* actual program name */
+
+static void fatal(const char* message)
+{
+ fprintf(stderr,"%s: %s\n",progname,message);
+ exit(EXIT_FAILURE);
+}
+
+static void cannot(const char* what)
+{
+ fprintf(stderr,"%s: cannot %s %s: %s\n",progname,what,output,strerror(errno));
+ exit(EXIT_FAILURE);
+}
+
+static void usage(const char* message)
+{
+ if (*message=='-')
+  fprintf(stderr,"%s: unrecognized option " LUA_QS "\n",progname,message);
+ else
+  fprintf(stderr,"%s: %s\n",progname,message);
+ fprintf(stderr,
+ "usage: %s [options] [filenames].\n"
+ "Available options are:\n"
+ "  -        process stdin\n"
+ "  -o name  output to file " LUA_QL("name") " (default is \"%s\")\n"
+ "  -p       parse only\n"
+ "  -s       strip debug information\n"
+ "  -v       show version information\n"
+ "  --       stop handling options\n",
+ progname,Output);
+ exit(EXIT_FAILURE);
+}
+
+#define	IS(s)	(strcmp(argv[i],s)==0)
+
+static int doargs(int argc, char* argv[])
+{
+ int i;
+ int version=0;
+ if (argv[0]!=NULL && *argv[0]!=0) progname=argv[0];
+ for (i=1; i<argc; i++)
+ {
+  if (*argv[i]!='-')			/* end of options; keep it */
+   break;
+  else if (IS("--"))			/* end of options; skip it */
+  {
+   ++i;
+   if (version) ++version;
+   break;
+  }
+  else if (IS("-"))			/* end of options; use stdin */
+   break;
+  else if (IS("-o"))			/* output file */
+  {
+   output=argv[++i];
+   if (output==NULL || *output==0) usage(LUA_QL("-o") " needs argument");
+   if (IS("-")) output=NULL;
+  }
+  else if (IS("-p"))			/* parse only */
+   dumping=0;
+  else if (IS("-s"))			/* strip debug information */
+   stripping=1;
+  else if (IS("-v"))			/* show version */
+   ++version;
+  else if (IS("--luaconly"))	/* ignore */
+	;
+  else if (IS("--luac"))	/* ignore */
+	;
+  else					/* unknown option */
+   usage(argv[i]);
+ }
+ if (i==argc && (!dumping))
+ {
+  dumping=0;
+  argv[--i]=Output;
+ }
+ if (version)
+ {
+  printf("%s  %s\n",LUA_RELEASE,LUA_COPYRIGHT);
+  if (version==argc-1) exit(EXIT_SUCCESS);
+ }
+ return i;
+}
+
+#define toproto(L,i) (clvalue(L->top+(i))->l.p)
+
+static const Proto* combine(lua_State* L, int n)
+{
+ if (n==1)
+  return toproto(L,-1);
+ else
+ {
+  int i,pc;
+  Proto* f=luaF_newproto(L);
+  setptvalue2s(L,L->top,f); incr_top(L);
+  f->source=luaS_newliteral(L,"=(" PROGNAME ")");
+  f->maxstacksize=1;
+  pc=2*n+1;
+  f->code=luaM_newvector(L,pc,Instruction);
+  f->sizecode=pc;
+  f->p=luaM_newvector(L,n,Proto*);
+  f->sizep=n;
+  pc=0;
+  for (i=0; i<n; i++)
+  {
+   f->p[i]=toproto(L,i-n-1);
+   f->code[pc++]=CREATE_ABx(OP_CLOSURE,0,i);
+   f->code[pc++]=CREATE_ABC(OP_CALL,0,1,1);
+  }
+  f->code[pc++]=CREATE_ABC(OP_RETURN,0,1,0);
+  return f;
+ }
+}
+
+static int writer(lua_State* L, const void* p, size_t size, void* u)
+{
+ UNUSED(L);
+ return (fwrite(p,size,1,(FILE*)u)!=1) && (size!=0);
+}
+
+struct Smain {
+ int argc;
+ char** argv;
+};
+
+static int pmain(lua_State* L)
+{
+ struct Smain* s = (struct Smain*)lua_touserdata(L, 1);
+ int argc=s->argc;
+ char** argv=s->argv;
+ const Proto* f;
+ int i;
+ if (!lua_checkstack(L,argc)) fatal("too many input files");
+ for (i=0; i<argc; i++)
+ {
+  const char* filename=IS("-") ? NULL : argv[i];
+  if (luaL_loadfile(L,filename)!=0) fatal(lua_tostring(L,-1));
+ }
+ f=combine(L,argc);
+ if (dumping)
+ {
+  FILE* D= (output==NULL) ? stdout : fopen(output,"wb");
+  if (D==NULL) cannot("open");
+  lua_lock(L);
+  luaU_dump(L,f,writer,D,stripping);
+  lua_unlock(L);
+  if (ferror(D)) cannot("write");
+  if (fclose(D)) cannot("close");
+ }
+ return 0;
+}
+
+int luac_main(int argc, char* argv[])
+{
+ lua_State* L;
+ struct Smain s;
+ int i=doargs(argc,argv);
+ argc-=i; argv+=i;
+ if (argc<=0) usage("no input files given");
+ L=lua_open();
+ if (L==NULL) fatal("not enough memory for state");
+ s.argc=argc;
+ s.argv=argv;
+ if (lua_cpcall(L,pmain,&s)!=0) fatal(lua_tostring(L,-1));
+ lua_close(L);
+ return EXIT_SUCCESS;
+}
diff --git a/Build/source/texk/web2c/luatexdir/luatangle.ch b/Build/source/texk/web2c/luatexdir/luatangle.ch
new file mode 100644
index 00000000000..578238d722a
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatangle.ch
@@ -0,0 +1,492 @@
+% otangle.ch: web2c changes to file tangle.ch
+% 
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tangle.ch.
+%
+% otangle.ch for C compilation with web2c.
+%
+%  10/9/82 (HT) Original version
+%  11/29   (HT) New version, with conversion to lowercase handled properly
+%               Also, new control sequence:
+%                       @=...text...@>   Put ...text... verbatim on a line
+%                                        by itself in the Pascal output.
+%                                        (argument must fit on one line)
+%               This control sequence facilitates putting #include "gcons.h"
+%               (for example) in files meant for the pc compiler.
+%               Also, changed command line usage, so that the absence of a
+%               change file implies no change file, rather than one with the
+%               same name as the web file, with .ch at the end.
+%  1/15/83 (HT) Changed to work with version 1.2, which incorporates the
+%               above change (though unbundling the output line breaking),
+%               so mainly had to remove stuff.
+%  2/17    (HT) Fixed bug that caused 0-9 in identifiers to be converted to
+%               Q-Y on output.
+%  3/18    (HT) Brought up to work with Version 1.5.  Added -r command line
+%               flag to cause a .rpl file to be written with all the lines
+%               of the .web file that were replaced because of the .ch file
+%               (useful for comparing with previous .rpl files, to see if a
+%               change file will still work with a new version of a .web file)
+%               Also, made it write a newline just before exit.
+%  4/12    (PC) Merged with Pavel's version, including adding a call to exit()
+%               at the end depending upon the value of history.
+%  4/16    (PC) Brought up to date with version 1.5 released April, 1983.
+%  6/28   (HWT) Brought up to date with version 1.7 released June, 1983.
+%               With new change file format, the -r option is now unnecessary.
+%  7/17   (HWT) Brought up to date with version 2.0 released July, 1983.
+% 12/18/83 (ETM) Brought up to date with version 2.5 released November, 1983.
+% 11/07/84 (ETM) Brought up to date with version 2.6.
+% 12/15/85 (ETM) Brought up to date with version 2.8.
+% 03/07/88 (ETM) Converted for use with WEB2C
+% 01/02/89 (PAM) Cosmetic upgrade to version 2.9
+% 11/30/89 (KB)  Version 4.
+% (more recent changes in the ChangeLog)
+
+@x [0] Print only changes.
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for C}
+@z
+
+@x [?] Define and call parse_arguments.
+procedure initialize;
+  var @<Local variables for initialization@>@/
+  begin @<Set initial values@>@/
+@y
+@<Define |parse_arguments|@>
+procedure initialize;
+  var @<Local variables for initialization@>@/
+  begin
+    kpse_set_progname (argv[0]);
+    parse_arguments;
+    @<Set initial values@>@/
+@z
+
+@x [8] Constants: increase id lengths, for TeX--XeT and tex2pdf.
+@!buf_size=100; {maximum length of input line}
+@y
+@!buf_size=3000; {maximum length of input line}
+@z
+@x
+@!max_names=10239; {number of identifiers, strings, module names;
+  must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@y
+@!max_names=10239; {number of identifiers, strings, module names;
+  must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@z
+
+@x
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+  not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+  {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+@y
+@!stack_size=100; {number of simultaneous levels of macro expansion}
+@!max_id_length=64; {long identifiers are chopped to this length, which must
+  not exceed |line_length|}
+@!unambig_length=64; {identifiers must be unique if chopped to this length}
+@z
+
+% [??] The text_char type is used as an array index into xord.  The
+% default type `char' produces signed integers, which are bad array
+% indices in C.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x [17] enable maximum character set
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+for i:=@'200 to @'377 do xchr[i]:=chr(i);
+@z
+
+@x [20] terminal output: use standard i/o
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@y
+@d term_out==stdout
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@z
+
+@x
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+@y
+@z
+
+@x [21] init terminal
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal.
+@^system dependencies@>
+
+@<Set init...@>=
+ {Nothing need be done for C.}
+@z
+
+@x [22] flush terminal buffer
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == fflush(term_out) {empty the terminal output buffer}
+@z
+
+@x [24] open input files
+begin reset(web_file); reset(change_file);
+@y
+begin reset(web_file, web_name);
+if chg_name then reset(change_file, chg_name);
+@z
+
+@x [26] Open output files (except for the pool file).
+rewrite(Pascal_file); rewrite(pool);
+@y
+rewrite (Pascal_file, pascal_name);
+@z
+
+@x [28] Fix f^.
+    begin buffer[limit]:=xord[f^]; get(f);
+    incr(limit);
+    if buffer[limit-1]<>" " then final_limit:=limit;
+    if limit=buf_size then
+      begin while not eoln(f) do get(f);
+@y
+    begin buffer[limit]:=xord[getc(f)];
+    incr(limit);
+    if buffer[limit-1]<>" " then final_limit:=limit;
+    if limit=buf_size then
+      begin while not eoln(f) do vgetc(f);
+@z
+
+@x [??] Fix `jump_out'.
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+  end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+@y
+@d jump_out==uexit(1)
+@d fatal_error(#)==begin new_line; write(stderr, #); 
+     error; mark_fatal; uexit(1);
+  end
+@z
+
+@x [38] Provide for a larger `byte_mem' and `tok_mem'. Extra capacity:
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@d zz=5 {we multiply the token capacity by approximately this amount}
+@z
+
+@x [58] Case smashing options/strict checking.
+  begin if buffer[i]<>"_" then
+    begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+    else chopped_id[s]:=buffer[i];
+@y
+  begin if (buffer[i]<>"_") or (allow_underlines) then
+    begin chopped_id[s]:=buffer[i];
+@z
+
+@x [63] Case smashing options/strict checking.
+  if c<>"_" then
+    begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+@y
+  if c<>"_" or (allow_underlines) then
+    begin
+@z
+
+@x [64] Delayed pool file opening.
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+  equiv[p]:=buffer[id_first+1]+1073741824
+else  begin equiv[p]:=string_ptr+1073741824;
+  l:=l-double_chars-1;
+@y
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+  equiv[p]:=buffer[id_first+1]+1073741824
+else  begin
+  {Avoid creating empty pool files.}
+  if string_ptr = 2097152 then begin
+    {Change |".web"| to |".pool"| and use the current directory.}
+    pool_name := basename_change_suffix (web_name, '.web', '.pool');
+    rewrite (pool, pool_name);
+  end;
+  equiv[p]:=string_ptr+1073741824;
+  l:=l-double_chars-1;
+@z
+
+@x [105] Accept DIV, div, MOD, and mod
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+@y
+  (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+  ((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@|
+  ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) or@|
+  ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@|
+@z
+
+@x [110] lowercase ids
+@^uppercase@>
+  if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+    (out_buf[out_ptr-1]="V"))or @/
+     ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+    (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+@y
+  if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+    (out_buf[out_ptr-1]="V"))or @/
+     ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and
+    (out_buf[out_ptr-1]="v"))or @/
+     ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+    (out_buf[out_ptr-1]="D"))or @/
+     ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and
+    (out_buf[out_ptr-1]="d")) then@/ goto bad_case
+@z
+
+@x [114] lowercase operators (`and', `or', etc.)
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+  send_out(ident,3);
+  end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+  send_out(ident,3);
+  end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+  send_out(ident,2);
+  end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+@y
+and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d";
+  send_out(ident,3);
+  end;
+not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t";
+  send_out(ident,3);
+  end;
+set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n";
+  send_out(ident,2);
+  end;
+or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2);
+@z
+
+@x [116] Remove conversion to uppercase
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+  #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+  end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+  end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+  while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+    begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+    if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+    else if out_contrib[k]="_" then decr(k);
+    end;
+  send_out(ident,k);
+  end;
+@y
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to lowercase,
+with underlines removed. Extremely long identifiers must be chopped.
+@^system dependencies@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+  #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"),
+"a",up_to("z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+  end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+  while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+    begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+    if not allow_underlines and (out_contrib[k]="_") then decr(k);
+    end;
+  send_out(ident,k);
+  end;
+@z
+
+@x [??] Fix casting bug
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+  end
+@y
+@d add_in(#)==begin accumulator:=accumulator+next_sign*intcast(#); next_sign:=+1;
+  end
+@z
+
+@x [179] make term_in = input
+any error stop will set |debug_cycle| to zero.
+@y
+any error stop will set |debug_cycle| to zero.
+
+@d term_in==stdin
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x [180] remove term_in reset
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x [182] write newline just before exit; use value of |history|
+print_ln(banner); {print a ``banner line''}
+@y
+print (banner); {print a ``banner line''}
+print_ln (version_string);
+@z
+
+@x
+@<Print the job |history|@>;
+@y
+@<Print the job |history|@>;
+new_line;
+if (history <> spotless) and (history <> harmless_message)
+then uexit (1)
+else uexit (0);
+@z
+
+@x [188] System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+@y
+Parse a Unix-style command line.
+
+@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0)
+
+@<Define |parse_arguments|@> =
+procedure parse_arguments;
+const n_options = 4; {Pascal won't count array lengths for us.}
+var @!long_options: array[0..n_options] of getopt_struct;
+    @!getopt_return_val: integer;
+    @!option_index: c_int_type;
+    @!current_option: 0..n_options;
+begin
+  @<Define the option table@>;
+  repeat
+    getopt_return_val := getopt_long_only (argc, argv, '', long_options,
+                                           address_of (option_index));
+    if getopt_return_val = -1 then begin
+      {End of arguments; we exit the loop below.} ;
+    
+    end else if getopt_return_val = "?" then begin
+      usage ('luatangle');
+
+    end else if argument_is ('underlines') then begin
+      allow_underlines := true;
+
+    end else if argument_is ('help') then begin
+      usage_help (LUATANGLE_HELP, nil);
+
+    end else if argument_is ('version') then begin
+      print_version_and_exit
+        (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil);
+
+    end; {Else it was a flag; |getopt| has already done the assignment.}
+  until getopt_return_val = -1;
+
+  {Now |optind| is the index of first non-option on the command line.}
+  if (optind + 1 <> argc) and (optind + 2 <> argc) then begin
+    write_ln (stderr, 'otangle: Need one or two file arguments.');
+    usage ('otangle');
+  end;
+  
+  {Supply |".web"| and |".ch"| extensions if necessary.}
+  web_name := extend_filename (cmdline (optind), 'web');
+  if optind + 2 = argc then begin
+    chg_name := extend_filename (cmdline (optind + 1), 'ch');
+  end;
+  
+  {Change |".web"| to |".p"| and use the current directory.}
+  pascal_name := basename_change_suffix (web_name, '.web', '.p');
+end;
+
+@ Here are the options we allow.  The first is one of the standard GNU options.
+@.-help@>
+
+@<Define the option...@> =
+current_option := 0;
+long_options[current_option].name := 'help';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Another of the standard options.
+@.-version@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'version';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ Allow underlines.
+@.-underlines@>
+
+@<Define the option...@> =
+long_options[current_option].name := 'underlines';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr (current_option);
+
+@ An element with all zeros always ends the list.
+
+@<Define the option...@> =
+long_options[current_option].name := 0;
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+
+@ Global filenames.
+
+@<Globals...@>=
+@!web_name,@!chg_name,@!pascal_name,@!pool_name:c_string;
+@!@!allow_underlines:boolean;
+@z
diff --git a/Build/source/texk/web2c/luatexdir/luatangle.web b/Build/source/texk/web2c/luatexdir/luatangle.web
new file mode 100644
index 00000000000..0cc3e8416c6
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatangle.web
@@ -0,0 +1,3328 @@
+% otangle.web: Omega version of file tangle.web
+% 
+% This file is part of the Omega project, which
+% is based in the web2c distribution of TeX.
+%
+% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous
+% applies only to the changes to the original tangle.web.
+%
+% This program by D. E. Knuth is not copyrighted and can be used freely.
+% Version 0 was released in December, 1981.
+% Version 1 was released in September, 1982, with version 0 of TeX.
+% Slight changes were made in October, 1982, for version 0.6 of TeX.
+% Version 1.2 introduced {:nnn} comments, added @@= and @@\ (December, 1982).
+% Version 1.4 added "history" (February, 1983).
+% Version 1.5 conformed to TeX version 0.96 and fixed @@\ (March, 1983).
+% Version 1.7 introduced the new change file format (June, 1983).
+% Version 2.0 was released in July, 1983, with version 0.999 of TeX.
+% Version 2.5 was released in November, 1983, with version 1.0 of TeX.
+% Version 2.6 fixed a bug: force-line-break after a constant (August, 1984).
+% Version 2.7 fixed the definition of check_sum_prime (May, 1985).
+% Version 2.8 fixed a bug in change_buffer movement (August, 1985).
+% Version 2.9 allows nonnumeric macros before their def (December, 1988).
+% Version 3, for Sewell's book, fixed long-line bug in input_ln (March, 1989).
+% Version 4 was major change to allow 8-bit input (September, 1989).
+% Version 4.1 conforms to ANSI standard for-loop rules (September, 1990).
+% Version 4.2 fixes stat report if phase one dies (March, 1991).
+% Version 4.3 fixes @@ bug in verbatim, catches extra } (September, 1991).
+% Version 4.4 activates debug_help on errors as advertised (February, 1993).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pb{$\.|\ldots\.|$} % Pascal brackets (|...|)
+\def\v{\.{\char'174}} % vertical (|) in typewriter font
+\mathchardef\BA="3224 % double arrow
+\def\({} % kludge for alphabetizing certain module names
+
+\def\title{OTANGLE}
+\def\contentspagenumber{123} % should be odd
+\def\topofcontents{\null\vfill
+  \titlefalse % include headline on the contents page
+  \def\rheader{\mainfont Appendix E\hfil \contentspagenumber}
+  \centerline{\titlefont The {\ttitlefont OTANGLE} processor}
+  \vskip 15pt
+  \centerline{(Version 4.4)}
+  \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program converts a \.{WEB} file to a \PASCAL\ file. It was written
+by D. E. Knuth in September, 1981; a somewhat similar {\mc SAIL} program had
+been developed in March, 1979. Since this program describes itself, a
+bootstrapping process involving hand-translation had to be used to get started.
+
+For large \.{WEB} files one should have a large memory, since \.{TANGLE} keeps
+all the \PASCAL\ text in memory (in an abbreviated form). The program uses
+a few features of the local \PASCAL\ compiler that may need to be changed in
+other installations:
+
+\yskip\item{1)} Case statements have a default.
+\item{2)} Input-output routines may need to be adapted for use with a particular
+character set and/or for printing messages on the user's terminal.
+
+\yskip\noindent
+These features are also present in the \PASCAL\ version of \TeX, where they
+are used in a similar (but more complex) way. System-dependent portions
+of \.{TANGLE} can be identified by looking at the entries for `system
+dependencies' in the index below.
+@!@^system dependencies@>
+
+The ``banner line'' defined here should be changed whenever \.{TANGLE}
+is modified.
+
+@d banner=='This is OTANGLE, Version 4.4'
+
+@ The program begins with a fairly normal header, made up of pieces that
+@^system dependencies@>
+will mostly be filled in later. The \.{WEB} input comes from files |web_file|
+and |change_file|, the \PASCAL\ output goes to file |Pascal_file|,
+and the string pool output goes to file |pool|.
+
+If it is necessary to abort the job because of a fatal error, the program
+calls the `|jump_out|' procedure, which goes to the label |end_of_TANGLE|.
+
+@d end_of_TANGLE = 9999 {go here to wrap it up}
+
+@p @t\4@>@<Compiler directives@>@/
+program OTANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+label end_of_TANGLE; {go here to finish}
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@<Error handling procedures@>@/
+procedure initialize;
+  var @<Local variables for initialization@>@/
+  begin @<Set initial values@>@/
+  end;
+
+@ Some of this code is optional for use when debugging only;
+such material is enclosed between the delimiters |debug| and $|gubed|$.
+Other parts, delimited by |stat| and $|tats|$, are optionally included if
+statistics about \.{TANGLE}'s memory usage are desired.
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$'
+  when gathering usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$'
+  when gathering usage statistics}
+@f stat==begin
+@f tats==end
+
+@ The \PASCAL\ compiler used to develop this system has ``compiler
+directives'' that can appear in comments whose first character is a dollar sign.
+In production versions of \.{TANGLE} these directives tell the compiler that
+@^system dependencies@>
+it is safe to avoid range checks and to leave out the extra code it inserts
+for the \PASCAL\ debugger's benefit, although interrupts will occur if
+there is arithmetic overflow.
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ Labels are given symbolic names by the following definitions. We insert
+the label `|exit|:' just before the `\ignorespaces|end|\unskip' of a
+procedure in which we have used the `|return|' statement defined below;
+the label `|restart|' is occasionally used at the very beginning of a
+procedure; and the label `|reswitch|' is occasionally used just prior to
+a \&{case} statement in which some cases change the conditions and we wish to
+branch to the newly applicable case.
+Loops that are set up with the \&{loop} construction defined below are
+commonly exited by going to `|done|' or to `|found|' or to `|not_found|',
+and they are sometimes repeated by going to `|continue|'.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=31 {go here when you've found it}
+@d not_found=32 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@f loop == xclause
+
+@ We assume that |case| statements may include a default case that applies
+if no matching label is found. Thus, we shall use constructions like
+@^system dependencies@>
+$$\vbox{\halign{#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the compiler
+used to develop \.{WEB} and \TeX\ allows `|others|:' as a default label,
+and other \PASCAL s allow syntaxes like `\ignorespaces|else|\unskip' or
+`\&{otherwise}' or `\\{otherwise}:', etc. The definitions of |othercases|
+and |endcases| should be changed to agree with local conventions. (Of
+course, if no default mechanism is available, the |case| statements of
+this program must be extended by listing all remaining cases. The author
+would have taken the trouble to modify \.{TANGLE} so that such extensions
+were done automatically, if he had not wanted to encourage \PASCAL\
+compiler writers to make this important change in \PASCAL, where it belongs.)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters are set big enough to handle \TeX, so they
+should be sufficient for most applications of \.{TANGLE}.
+
+@<Constants...@>=
+@!buf_size=100; {maximum length of input line}
+@!max_bytes=65535; {|1/ww| times the number of bytes in identifiers,
+  strings, and module names; must be less than 65536}
+@!max_toks=65535; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+  must be less than 65536}
+@!max_names=10239; {number of identifiers, strings, module names;
+  must be less than 10240}
+@!max_texts=10239; {number of replacement texts, must be less than 10240}
+@!hash_size=353; {should be prime}
+@!longest_name=400; {module names shouldn't be longer than this}
+@!line_length=72; {lines of \PASCAL\ output have at most this many characters}
+@!out_buf_size=144; {length of output buffer, should be twice |line_length|}
+@!stack_size=50; {number of simultaneous levels of macro expansion}
+@!max_id_length=12; {long identifiers are chopped to this length, which must
+  not exceed |line_length|}
+@!unambig_length=7; {identifiers must be unique if chopped to this length}
+  {note that 7 is more strict than \PASCAL's 8, but this can be varied}
+
+@ A global variable called |history| will contain one of four values
+at the end of every run: |spotless| means that no unusual messages were
+printed; |harmless_message| means that a message of possible interest
+was printed but no serious errors were detected; |error_message| means that
+at least one error was found; |fatal_message| means that the program
+terminated abnormally. The value of |history| does not influence the
+behavior of the program; it is simply computed for the convenience
+of systems that might want to use such information.
+
+@d spotless=0 {|history| value for normal jobs}
+@d harmless_message=1 {|history| value when non-serious info was printed}
+@d error_message=2 {|history| value when an error was noted}
+@d fatal_message=3 {|history| value when we had to stop prematurely}
+@#
+@d mark_harmless==@t@>@+if history=spotless then history:=harmless_message
+@d mark_error==history:=error_message
+@d mark_fatal==history:=fatal_message
+@d biggest_char=2097151 
+@d number_chars=2097152 
+
+@<Glob...@>=@!history:spotless..fatal_message; {how bad was this run?}
+
+@ @<Set init...@>=history:=spotless;
+
+@* The character set.
+One of the main goals in the design of \.{WEB} has been to make it readily
+portable between a wide variety of computers. Yet \.{WEB} by its very
+nature must use a greater variety of characters than most computer
+programs deal with, and character encoding is one of the areas in which
+existing machines differ most widely from each other.
+
+To resolve this problem, all input to \.{WEAVE} and \.{TANGLE} is converted
+to an internal eight-bit code that is essentially standard ASCII, the ``American
+Standard Code for Information Interchange.''  The conversion is done
+immediately when each character is read in. Conversely, characters are
+converted from ASCII to the user's external representation just before
+they are output. (The original ASCII code was seven bits only; \.{WEB} now
+allows eight bits in an attempt to keep up with modern times.)
+
+Such an internal code is relevant to users of \.{WEB} only because it is
+the code used for preprocessed constants like \.{"A"}. If you are writing
+a program in \.{WEB} that makes use of such one-character constants, you
+should convert your input to ASCII form, like \.{WEAVE} and \.{TANGLE} do.
+Otherwise \.{WEB}'s internal coding scheme does not affect you.
+@^ASCII code@>
+
+Here is a table of the standard visible ASCII codes:
+$$\def\:{\char\count255\global\advance\count255 by 1}
+\count255='40
+\vbox{
+\hbox{\hbox to 40pt{\it\hfill0\/\hfill}%
+\hbox to 40pt{\it\hfill1\/\hfill}%
+\hbox to 40pt{\it\hfill2\/\hfill}%
+\hbox to 40pt{\it\hfill3\/\hfill}%
+\hbox to 40pt{\it\hfill4\/\hfill}%
+\hbox to 40pt{\it\hfill5\/\hfill}%
+\hbox to 40pt{\it\hfill6\/\hfill}%
+\hbox to 40pt{\it\hfill7\/\hfill}}
+\vskip 4pt
+\hrule
+\def\^{\vrule height 10.5pt depth 4.5pt}
+\halign{\hbox to 0pt{\hskip -24pt\O{#0}\hfill}&\^
+\hbox to 40pt{\tt\hfill#\hfill\^}&
+&\hbox to 40pt{\tt\hfill#\hfill\^}\cr
+04&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+05&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+06&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+07&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+10&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+11&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+12&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+13&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+14&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+15&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+16&\:&\:&\:&\:&\:&\:&\:&\:\cr\noalign{\hrule}
+17&\:&\:&\:&\:&\:&\:&\:\cr}
+\hrule width 280pt}$$
+(Actually, of course, code @'040 is an invisible blank space.)  Code @'136
+was once an upward arrow (\.{\char'13}), and code @'137 was
+once a left arrow (\.^^X), in olden times when the first draft
+of ASCII code was prepared; but \.{WEB} works with today's standard
+ASCII in which those codes represent circumflex and underline as shown.
+
+@<Types...@>=
+@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, so \.{WEB} assumes that it is being used
+with a \PASCAL\ whose character set contains at least the characters of
+standard ASCII as listed above. Some \PASCAL\ compilers use the original
+name |char| for the data type associated with the characters in text files,
+while other \PASCAL s consider |char| to be a 64-element subrange of a larger
+data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters in the input and output
+files.  We shall also assume that |text_char| consists of the elements
+|chr(first_text_char)| through |chr(last_text_char)|, inclusive. The
+following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{WEAVE} and \.{TANGLE} processors convert between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+  {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+  {specifies conversion of output characters}
+
+@ If we assume that every system using \.{WEB} is able to read and write the
+visible characters of standard ASCII (although not necessarily using the
+ASCII codes to represent them), the following assignment statements initialize
+most of the |xchr| array properly, without needing any system-dependent
+changes. For example, the statement \.{xchr[@@\'101]:=\'A\'} that appears
+in the present \.{WEB} file might be encoded in, say, {\mc EBCDIC} code
+on the external medium on which it resides, but \.{TANGLE} will convert from
+this external code to ASCII and back again. Therefore the assignment
+statement \.{XCHR[65]:=\'A\'} will appear in the corresponding \PASCAL\ file,
+and \PASCAL\ will compile this statement so that |xchr[65]| receives the
+character \.A in the external (|char|) code. Note that it would be quite
+incorrect to say \.{xchr[@@\'101]:="A"}, because |"A"| is a constant of
+type |integer|, not |char|, and because we have $|"A"|=65$ regardless of
+the external character set.
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+xchr[0]:=' '; xchr[@'177]:=' '; {these ASCII codes are not used}
+
+@ Some of the ASCII codes below @'40 have been given symbolic names in
+\.{WEAVE} and \.{TANGLE} because they are used with a special meaning.
+
+@d and_sign=@'4 {equivalent to `\.{and}'}
+@d not_sign=@'5 {equivalent to `\.{not}'}
+@d set_element_sign=@'6 {equivalent to `\.{in}'}
+@d tab_mark=@'11 {ASCII code used as tab-skip}
+@d line_feed=@'12 {ASCII code thrown away at end of line}
+@d form_feed=@'14 {ASCII code used at end of page}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d left_arrow=@'30 {equivalent to `\.{:=}'}
+@d not_equal=@'32 {equivalent to `\.{<>}'}
+@d less_or_equal=@'34 {equivalent to `\.{<=}'}
+@d greater_or_equal=@'35 {equivalent to `\.{>=}'}
+@d equivalence_sign=@'36 {equivalent to `\.{==}'}
+@d or_sign=@'37 {equivalent to `\.{or}'}
+
+@ When we initialize the |xord| array and the remaining parts of |xchr|,
+it will be convenient to make use of an index variable, |i|.
+
+@<Local variables for init...@>=
+@!i:0..255;
+
+@ Here now is the system-dependent part of the character set.
+If \.{WEB} is being implemented on a garden-variety \PASCAL\ for which
+only standard ASCII codes will appear in the input and output files, you
+don't need to make any changes here. But if you have, for example, an extended
+character set like the one in Appendix~C of {\sl The \TeX book}, the first
+line of code in this module should be changed to
+$$\hbox{|for i:=1 to @'37 do xchr[i]:=chr(i);|}$$
+\.{WEB}'s character set is essentially identical to \TeX's, even with respect to
+characters less than @'40.
+@^system dependencies@>
+
+Changes to the present module will make \.{WEB} more friendly on computers
+that have an extended character set, so that one can type things like
+\.^^Z\ instead of \.{<>}. If you have an extended set of characters that
+are easily incorporated into text files, you can assign codes arbitrarily
+here, giving an |xchr| equivalent to whatever characters the users of
+\.{WEB} are allowed to have in their input files, provided that unsuitable
+characters do not correspond to special codes like |carriage_return|
+that are listed above.
+
+(The present file \.{TANGLE.WEB} does not contain any of the non-ASCII
+characters, because it is intended to be used with all implementations of
+\.{WEB}.  It was originally created on a Stanford system that has a
+convenient extended character set, then ``sanitized'' by applying another
+program that transliterated all of the non-standard characters into
+standard equivalents.)
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+for i:=@'200 to @'377 do xchr[i]:=' ';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=" ";
+for i:=1 to @'377 do xord[xchr[i]]:=i;
+xord[' ']:=" ";
+
+@* Input and output.
+The input conventions of this program are intended to be very much like those
+of \TeX\ (except, of course, that they are much simpler, because much less
+needs to be done). Furthermore they are identical to those of \.{WEAVE}.
+Therefore people who need to make modifications to all three systems
+should be able to do so without too many headaches.
+
+We use the standard \PASCAL\ input/output procedures in several places that
+\TeX\ cannot, since \.{TANGLE} does not have to deal with files that are named
+dynamically by the user, and since there is no input from the terminal.
+
+@ Terminal output is done by writing on file |term_out|, which is assumed to
+consist of characters of type |text_char|:
+@^system dependencies@>
+
+@d print(#)==write(term_out,#) {`|print|' means write on the terminal}
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@d print_nl(#)==  {print information starting on a new line}
+  begin new_line; print(#);
+  end
+
+@<Globals...@>=
+@!term_out:text_file; {the terminal as an output file}
+
+@ Different systems have different ways of specifying that the output on a
+certain file will appear on the user's terminal. Here is one way to do this
+on the \PASCAL\ system that was used in \.{TANGLE}'s initial development:
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+
+@ The |update_terminal| procedure is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ The main input comes from |web_file|; this input may be overridden
+by changes in |change_file|. (If |change_file| is empty, there are no changes.)
+
+@<Globals...@>=
+@!web_file:text_file; {primary input}
+@!change_file:text_file; {updates}
+
+@ The following code opens the input files.  Since these files were listed
+in the program header, we assume that the \PASCAL\ runtime system has
+already checked that suitable file names have been given; therefore no
+additional error checking needs to be done.
+@^system dependencies@>
+
+@p procedure open_input; {prepare to read |web_file| and |change_file|}
+begin reset(web_file); reset(change_file);
+end;
+
+@ The main output goes to |Pascal_file|, and string pool constants are
+written to the |pool| file.
+
+@<Globals...@>=
+@!Pascal_file: text_file;
+@!pool: text_file;
+
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+
+@ The |input_ln| procedure brings the next line of input from the specified
+file into the |buffer| array and returns the value |true|, unless the file has
+already been entirely read, in which case it returns |false|. The conventions
+of \TeX\ are followed; i.e., |ASCII_code| numbers representing the next line
+of the file are input into |buffer[0]|, |buffer[1]|, \dots,
+|buffer[limit-1]|; trailing blanks are ignored;
+and the global variable |limit| is set to the length of the
+@^system dependencies@>
+line. The value of |limit| must be strictly less than |buf_size|.
+
+We assume that none of the |ASCII_code| values
+of |buffer[j]| for |0<=j<limit| is equal to 0, @'177, |line_feed|, |form_feed|,
+or |carriage_return|.
+
+@p function input_ln(var f:text_file):boolean;
+  {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else  begin while not eoln(f) do
+    begin buffer[limit]:=xord[f^]; get(f);
+    incr(limit);
+    if buffer[limit-1]<>" " then final_limit:=limit;
+    if limit=buf_size then
+      begin while not eoln(f) do get(f);
+      decr(limit); {keep |buffer[buf_size]| empty}
+      if final_limit>limit then final_limit:=limit;
+      print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+      end;
+    end;
+  read_ln(f); limit:=final_limit; input_ln:=true;
+  end;
+end;
+
+@* Reporting errors to the user.
+The \.{TANGLE} processor operates in two phases: first it inputs the source
+file and stores a compressed representation of the program, then it produces
+the \PASCAL\ output from the compressed representation.
+
+The global variable |phase_one| tells whether we are in Phase I or not.
+
+@<Globals...@>=
+@!phase_one: boolean; {|true| in Phase I, |false| in Phase II}
+
+@ If an error is detected while we are debugging,
+we usually want to look at the contents of memory.
+A special procedure will be declared later for this purpose.
+
+@<Error handling...@>=
+@!debug @+ procedure debug_help; forward;@+ gubed
+
+@ During the first phase, syntax errors are reported to the user by saying
+$$\hbox{`|err_print('! Error message')|'},$$
+followed by `|jump_out|' if no recovery from the error is provided.
+This will print the error message followed by an indication of where the error
+was spotted in the source file. Note that no period follows the error message,
+since the error routine will automatically supply a period.
+
+Errors that are noticed during the second phase are reported to the user
+in the same fashion, but the error message will be
+followed by an indication of where the error was spotted in the output file.
+
+The actual error indications are provided by a procedure called |error|.
+
+@d err_print(#)==begin new_line; print(#); error;
+  end
+
+@<Error handling...@>=
+procedure error; {prints '\..' and location of error message}
+var j: 0..out_buf_size; {index into |out_buf|}
+@!k,@!l: 0..buf_size; {indices into |buffer|}
+begin if phase_one then @<Print error location based on input buffer@>
+else @<Print error location based on output buffer@>;
+update_terminal; mark_error;
+@!debug debug_skipped:=debug_cycle; debug_help;@+gubed
+end;
+
+@ The error locations during Phase I can be indicated by using the global
+variables |loc|, |line|, and |changing|, which tell respectively the first
+unlooked-at position in |buffer|, the current line number, and whether or not
+the current line is from |change_file| or |web_file|.
+This routine should be modified on systems whose standard text editor
+has special line-numbering conventions.
+@^system dependencies@>
+
+@<Print error location based on input buffer@>=
+begin if changing then print('. (change file ')@+else print('. (');
+print_ln('l.', line:1, ')');
+if loc>=limit then l:=limit else l:=loc;
+for k:=1 to l do
+  if buffer[k-1]=tab_mark then print(' ')
+  else print(xchr[buffer[k-1]]); {print the characters already read}
+new_line;
+for k:=1 to l do print(' '); {space out the next line}
+for k:=l+1 to limit do print(xchr[buffer[k-1]]); {print the part not yet read}
+print(' '); {this space separates the message from future asterisks}
+end
+
+@ The position of errors detected during the second phase can be indicated
+by outputting the partially-filled output buffer, which contains |out_ptr|
+entries.
+
+@<Print error location based on output...@>=
+begin print_ln('. (l.',line:1,')');
+for j:=1 to out_ptr do print(xchr[out_buf[j-1]]); {print current partial line}
+print('... '); {indicate that this information is partial}
+end
+
+@ The |jump_out| procedure just cuts across all active procedure levels
+and jumps out of the program. This is the only non-local |goto| statement
+in \.{TANGLE}. It is used when no recovery from a particular error has
+been provided.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the code that appears at label |end_of_TANGLE| should be
+copied into the |jump_out| procedure, followed by a call to a system procedure
+that terminates the program.
+
+@d fatal_error(#)==begin new_line; print(#); error; mark_fatal; jump_out;
+  end
+
+@<Error handling...@>=
+procedure jump_out;
+begin goto end_of_TANGLE;
+end;
+
+@ Sometimes the program's behavior is far different from what it should be,
+and \.{TANGLE} prints an error message that is really for the \.{TANGLE}
+maintenance person, not the user. In such cases the program says
+|confusion('indication of where we are')|.
+
+@d confusion(#)==fatal_error('! This can''t happen (',#,')')
+@.This can't happen@>
+
+@ An overflow stop occurs if \.{TANGLE}'s tables aren't large enough.
+
+@d overflow(#)==fatal_error('! Sorry, ',#,' capacity exceeded')
+@.Sorry, x capacity exceeded@>
+
+
+@* Data structures.
+Most of the user's \PASCAL\ code is packed into eight-bit integers
+in two large arrays called |byte_mem| and |tok_mem|.
+The |byte_mem| array holds the names of identifiers, strings, and modules;
+the |tok_mem| array holds the replacement texts
+for macros and modules. Allocation is sequential, since things are deleted only
+during Phase II, and only in a last-in-first-out manner.
+
+Auxiliary arrays |byte_start| and |tok_start| are used as directories to
+|byte_mem| and |tok_mem|, and the |link|, |ilk|, |equiv|, and |text_link|
+arrays give further information about names. These auxiliary arrays
+consist of sixteen-bit items.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=integer; {not quite a two-byte quantity}
+
+@ \.{TANGLE} has been designed to avoid the need for indices that are more
+than sixteen bits wide, so that it can be used on most computers. But
+there are programs that need more than 65536 tokens, and some programs
+even need more than 65536 bytes; \TeX\ is one of these.  To get around
+this problem, a slight complication has been added to the data structures:
+|byte_mem| and |tok_mem| are two-dimensional arrays, whose first index is
+either 0 or 1. (For generality, the first index is actually allowed to run
+between 0 and |ww-1| in |byte_mem|, or between 0 and |zz-1| in |tok_mem|,
+where |ww| and |zz| are set to 2 and~3; the program will work for any
+positive values of |ww| and |zz|, and it can be simplified in obvious ways
+if |ww=1| or |zz=1|.)
+
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+
+@<Globals...@>=
+@!byte_mem: packed array [0..ww-1,0..max_bytes] of ASCII_code;
+  {characters of names}
+@!tok_mem: packed array [0..zz-1,0..max_toks] of eight_bits; {tokens}
+@!byte_start: array [0..max_names] of sixteen_bits; {directory into |byte_mem|}
+@!tok_start: array [0..max_texts] of sixteen_bits; {directory into |tok_mem|}
+@!link: array [0..max_names] of sixteen_bits; {hash table or tree links}
+@!ilk: array [0..max_names] of sixteen_bits; {type codes or tree links}
+@!equiv: array [0..max_names] of sixteen_bits; {info corresponding to names}
+@!text_link: array [0..max_texts] of sixteen_bits; {relates replacement texts}
+
+@ The names of identifiers are found by computing a hash address |h| and
+then looking at strings of bytes signified by |hash[h]|, |link[hash[h]]|,
+|link[link[hash[h]]]|, \dots, until either finding the desired name
+or encountering a zero.
+
+A `|name_pointer|' variable, which signifies a name, is an index into
+|byte_start|. The actual sequence of characters in the name pointed to by
+|p| appears in positions |byte_start[p]| to |byte_start[p+ww]-1|, inclusive,
+in the segment of |byte_mem| whose first index is |p mod ww|. Thus, when
+|ww=2| the even-numbered name bytes appear in |byte_mem[0,@t$*$@>]|
+and the odd-numbered ones appear in |byte_mem[1,@t$*$@>]|.
+The pointer 0 is used for undefined module names; we don't
+want to use it for the names of identifiers, since 0 stands for a null
+pointer in a linked list.
+
+Strings are treated like identifiers; the first character (a double-quote)
+distinguishes a string from an alphabetic name, but for \.{TANGLE}'s purposes
+strings behave like numeric macros. (A `string' here refers to the
+strings delimited by double-quotes that \.{TANGLE} processes. \PASCAL\
+string constants delimited by single-quote marks are not given such special
+treatment; they simply appear as sequences of characters in the \PASCAL\
+texts.)  The total number of strings in the string
+pool is called |string_ptr|, and the total number of names in |byte_mem|
+is called |name_ptr|. The total number of bytes occupied in
+|byte_mem[w,@t$*$@>]| is called |byte_ptr[w]|.
+
+We usually have |byte_start[name_ptr+w]=byte_ptr[(name_ptr+w) mod ww]|
+for |0<=w<ww|, since these are the starting positions for the next |ww|
+names to be stored in |byte_mem|.
+
+@d length(#)==byte_start[#+ww]-byte_start[#] {the length of a name}
+
+@<Types...@>=
+@!name_pointer=0..max_names; {identifies a name}
+
+@ @<Global...@>=
+@!name_ptr:name_pointer; {first unused position in |byte_start|}
+@!string_ptr:name_pointer; {next number to be given to a string of length |<>1|}
+@!byte_ptr:array [0..ww-1] of 0..max_bytes;
+  {first unused position in |byte_mem|}
+@!pool_check_sum:integer; {sort of a hash for the whole string pool}
+
+@ @<Local variables for init...@>=
+@!wi: 0..ww-1; {to initialize the |byte_mem| indices}
+
+@ @<Set init...@>=
+for wi:=0 to ww-1 do
+  begin byte_start[wi]:=0; byte_ptr[wi]:=0;
+  end;
+byte_start[ww]:=0; {this makes name 0 of length zero}
+name_ptr:=1; string_ptr:=number_chars; pool_check_sum:=271828;
+
+@ Replacement texts are stored in |tok_mem|, using similar conventions.
+A `|text_pointer|' variable is an index into |tok_start|, and the
+replacement text that corresponds to |p| runs from positions
+|tok_start[p]| to |tok_start[p+zz]-1|, inclusive, in the segment of
+|tok_mem| whose first index is |p mod zz|. Thus, when |zz=2| the
+even-numbered replacement texts appear in |tok_mem[0,@t$*$@>]| and the
+odd-numbered ones appear in |tok_mem[1,@t$*$@>]|.  Furthermore,
+|text_link[p]| is used to connect pieces of text that have the same name,
+as we shall see later. The pointer 0 is used for undefined replacement
+texts.
+
+The first position of |tok_mem[z,@t$*$@>]| that is unoccupied by
+replacement text is called |tok_ptr[z]|, and the first unused location of
+|tok_start| is called |text_ptr|.  We usually have the identity
+|tok_start[text_ptr+z]=tok_ptr[(text_ptr+z) mod zz]|, for |0<=z<zz|, since
+these are the starting positions for the next |zz| replacement texts to
+be stored in |tok_mem|.
+
+@<Types...@>=
+@!text_pointer=0..max_texts; {identifies a replacement text}
+
+@ It is convenient to maintain a variable |z| that is equal to |text_ptr
+mod zz|, so that we always insert tokens into segment |z| of |tok_mem|.
+
+@<Glob...@>=
+@t\hskip1em@>@!text_ptr:text_pointer; {first unused position in |tok_start|}
+@t\hskip1em@>@!tok_ptr:array[0..zz-1] of 0..max_toks;
+  {first unused position in a given segment of |tok_mem|}
+@t\hskip1em@>@!z:0..zz-1; {current segment of |tok_mem|}
+stat @!max_tok_ptr:array[0..zz-1] of 0..max_toks;
+  {largest values assumed by |tok_ptr|}
+tats
+
+@ @<Local variables for init...@>=
+@!zi:0..zz-1; {to initialize the |tok_mem| indices}
+
+@ @<Set init...@>=
+for zi:=0 to zz-1 do
+  begin tok_start[zi]:=0; tok_ptr[zi]:=0;
+  end;
+tok_start[zz]:=0; {this makes replacement text 0 of length zero}
+text_ptr:=1; z:=1 mod zz;
+
+@ Four types of identifiers are distinguished by their |ilk|:
+
+\yskip\hang |normal| identifiers will appear in the \PASCAL\ program as
+ordinary identifiers since they have not been defined to be macros; the
+corresponding value in the |equiv| array
+for such identifiers is a link in a secondary hash table that
+is used to check whether any two of them agree in their first |unambig_length|
+characters after underline symbols are removed and lowercase letters are
+changed to uppercase.
+
+\yskip\hang |numeric| identifiers have been defined to be numeric macros;
+their |equiv| value contains the corresponding numeric value plus $2^{15}$.
+Strings are treated as numeric macros.
+
+\yskip\hang |simple| identifiers have been defined to be simple macros;
+their |equiv| value points to the corresponding replacement text.
+
+\yskip\hang |parametric| identifiers have been defined to be parametric macros;
+like simple identifiers, their |equiv| value points to the replacement text.
+
+@d normal=0 {ordinary identifiers have |normal| ilk}
+@d numeric=1 {numeric macros and strings have |numeric| ilk}
+@d simple=2 {simple macros have |simple| ilk}
+@d parametric=3 {parametric macros have |parametric| ilk}
+
+@ The names of modules are stored in |byte_mem| together
+with the identifier names, but a hash table is not used for them because
+\.{TANGLE} needs to be able to recognize a module name when given a prefix of
+that name. A conventional binary seach tree is used to retrieve module names,
+with fields called |llink| and |rlink| in place of |link| and |ilk|. The
+root of this tree is |rlink[0]|. If |p| is a pointer to a module name,
+|equiv[p]| points to its replacement text, just as in simple and parametric
+macros, unless this replacement text has not yet been defined (in which case
+|equiv[p]=0|).
+
+@d llink==link {left link in binary search tree for module names}
+@d rlink==ilk {right link in binary search tree for module names}
+
+@<Set init...@>=
+rlink[0]:=0; {the binary search tree starts out with nothing in it}
+equiv[0]:=0; {the undefined module has no replacement text}
+
+@ Here is a little procedure that prints the text of a given name.
+
+@p procedure print_id(@!p:name_pointer); {print identifier or module name}
+var k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin if p>=name_ptr then print('IMPOSSIBLE')
+else  begin w:=p mod ww;
+  for k:=byte_start[p] to byte_start[p+ww]-1 do print(xchr[byte_mem[w,k]]);
+  end;
+end;
+
+@* Searching for identifiers.
+The hash table described above is updated by the |id_lookup| procedure,
+which finds a given identifier and returns a pointer to its index in
+|byte_start|. If the identifier was not already present, it is inserted with
+a given |ilk| code; and an error message is printed if the identifier is being
+doubly defined.
+
+Because of the way \.{TANGLE}'s scanning mechanism works, it is most convenient
+to let |id_lookup| search for an identifier that is present in the |buffer|
+array. Two other global variables specify its position in the buffer: the
+first character is |buffer[id_first]|, and the last is |buffer[id_loc-1]|.
+Furthermore, if the identifier is really a string, the global variable
+|double_chars| tells how many of the characters in the buffer appear
+twice (namely \.{@@@@} and \.{""}), since this additional information makes
+it easy to calculate the true length of the string. The final double-quote
+of the string is not included in its ``identifier,'' but the first one is,
+so the string length is |id_loc-id_first-double_chars-1|.
+
+We have mentioned that |normal| identifiers belong to two hash tables,
+one for their true names as they appear in the \.{WEB} file and the other
+when they have been reduced to their first |unambig_length| characters.
+The hash tables are kept by the method of simple chaining, where the
+heads of the individual lists appear in the |hash| and |chop_hash| arrays.
+If |h| is a hash code, the primary hash table list starts at |hash[h]| and
+proceeds through |link| pointers; the secondary hash table list starts at
+|chop_hash[h]| and proceeds through |equiv| pointers. Of course, the same
+identifier will probably have two different values of |h|.
+
+The |id_lookup| procedure uses an auxiliary array called |chopped_id| to
+contain up to |unambig_length| characters of the current identifier, if
+it is necessary to compute the secondary hash code. (This array could be
+declared local to |id_lookup|, but in general we are making all array
+declarations global in this program, because some compilers and some machine
+architectures make dynamic array allocation inefficient.)
+
+@<Glob...@>=
+@!id_first:0..buf_size; {where the current identifier begins in the buffer}
+@!id_loc:0..buf_size; {just after the current identifier in the buffer}
+@!double_chars:0..buf_size; {correction to length in case of strings}
+@#
+@!hash,@!chop_hash:array [0..hash_size] of sixteen_bits; {heads of hash lists}
+@!chopped_id:array [0..unambig_length] of ASCII_code; {chopped identifier}
+
+@ Initially all the hash lists are empty.
+
+@<Local variables for init...@>=
+@!h:0..hash_size; {index into hash-head arrays}
+
+@ @<Set init...@>=
+for h:=0 to hash_size-1 do
+  begin hash[h]:=0; chop_hash[h]:=0;
+  end;
+
+@ Here now is the main procedure for finding identifiers (and strings).
+The parameter |t| is set to |normal| except when the identifier is
+a macro name that is just being defined; in the latter case, |t| will be
+|numeric|, |simple|, or |parametric|.
+
+@p function id_lookup(@!t:eight_bits):name_pointer; {finds current identifier}
+label found, not_found;
+var c:eight_bits; {byte being chopped}
+@!i:0..buf_size; {index into |buffer|}
+@!h:0..hash_size; {hash code}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!l:0..buf_size; {length of the given identifier}
+@!p,@!q:name_pointer; {where the identifier is being sought}
+@!s:0..unambig_length; {index into |chopped_id|}
+begin l:=id_loc-id_first; {compute the length}
+@<Compute the hash code |h|@>;
+@<Compute the name location |p|@>;
+if (p=name_ptr)or(t<>normal) then
+  @<Update the tables and check for possible errors@>;
+id_lookup:=p;
+end;
+
+@ A simple hash code is used: If the sequence of
+ASCII codes is $c_1c_2\ldots c_m$, its hash value will be
+$$(2^{n-1}c_1+2^{n-2}c_2+\cdots+c_n)\,\bmod\,|hash_size|.$$
+
+@<Compute the hash...@>=
+h:=buffer[id_first]; i:=id_first+1;
+while i<id_loc do
+  begin h:=(h+h+buffer[i]) mod hash_size; incr(i);
+  end
+
+@ If the identifier is new, it will be placed in position |p=name_ptr|,
+otherwise |p| will point to its existing location.
+
+@<Compute the name location...@>=
+p:=hash[h];
+while p<>0 do
+  begin if length(p)=l then
+      @<Compare name |p| with current identifier, |goto found| if equal@>;
+  p:=link[p];
+  end;
+p:=name_ptr; {the current identifier is new}
+link[p]:=hash[h]; hash[h]:=p; {insert |p| at beginning of hash list}
+found:
+
+@ @<Compare name |p|...@>=
+begin i:=id_first; k:=byte_start[p]; w:=p mod ww;
+while (i<id_loc)and(buffer[i]=byte_mem[w,k]) do
+  begin incr(i); incr(k);
+  end;
+if i=id_loc then goto found; {all characters agree}
+end
+
+@ @<Update the tables...@>=
+begin if ((p<>name_ptr)and(t<>normal)and(ilk[p]=normal)) or
+    ((p=name_ptr)and(t=normal)and(buffer[id_first]<>"""")) then
+  @<Compute the secondary hash code |h| and put the first characters
+  into the auxiliary array |chopped_id|@>;
+if p<>name_ptr then
+  @<Give double-definition error, if necessary, and change |p| to type |t|@>
+else @<Enter a new identifier into the table at position |p|@>;
+end
+
+@ The following routine, which is called into play when it is necessary to
+look at the secondary hash table, computes the same hash function as before
+(but on the chopped data), and places a zero after the chopped identifier
+in |chopped_id| to serve as a convenient sentinel.
+
+@<Compute the secondary...@>=
+begin i:=id_first; s:=0; h:=0;
+while (i<id_loc)and(s<unambig_length) do
+  begin if buffer[i]<>"_" then
+    begin if buffer[i]>="a" then chopped_id[s]:=buffer[i]-@'40
+    else chopped_id[s]:=buffer[i];
+    h:=(h+h+chopped_id[s]) mod hash_size; incr(s);
+    end;
+  incr(i);
+  end;
+chopped_id[s]:=0;
+end
+
+@ If a nonnumeric macro has appeared before it was defined, \.{TANGLE}
+will still work all right; after all, such behavior is typical of the
+replacement texts for modules, which act very much like macros.
+However, an undefined numeric macro may not be used on the right-hand
+side of another numeric macro definition, so \.{TANGLE} finds it
+simplest to make a blanket rule that numeric macros should be defined
+before they are used. The following routine gives an error message and
+also fixes up any damage that may have been caused.
+
+@<Give double...@>= {now |p<>name_ptr| and |t<>normal|}
+begin if ilk[p]=normal then
+  begin if t=numeric then err_print('! This identifier has already appeared');
+@.This identifier has already...@>
+  @<Remove |p| from secondary hash table@>;
+  end
+else err_print('! This identifier was defined before');
+@.This identifier was defined...@>
+ilk[p]:=t;
+end
+
+@ When we have to remove a secondary hash entry, because a |normal| identifier
+is changing to another |ilk|, the hash code |h| and chopped identifier have
+already been computed.
+
+@<Remove |p| from secondary...@>=
+q:=chop_hash[h];
+if q=p then chop_hash[h]:=equiv[p]
+else  begin while equiv[q]<>p do q:=equiv[q];
+  equiv[q]:=equiv[p];
+  end
+
+@ The following routine could make good use of a generalized |pack| procedure
+that puts items into just part of a packed array instead of the whole thing.
+
+@<Enter a new identifier...@>=
+begin if (t=normal)and(buffer[id_first]<>"""") then
+  @<Check for ambiguity and update secondary hash@>;
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+i:=id_first; {get ready to move the identifier into |byte_mem|}
+while i<id_loc do
+  begin byte_mem[w,k]:=buffer[i]; incr(k); incr(i);
+  end;
+byte_ptr[w]:=k; byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if buffer[id_first]<>"""" then ilk[p]:=t
+else @<Define and output a new string of the pool@>;
+end
+
+@ @<Check for ambig...@>=
+begin q:=chop_hash[h];
+while q<>0 do
+  begin @<Check if |q| conflicts with |p|@>;
+  q:=equiv[q];
+  end;
+equiv[p]:=chop_hash[h]; chop_hash[h]:=p; {put |p| at front of secondary list}
+end
+
+@ @<Check if |q| conflicts...@>=
+begin k:=byte_start[q]; s:=0; w:=q mod ww;
+while (k<byte_start[q+ww]) and (s<unambig_length) do
+  begin c:=byte_mem[w,k];
+  if c<>"_" then
+    begin if c>="a" then c:=c-@'40; {merge lowercase with uppercase}
+    if chopped_id[s]<>c then goto not_found;
+    incr(s);
+    end;
+  incr(k);
+  end;
+if (k=byte_start[q+ww])and(chopped_id[s]<>0) then goto not_found;
+print_nl('! Identifier conflict with ');
+@.Identifier conflict...@>
+for k:=byte_start[q] to byte_start[q+ww]-1 do print(xchr[byte_mem[w,k]]);
+error; q:=0; {only one conflict will be printed, since |equiv[0]=0|}
+not_found:
+end
+
+@ We compute the string pool check sum by working modulo a prime number
+that is large but not so large that overflow might occur.
+
+@d check_sum_prime==@'3777777667 {$2^{29}-73$}
+@^preprocessed strings@>
+
+@<Define and output a new string...@>=
+begin ilk[p]:=numeric; {strings are like numeric macros}
+if l-double_chars=2 then {this string is for a single character}
+  equiv[p]:=buffer[id_first+1]+1073741824
+else  begin equiv[p]:=string_ptr+1073741824;
+  l:=l-double_chars-1;
+  if l>99 then err_print('! Preprocessed string is too long');
+@.Preprocessed string is too long@>
+  incr(string_ptr);
+  write(pool,xchr["0"+l div 10],xchr["0"+l mod 10]); {output the length}
+  pool_check_sum:=pool_check_sum+pool_check_sum+l;
+  while pool_check_sum>check_sum_prime do
+    pool_check_sum:=pool_check_sum-check_sum_prime;
+  i:=id_first+1;
+  while i<id_loc do
+    begin write(pool,xchr[buffer[i]]); {output characters of string}
+    pool_check_sum:=pool_check_sum+pool_check_sum+buffer[i];
+    while pool_check_sum>check_sum_prime do
+      pool_check_sum:=pool_check_sum-check_sum_prime;
+    if (buffer[i]="""") or (buffer[i]="@@") then
+      i:=i+2 {omit second appearance of doubled character}
+    else incr(i);
+    end;
+  write_ln(pool);
+  end;
+end
+
+@* Searching for module names.
+The |mod_lookup| procedure finds the module name |mod_text[1..l]| in the
+search tree, after inserting it if necessary, and returns a pointer to
+where it was found.
+
+@<Glob...@>=
+@!mod_text:array [0..longest_name] of ASCII_code; {name being sought for}
+
+@ According to the rules of \.{WEB}, no module name
+should be a proper prefix of another, so a ``clean'' comparison should
+occur between any two names. The result of |mod_lookup| is 0 if this
+prefix condition is violated. An error message is printed when such violations
+are detected during phase two of \.{WEAVE}.
+
+@d less=0 {the first name is lexicographically less than the second}
+@d equal=1 {the first name is equal to the second}
+@d greater=2 {the first name is lexicographically greater than the second}
+@d prefix=3 {the first name is a proper prefix of the second}
+@d extension=4 {the first name is a proper extension of the second}
+
+@p function mod_lookup(@!l:sixteen_bits):name_pointer; {finds module name}
+label found;
+var c:less..extension; {comparison between two names}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {father of node |p|}
+begin c:=greater; q:=0; p:=rlink[0]; {|rlink[0]| is the root of the tree}
+while p<>0 do
+  begin @<Set \(|c| to the result of comparing the given name to
+    name |p|@>;
+  q:=p;
+  if c=less then p:=llink[q]
+  else if c=greater then p:=rlink[q]
+  else goto found;
+  end;
+@<Enter a new module name into the tree@>;
+found: if c<>equal then
+  begin err_print('! Incompatible section names'); p:=0;
+@.Incompatible module names@>
+  end;
+mod_lookup:=p;
+end;
+
+@ @<Enter a new module name...@>=
+w:=name_ptr mod ww; k:=byte_ptr[w];
+if k+l>max_bytes then overflow('byte memory');
+if name_ptr>max_names-ww then overflow('name');
+p:=name_ptr;
+if c=less then llink[q]:=p else rlink[q]:=p;
+llink[p]:=0; rlink[p]:=0; c:=equal; equiv[p]:=0;
+for j:=1 to l do byte_mem[w,k+j-1]:=mod_text[j];
+byte_ptr[w]:=k+l; byte_start[name_ptr+ww]:=k+l; incr(name_ptr);
+
+@ @<Set \(|c|...@>=
+begin k:=byte_start[p]; w:=p mod ww; c:=equal; j:=1;
+while (k<byte_start[p+ww]) and (j<=l) and (mod_text[j]=byte_mem[w,k]) do
+  begin incr(k); incr(j);
+  end;
+if k=byte_start[p+ww] then
+  if j>l then c:=equal
+  else c:=extension
+else if j>l then c:=prefix
+else if mod_text[j]<byte_mem[w,k] then c:=less
+else c:=greater;
+end
+
+@ The |prefix_lookup| procedure is supposed to find exactly one module
+name that has |mod_text[1..l]| as a prefix. Actually the algorithm silently
+accepts also the situation that some module name is a prefix of
+|mod_text[1..l]|, because the user who painstakingly typed in more than
+necessary probably doesn't want to be told about the wasted effort.
+
+@p function prefix_lookup(@!l:sixteen_bits):name_pointer; {finds name extension}
+var c:less..extension; {comparison between two names}
+@!count:0..max_names; {the number of hits}
+@!j:0..longest_name; {index into |mod_text|}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+@!p:name_pointer; {current node of the search tree}
+@!q:name_pointer; {another place to resume the search after one branch is done}
+@!r:name_pointer; {extension found}
+begin q:=0; p:=rlink[0]; count:=0; r:=0; {begin search at root of tree}
+while p<>0 do
+  begin @<Set \(|c|...@>;
+  if c=less then p:=llink[p]
+  else if c=greater then p:=rlink[p]
+  else  begin r:=p; incr(count); q:=rlink[p]; p:=llink[p];
+    end;
+  if p=0 then
+    begin p:=q; q:=0;
+    end;
+  end;
+if count<>1 then
+  if count=0 then err_print('! Name does not match')
+@.Name does not match@>
+  else err_print('! Ambiguous prefix');
+@.Ambiguous prefix@>
+prefix_lookup:=r; {the result will be 0 if there was no match}
+end;
+
+@* Tokens.
+Replacement texts, which represent \PASCAL\ code in a compressed format,
+appear in |tok_mem| as mentioned above. The codes in
+these texts are called `tokens'; some tokens occupy two consecutive
+eight-bit byte positions, and the others take just one byte.
+
+If $p>0$ points to a replacement text, |tok_start[p]| is the |tok_mem| position
+of the first eight-bit code of that text. If |text_link[p]=0|,
+this is the replacement text for a macro, otherwise it is the replacement
+text for a module. In the latter case |text_link[p]| is either equal to
+|module_flag|, which means that there is no further text for this module, or
+|text_link[p]| points to a
+continuation of this replacement text; such links are created when
+several modules have \PASCAL\ texts with the same name, and they also
+tie together all the \PASCAL\ texts of unnamed modules.
+The replacement text pointer for the first unnamed module
+appears in |text_link[0]|, and the most recent such pointer is |last_unnamed|.
+
+@d module_flag==max_texts {final |text_link| in module replacement texts}
+
+@<Glob...@>=
+@!last_unnamed:text_pointer; {most recent replacement text of unnamed module}
+
+@ @<Set init...@>= last_unnamed:=0; text_link[0]:=0;
+
+@ If the first byte of a token is less than @'200, the token occupies a
+single byte. Otherwise we make a sixteen-bit token by combining two consecutive
+bytes |a| and |b|. If |@'200<=a<@'250|, then $(a-@'200)\times2^8+b$ points
+to an identifier; if |@'250<=a<@'320|, then
+$(a-@'250)\times2^8+b$ points to a module name; otherwise, i.e., if
+|@'320<=a<@'400|, then $(a-@'320)\times2^8+b$ is the number of the module
+in which the current replacement text appears.
+
+Codes less than @'200 are 7-bit ASCII codes that represent themselves.
+In particular, a single-character identifier like `|x|' will be a one-byte
+token, while all longer identifiers will occupy two bytes.
+
+Some of the 7-bit ASCII codes will not be present, however, so we can
+use them for special purposes. The following symbolic names are used:
+
+\yskip\hang |param| denotes insertion of a parameter. This occurs only in
+the replacement texts of parametric macros, outside of single-quoted strings
+in those texts.
+
+\hang |begin_comment| denotes \.{@@\{}, which will become either
+\.{\{} or \.{[}.
+
+\hang |end_comment| denotes \.{@@\}}, which will become either
+\.{\}} or \.{]}.
+
+\hang |octal| denotes the \.{@@\'} that precedes an octal constant.
+
+\hang |hex| denotes the \.{@@"} that precedes a hexadecimal constant.
+
+\hang |check_sum| denotes the \.{@@\char'44} that denotes the string pool
+check sum.
+
+\hang |join| denotes the concatenation of adjacent items with no
+space or line breaks allowed between them (the \.{@@\&} operation of \.{WEB}).
+
+\hang |double_dot| denotes `\.{..}' in \PASCAL.
+
+\hang |verbatim| denotes the \.{@@=} that begins a verbatim \PASCAL\ string.
+It is also used for the end of the string.
+
+\hang |force_line| denotes the \.{@@\\} that forces a new line in the
+\PASCAL\ output.
+@^ASCII code@>
+
+@d param=0 {ASCII null code will not appear}
+@d verbatim=@'2 {extended ASCII alpha should not appear}
+@d force_line=@'3 {extended ASCII beta should not appear}
+@d begin_comment=@'11 {ASCII tab mark will not appear}
+@d end_comment=@'12 {ASCII line feed will not appear}
+@d octal=@'14 {ASCII form feed will not appear}
+@d hex=@'15 {ASCII carriage return will not appear}
+@d double_dot=@'40 {ASCII space will not appear except in strings}
+@d check_sum=@'175 {will not be confused with right brace}
+@d join=@'177 {ASCII delete will not appear}
+
+@ The following procedure is used to enter a two-byte value into
+|tok_mem| when a replacement text is being generated.
+
+@p procedure store_two_bytes(@!x:sixteen_bits);
+  {stores high byte, then low byte}
+begin if tok_ptr[z]+2>max_toks then overflow('token');
+tok_mem[z,tok_ptr[z]]:=x div@'400; {this could be done by a shift command}
+tok_mem[z,tok_ptr[z]+1]:=x mod@'400; {this could be done by a logical and}
+tok_ptr[z]:=tok_ptr[z]+2;
+end;
+
+@ When \.{TANGLE} is being operated in debug mode, it has a procedure to display
+a replacement text in symbolic form. This procedure has not been spruced up to
+generate a real great format, but at least the results are not as bad as
+a memory dump.
+
+@p @!debug procedure print_repl(@!p:text_pointer);
+var k:0..max_toks; {index into |tok_mem|}
+@!a: sixteen_bits; {current byte(s)}
+@!zp: 0..zz-1; {segment of |tok_mem| being accessed}
+begin if p>=text_ptr then print('BAD')
+else  begin k:=tok_start[p]; zp:=p mod zz;
+  while k<tok_start[p+zz] do
+    begin a:=tok_mem[zp,k];
+    if a>=@'200 then @<Display two-byte token starting with |a|@>
+    else @<Display one-byte token |a|@>;
+    incr(k);
+    end;
+  end;
+end;
+gubed
+
+@ @<Display two-byte...@>=
+begin incr(k);
+if a<@'250 then {identifier or string}
+  begin a:=(a-@'200)*@'400+tok_mem[zp,k]; print_id(a);
+  if byte_mem[a mod ww,byte_start[a]]="""" then print('"')
+  else print(' ');
+  end
+else if a<@'320 then {module name}
+  begin print('@@<'); print_id((a-@'250)*@'400+tok_mem[zp,k]);
+  print('@@>');
+  end
+else  begin a:=(a-@'320)*@'400+tok_mem[zp,k]; {module number}
+  print('@@',xchr["{"],a:1,'@@',xchr["}"]); {can't use right brace
+    between \&{debug} and \&{gubed}}
+  end;
+end
+
+@ @<Display one-byte...@>=
+case a of
+begin_comment: print('@@',xchr["{"]);
+end_comment: print('@@',xchr["}"]); {can't use right brace
+    between \&{debug} and \&{gubed}}
+octal: print('@@''');
+hex: print('@@"');
+check_sum: print('@@$');
+param: print('#');
+"@@": print('@@@@');
+verbatim: print('@@=');
+force_line: print('@@\');
+othercases print(xchr[a])
+endcases
+
+@* Stacks for output.
+Let's make sure that our data structures contain enough information to
+produce the entire \PASCAL\ program as desired, by working next on the
+algorithms that actually do produce that program.
+
+@ The output process uses a stack to keep track of what is going on at
+different ``levels'' as the macros are being expanded.
+Entries on this stack have five parts:
+
+\yskip\hang |end_field| is the |tok_mem| location where the replacement
+text of a particular level will end;
+
+\hang |byte_field| is the |tok_mem| location from which the next token
+on a particular level will be read;
+
+\hang |name_field| points to the name corresponding to a particular level;
+
+\hang |repl_field| points to the replacement text currently being read
+at a particular level;
+
+\hang |mod_field| is the module number, or zero if this is a macro.
+
+\yskip\noindent The current values of these five quantities are referred to
+quite frequently, so they are stored in a separate place instead of in
+the |stack| array. We call the current values |cur_end|, |cur_byte|,
+|cur_name|, |cur_repl|, and |cur_mod|.
+
+The global variable |stack_ptr| tells how many levels of output are
+currently in progress. The end of all output occurs when the stack is
+empty, i.e., when |stack_ptr=0|.
+
+@<Types...@>=
+@t\4@>@!output_state=record
+  @!end_field: sixteen_bits; {ending location of replacement text}
+  @!byte_field: sixteen_bits; {present location within replacement text}
+  @!name_field: name_pointer; {|byte_start| index for text being output}
+  @!repl_field: text_pointer; {|tok_start| index for text being output}
+  @!mod_field: 0..@'27777; {module number or zero if not a module}
+  end;
+
+@ @d cur_end==cur_state.end_field {current ending location in |tok_mem|}
+@d cur_byte==cur_state.byte_field {location of next output byte in |tok_mem|}
+@d cur_name==cur_state.name_field {pointer to current name being expanded}
+@d cur_repl==cur_state.repl_field {pointer to current replacement text}
+@d cur_mod==cur_state.mod_field {current module number being expanded}
+
+@<Globals...@>=
+@!cur_state : output_state; {|cur_end|, |cur_byte|, |cur_name|,
+  |cur_repl|, |cur_mod|}
+@!stack : array [1..stack_size] of output_state; {info for non-current levels}
+@!stack_ptr: 0..stack_size; {first unused location in the output state stack}
+
+@ It is convenient to keep a global variable |zo| equal to |cur_repl mod zz|.
+
+@<Glob...@>=
+@!zo:0..zz-1; {the segment of |tok_mem| from which output is coming}
+
+@ Parameters must also be stacked. They are placed in
+|tok_mem| just above the other replacement texts, and dummy parameter
+`names' are placed in |byte_start| just after the other names.
+The variables |text_ptr| and |tok_ptr[z]| essentially serve as parameter
+stack pointers during the output phase, so there is no need for a separate
+data structure to handle this problem.
+
+@ There is an implicit stack corresponding to meta-comments that are output
+via \.{@@\{} and \.{@@\}}. But this stack need not be represented in detail,
+because we only need to know whether it is empty or not. A global variable
+|brace_level| tells how many items would be on this stack if it were present.
+
+@<Globals...@>=
+@!brace_level: eight_bits; {current depth of $\.{@@\{}\ldots\.{@@\}}$ nesting}
+
+@ To get the output process started, we will perform the following
+initialization steps. We may assume that |text_link[0]| is nonzero, since it
+points to the \PASCAL\ text in the first unnamed module that generates
+code; if there are no such modules, there is nothing to output, and an
+error message will have been generated before we do any of the initialization.
+
+@<Initialize the output stacks@>=
+stack_ptr:=1; brace_level:=0; cur_name:=0; cur_repl:=text_link[0];
+zo:=cur_repl mod zz; cur_byte:=tok_start[cur_repl];
+cur_end:=tok_start[cur_repl+zz]; cur_mod:=0;
+
+@ When the replacement text for name |p| is to be inserted into the output,
+the following subroutine is called to save the old level of output and get
+the new one going.
+
+@p procedure push_level(@!p:name_pointer); {suspends the current level}
+begin if stack_ptr=stack_size then overflow('stack')
+else  begin stack[stack_ptr]:=cur_state; {save |cur_end|, |cur_byte|, etc.}
+  incr(stack_ptr);
+  cur_name:=p; cur_repl:=equiv[p]; zo:=cur_repl mod zz;
+  cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+  cur_mod:=0;
+  end;
+end;
+
+@ When we come to the end of a replacement text, the |pop_level| subroutine
+does the right thing: It either moves to the continuation of this replacement
+text or returns the state to the most recently stacked level. Part of this
+subroutine, which updates the parameter stack, will be given later when we
+study the parameter stack in more detail.
+
+@p procedure pop_level; {do this when |cur_byte| reaches |cur_end|}
+label exit;
+begin if text_link[cur_repl]=0 then {end of macro expansion}
+  begin if ilk[cur_name]=parametric then
+    @<Remove a parameter from the parameter stack@>;
+  end
+else if text_link[cur_repl]<module_flag then {link to a continuation}
+  begin cur_repl:=text_link[cur_repl]; {we will stay on the same level}
+  zo:=cur_repl mod zz;
+  cur_byte:=tok_start[cur_repl]; cur_end:=tok_start[cur_repl+zz];
+  return;
+  end;
+decr(stack_ptr); {we will go down to the previous level}
+if stack_ptr>0 then
+  begin cur_state:=stack[stack_ptr]; zo:=cur_repl mod zz;
+  end;
+exit: end;
+
+@ The heart of the output procedure is the |get_output| routine, which produces
+the next token of output that is not a reference to a macro. This procedure
+handles all the stacking and unstacking that is necessary. It returns the
+value |number| if the next output has a numeric value (the value of a
+numeric macro or string), in which case |cur_val| has been set to the
+number in question. The procedure also returns the value |module_number|
+if the next output begins or ends the replacement text of some module,
+in which case |cur_val| is that module's number (if beginning) or the
+negative of that value (if ending). And it returns the value |identifier|
+if the next output is an identifier of length two or more, in which case
+|cur_val| points to that identifier name.
+
+@d number=@'200 {code returned by |get_output| when next output is numeric}
+@d module_number=@'201 {code returned by |get_output| for module numbers}
+@d identifier=@'202 {code returned by |get_output| for identifiers}
+
+@<Globals...@>=
+@!cur_val:integer; {additional information corresponding to output token}
+
+@ If |get_output| finds that no more output remains, it returns the value zero.
+
+@p function get_output:sixteen_bits; {returns next token after macro expansion}
+label restart, done, found;
+var a:sixteen_bits; {value of current byte}
+@!b:eight_bits; {byte being copied}
+@!bal:sixteen_bits; {excess of \.( versus \.) while copying a parameter}
+@!k:0..max_bytes; {index into |byte_mem|}
+@!w:0..ww-1; {segment of |byte_mem|}
+begin restart: if stack_ptr=0 then
+  begin a:=0; goto found;
+  end;
+if cur_byte=cur_end then
+  begin cur_val:=-cur_mod; pop_level;
+  if cur_val=0 then goto restart;
+  a:=module_number; goto found;
+  end;
+a:=tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'200 then {one-byte token}
+  if a=param then
+      @<Start scanning current macro parameter, |goto restart|@>
+  else goto found;
+a:=(a-@'200)*@'400+tok_mem[zo,cur_byte]; incr(cur_byte);
+if a<@'24000 then {|@'24000=(@'250-@'200)*@'400|}
+  @<Expand macro |a| and |goto found|, or |goto restart| if no output found@>;
+if a<@'50000 then {|@'50000=(@'320-@'200)*@'400|}
+  @<Expand module |a-@'24000|, |goto restart|@>;
+cur_val:=a-@'50000; a:=module_number; cur_mod:=cur_val;
+found:
+@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_output:=a;
+end;
+
+@ The user may have forgotten to give any \PASCAL\ text for a module name,
+or the \PASCAL\ text may have been associated with a different name by mistake.
+
+@<Expand module |a-...@>=
+begin a:=a-@'24000;
+if equiv[a]<>0 then push_level(a)
+else if a<>0 then
+  begin print_nl('! Not present: <'); print_id(a); print('>'); error;
+@.Not present: <section name>@>
+  end;
+goto restart;
+end
+
+@ @<Expand macro ...@>=
+begin case ilk[a] of
+normal: begin cur_val:=a; a:=identifier;
+  end;
+numeric: begin cur_val:=equiv[a]-1073741824; a:=number;
+  end;
+simple: begin push_level(a); goto restart;
+  end;
+parametric: begin @<Put a parameter on the parameter stack,
+  or |goto restart| if error occurs@>;
+  push_level(a); goto restart;
+  end;
+othercases confusion('output')
+endcases;@/
+goto found;
+end
+
+@ We come now to the interesting part, the job of putting a parameter on
+the parameter stack. First we pop the stack if necessary until getting to
+a level that hasn't ended. Then the next character must be a `\.(';
+and since parentheses are balanced on each level, the entire parameter must
+be present, so we can copy it without difficulty.
+
+@<Put a parameter...@>=
+while (cur_byte=cur_end)and(stack_ptr>0) do pop_level;
+if (stack_ptr=0)or(tok_mem[zo,cur_byte]<>"(") then
+  begin print_nl('! No parameter given for '); print_id(a); error;
+@.No parameter given for macro@>
+  goto restart;
+  end;
+@<Copy the parameter into |tok_mem|@>;
+equiv[name_ptr]:=text_ptr; ilk[name_ptr]:=simple; w:=name_ptr mod ww;
+k:=byte_ptr[w];
+@!debug if k=max_bytes then overflow('byte memory');
+byte_mem[w,k]:="#"; incr(k); byte_ptr[w]:=k;
+gubed {this code has set the parameter identifier for debugging printouts}
+if name_ptr>max_names-ww then overflow('name');
+byte_start[name_ptr+ww]:=k; incr(name_ptr);
+if text_ptr>max_texts-zz then overflow('text');
+text_link[text_ptr]:=0; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+z:=text_ptr mod zz
+
+@ The |pop_level| routine undoes the effect of parameter-pushing when
+a parameter macro is finished:
+
+@<Remove a parameter...@>=
+begin decr(name_ptr); decr(text_ptr);
+z:=text_ptr mod zz;
+stat if tok_ptr[z]>max_tok_ptr[z] then max_tok_ptr[z]:=tok_ptr[z];
+tats {the maximum value of |tok_ptr| occurs just before parameter popping}
+tok_ptr[z]:=tok_start[text_ptr];
+@!debug decr(byte_ptr[name_ptr mod ww]);@+gubed
+end
+
+@ When a parameter occurs in a replacement text, we treat it as a simple
+macro in position (|name_ptr-1|):
+
+@<Start scanning...@>=
+begin push_level(name_ptr-1); goto restart;
+end
+
+@ Similarly, a |param| token encountered as we copy a parameter is converted
+into a simple macro call for |name_ptr-1|.
+Some care is needed to handle cases like \\{macro}|(#; print('#)'))|; the
+\.{\#} token will have been changed to |param| outside of strings, but we
+still must distinguish `real' parentheses from those in strings.
+
+@d app_repl(#)==begin if tok_ptr[z]=max_toks then overflow('token');
+  tok_mem[z,tok_ptr[z]]:=#; incr(tok_ptr[z]); end
+
+@<Copy the parameter...@>=
+bal:=1; incr(cur_byte); {skip the opening `\.('}
+loop@+  begin b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+  if b=param then store_two_bytes(name_ptr+@'77777)
+  else  begin if b>=@'200 then
+      begin app_repl(b);
+      b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+      end
+    else   case b of
+      "(": incr(bal);
+      ")":  begin decr(bal);
+        if bal=0 then goto done;
+        end;
+      "'": repeat app_repl(b);
+        b:=tok_mem[zo,cur_byte]; incr(cur_byte);
+        until b="'"; {copy string, don't change |bal|}
+      othercases do_nothing
+      endcases;
+    app_repl(b);
+    end;
+  end;
+done:
+
+@* Producing the output.
+The |get_output| routine above handles most of the complexity of output
+generation, but there are two further considerations that have a nontrivial
+effect on \.{TANGLE}'s algorithms.
+
+First, we want to make sure that the output is broken into lines not
+exceeding |line_length| characters per line, where these breaks occur at
+valid places (e.g., not in the middle of a string or a constant or an
+identifier, not between `\.<' and `\.>', not at a `\.{@@\&}' position
+where quantities are being joined together). Therefore we assemble the
+output into a buffer before deciding where the line breaks will appear.
+However, we make very little attempt to make ``logical'' line breaks that
+would enhance the readability of the output; people are supposed to read
+the input of \.{TANGLE} or the \TeX ed output of \.{WEAVE}, but not the
+tangled-up output. The only concession to readability is that a break after
+a semicolon will be made if possible, since commonly used ``pretty
+printing'' routines give better results in such cases.
+
+Second, we want to decimalize non-decimal constants, and to combine integer
+quantities that are added or subtracted, because \PASCAL\ doesn't allow
+constant expressions in subrange types or in case labels. This means we
+want to have a procedure that treats a construction like \.{(E-15+17)}
+as equivalent to `\.{(E+2)}', while also leaving `\.{(1E-15+17)}' and
+`\.{(E-15+17*y)}' untouched. Consider also `\.{-15+17.5}' versus
+`\.{-15+17..5}'. We shall not combine integers preceding or following
+\.*, \./, \.{div}, \.{mod}, or \.{@@\&}. Note that if |y| has been defined
+to equal $-2$, we must expand `\.{x*y}' into `\.{x*(-2)}'; but `\.{x-y}'
+can expand into `\.{x+2}' and we can even change `\.{x - y mod z}' to
+@^mod@>
+`\.{x + 2 mod z}' because \PASCAL\ has a nonstandard \&{mod} operation!
+
+The following solution to these problems has been adopted: An array
+|out_buf| contains characters that have been generated but not yet output,
+and there are three pointers into this array. One of these, |out_ptr|, is
+the number of characters currently in the buffer, and we will have
+|1<=out_ptr<=line_length| most of the time. The second is |break_ptr|,
+which is the largest value |<=out_ptr| such that we are definitely entitled
+to end a line by outputting the characters |out_buf[1..(break_ptr-1)]|;
+we will always have |break_ptr<=line_length|. Finally, |semi_ptr| is either
+zero or the largest known value of a legal break after a semicolon or comment
+on the current line; we will always have |semi_ptr<=break_ptr|.
+
+@<Globals...@>=
+@!out_buf: array [0..out_buf_size] of ASCII_code; {assembled characters}
+@!out_ptr: 0..out_buf_size; {first available place in |out_buf|}
+@!break_ptr: 0..out_buf_size; {last breaking place in |out_buf|}
+@!semi_ptr: 0..out_buf_size; {last semicolon breaking place in |out_buf|}
+
+@ Besides having those three pointers,
+the output process is in one of several states:
+
+\yskip\hang |num_or_id| means that the last item in the buffer is a number or
+identifier, hence a blank space or line break must be inserted if the next
+item is also a number or identifier.
+
+\yskip\hang |unbreakable| means that the last item in the buffer was followed
+by the \.{@@\&} operation that inhibits spaces between it and the next item.
+
+\yskip\hang |sign| means that the last item in the buffer is to be followed
+by \.+ or \.-, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val| means that the decimal equivalent of
+$\vert|out_val|\vert$ should be appended to the buffer. If |out_val<0|,
+or if |out_val=0| and |last_sign<0|, the number should be preceded by a minus
+sign. Otherwise it should be preceded by the character |out_sign| unless
+|out_sign=0|; the |out_sign| variable is either 0 or \.{"\ "} or \.{"+"}.
+
+\yskip\hang |sign_val_sign| is like |sign_val|, but also append \.+ or \.-
+afterwards, depending on whether |out_app| is positive or negative.
+
+\yskip\hang |sign_val_val| is like |sign_val|, but also append the decimal
+equivalent of |out_app| including its sign, using |last_sign| in case
+|out_app=0|.
+
+\yskip\hang |misc| means none of the above.
+
+\yskip\noindent
+For example, the output buffer and output state run through the following
+sequence as we generate characters from `\.{(x-15+19-2)}':
+$$\vbox{\halign{$\hfil#\hfil$\quad&#\hfil&\quad\hfil#\hfil&\quad
+\hfil#\hfil&\quad\hfil#\hfil&\quad\hfil#\hfil\quad&\hfil#\hfil\cr
+output&|out_buf|&|out_state|&|out_sign|&|out_val|&|out_app|&|last_sign|\cr
+\noalign{\vskip 3pt}
+(&\.(&|misc|\cr
+x&\.{(x}&|num_or_id|\cr
+-&\.{(x}&|sign|&&&$-1$&$-1$\cr
+15&\.{(x}&|sign_val|&\.{"+"}&$-15$&&$-15$\cr
++&\.{(x}&|sign_val_sign|&\.{"+"}&$-15$&$+1$&$+1$\cr
+19&\.{(x}&|sign_val_val|&\.{"+"}&$-15$&$+19$&$+1$\cr
+-&\.{(x}&|sign_val_sign|&\.{"+"}&$+4$&$-1$&$-1$\cr
+2&\.{(x}&|sign_val_val|&\.{"+"}&$+4$&$-2$&$-2$\cr
+)&\.{(x+2)}&|misc|\cr}}$$
+At each stage we have put as much into the buffer as possible without
+knowing what is coming next. Examples like `\.{x-0.1}' indicate why
+|last_sign| is needed to associate the proper sign with an output of zero.
+
+In states |num_or_id|, |unbreakable|, and |misc| the last item in the buffer
+lies between |break_ptr| and |out_ptr-1|, inclusive; in the other states we
+have |break_ptr=out_ptr|.
+
+The numeric values assigned to |num_or_id|, etc., have been chosen to
+shorten some of the program logic; for example, the program makes use of
+the fact that |sign+2=sign_val_sign|.
+
+@d misc=0 {state associated with special characters}
+@d num_or_id=1 {state associated with numbers and identifiers}
+@d sign=2 {state associated with pending \.+ or \.-}
+@d sign_val=num_or_id+2 {state associated with pending sign and value}
+@d sign_val_sign=sign+2 {|sign_val| followed by another pending sign}
+@d sign_val_val=sign_val+2 {|sign_val| followed by another pending value}
+@d unbreakable=sign_val_val+1 {state associated with \.{@@\&}}
+
+@<Globals...@>=
+@!out_state:eight_bits; {current status of partial output}
+@!out_val,@!out_app:integer; {pending values}
+@!out_sign:ASCII_code; {sign to use if appending |out_val>=0|}
+@!last_sign:-1..+1; {sign to use if appending a zero}
+
+@ During the output process, |line| will equal the number of the next line
+to be output.
+
+@<Initialize the output buffer@>=
+out_state:=misc; out_ptr:=0; break_ptr:=0; semi_ptr:=0; out_buf[0]:=0; line:=1;
+
+@ Here is a routine that is invoked when |out_ptr>line_length|
+or when it is time to flush out the final line. The |flush_buffer| procedure
+often writes out the line up to the current |break_ptr| position, then moves the
+remaining information to the front of |out_buf|. However, it prefers to
+write only up to |semi_ptr|, if the residual line won't be too long.
+
+@d check_break==if out_ptr>line_length then flush_buffer
+
+@p procedure flush_buffer; {writes one line to output file}
+var k:0..out_buf_size; {index into |out_buf|}
+@!b:0..out_buf_size; {value of |break_ptr| upon entry}
+begin b:=break_ptr;
+if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr;
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+if line mod 100 = 0 then
+  begin print('.');
+  if line mod 500 = 0 then print(line:1);
+  update_terminal; {progress report}
+  end;
+if break_ptr<out_ptr then
+  begin if out_buf[break_ptr]=" " then
+    begin incr(break_ptr); {drop space at break}
+    if break_ptr>b then b:=break_ptr;
+    end;
+  for k:=break_ptr to out_ptr-1 do out_buf[k-break_ptr]:=out_buf[k];
+  end;
+out_ptr:=out_ptr-break_ptr; break_ptr:=b-break_ptr; semi_ptr:=0;
+if out_ptr>line_length then
+  begin err_print('! Long line must be truncated'); out_ptr:=line_length;
+@.Long line must be truncated@>
+  end;
+end;
+
+@ @<Empty the last line from the buffer@>=
+break_ptr:=out_ptr; semi_ptr:=0; flush_buffer;
+if brace_level<>0 then
+  err_print('! Program ended at brace level ',brace_level:1);
+@.Program ended at brace level n@>
+
+@ Another simple and useful routine appends the decimal equivalent of
+a nonnegative integer to the output buffer.
+
+@d app(#)==begin out_buf[out_ptr]:=#; incr(out_ptr); {append a single character}
+  end
+
+@p procedure app_val(@!v:integer); {puts |v| into buffer, assumes |v>=0|}
+var k:0..out_buf_size; {index into |out_buf|}
+begin k:=out_buf_size; {first we put the digits at the very end of |out_buf|}
+repeat out_buf[k]:=v mod 10; v:=v div 10; decr(k);
+until v=0;
+repeat incr(k); app(out_buf[k]+"0");
+until k=out_buf_size; {then we append them, most significant first}
+end;
+
+@ The output states are kept up to date by the output routines, which are
+called |send_out|, |send_val|, and |send_sign|. The |send_out| procedure
+has two parameters: |t| tells the type of information being sent and
+|v| contains the information proper. Some information may also be passed
+in the array |out_contrib|.
+
+\yskip\hang If |t=misc| then |v| is a character to be output.
+
+\hang If |t=str| then |v| is the length of a string or something like `\.{<>}'
+in |out_contrib|.
+
+\hang If |t=ident| then |v| is the length of an identifier in |out_contrib|.
+
+\hang If |t=frac| then |v| is the length of a fraction and/or exponent in
+|out_contrib|.
+
+@d str=1 {|send_out| code for a string}
+@d ident=2 {|send_out| code for an identifier}
+@d frac=3 {|send_out| code for a fraction}
+
+@<Glob...@>=
+@!out_contrib:array[1..line_length] of ASCII_code; {a contribution to |out_buf|}
+
+@ A slightly subtle point in the following code is that the user may ask
+for a |join| operation (i.e., \.{@@\&}) following whatever is being sent
+out.  We will see later that |join| is implemented in part by calling
+|send_out(frac,0)|.
+
+@p procedure send_out(@!t:eight_bits; @!v:sixteen_bits);
+  {outputs |v| of type |t|}
+label restart;
+var k: 0..line_length; {index into |out_contrib|}
+begin @<Get the buffer ready for appending the new information@>;
+if t<>misc then for k:=1 to v do app(out_contrib[k])
+else app(v);
+check_break;
+if (t=misc)and((v=";")or(v="}")) then
+  begin semi_ptr:=out_ptr; break_ptr:=out_ptr;
+  end;
+if t>=ident then out_state:=num_or_id {|t=ident| or |frac|}
+else out_state:=misc {|t=str| or |misc|}
+end;
+
+@ Here is where the buffer states for signs and values collapse into simpler
+states, because we are about to append something that doesn't combine with
+the previous integer constants.
+
+We use an ASCII-code trick: Since |","-1="+"| and |","+1="-"|, we have
+|","-c=@t sign of $c$@>|, when $\vert c\vert=1$.
+
+@<Get the buffer ready...@>=
+restart: case out_state of
+num_or_id: if t<>frac then
+  begin break_ptr:=out_ptr;
+  if t=ident then app(" ");
+  end;
+sign: begin app(","-out_app); check_break; break_ptr:=out_ptr;
+  end;
+sign_val,sign_val_sign: begin @<Append \(|out_val| to buffer@>;
+  out_state:=out_state-2; goto restart;
+  end;
+sign_val_val: @<Reduce |sign_val_val| to |sign_val| and |goto restart|@>;
+misc: if t<>frac then break_ptr:=out_ptr;@/
+othercases do_nothing {this is for |unbreakable| state}
+endcases
+
+@ @<Append \(|out_val|...@>=
+if (out_val<0)or((out_val=0)and(last_sign<0)) then app("-")
+else if out_sign>0 then app(out_sign);
+app_val(abs(out_val)); check_break;
+
+@ @<Reduce |sign_val_val|...@>=
+begin if (t=frac)or(@<Contribution is \.* or \./ or \.{DIV} or \.{MOD}@>) then
+  begin @<Append \(|out_val| to buffer@>;
+  out_sign:="+"; out_val:=out_app;
+  end
+else out_val:=out_val+out_app;
+out_state:=sign_val; goto restart;
+end
+
+@ @<Contribution is \.*...@>=
+((t=ident)and(v=3)and@|
+ (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@|
+ ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@|
+@^uppercase@>
+ ((t=misc)and((v="*")or(v="/")))
+
+@ The following routine is called with $v=\pm1$ when a plus or minus sign is
+appended to the output. It extends \PASCAL\ to allow repeated signs
+(e.g., `\.{--}' is equivalent to `\.+'), rather than to give an error message.
+The signs following `\.E' in real constants are treated as part of a fraction,
+so they are not seen by this routine.
+
+@p procedure send_sign(@!v:integer);
+begin case out_state of
+sign, sign_val_sign: out_app:=out_app*v;
+sign_val:begin out_app:=v; out_state:=sign_val_sign;
+  end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+  out_state:=sign_val_sign;
+  end;
+othercases begin break_ptr:=out_ptr; out_app:=v; out_state:=sign;
+  end
+endcases;@/
+last_sign:=out_app;
+end;
+
+@ When a (signed) integer value is to be output, we call |send_val|.
+
+@d bad_case=666 {this is a label used below}
+
+@p procedure send_val(@!v:integer); {output the (signed) value |v|}
+label bad_case, {go here if we can't keep |v| in the output state}
+  exit;
+begin case out_state of
+num_or_id: begin @<If previous output was \.{DIV} or \.{MOD}, |goto bad_case|@>;
+  out_sign:=" "; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+  last_sign:=+1;
+  end;
+misc: begin @<If previous output was \.* or \./, |goto bad_case|@>;
+  out_sign:=0; out_state:=sign_val; out_val:=v; break_ptr:=out_ptr;
+  last_sign:=+1;
+  end;
+@t\4@>@<Handle cases of |send_val| when |out_state| contains a sign@>@;
+othercases goto bad_case
+endcases;@/
+return;
+bad_case: @<Append the decimal value of |v|, with parentheses if negative@>;
+exit: end;
+
+@ @<Handle cases of |send_val|...@>=
+sign: begin out_sign:="+"; out_state:=sign_val; out_val:=out_app*v;
+  end;
+sign_val: begin out_state:=sign_val_val; out_app:=v;
+  err_print('! Two numbers occurred without a sign between them');
+  end;
+sign_val_sign: begin out_state:=sign_val_val; out_app:=out_app*v;
+  end;
+sign_val_val: begin out_val:=out_val+out_app; out_app:=v;
+  err_print('! Two numbers occurred without a sign between them');
+@.Two numbers occurred...@>
+  end;
+
+@ @<If previous output was \.*...@>=
+if (out_ptr=break_ptr+1)and((out_buf[break_ptr]="*")or(out_buf[break_ptr]="/"))
+  then goto bad_case
+
+@ @<If previous output was \.{DIV}...@>=
+if (out_ptr=break_ptr+3)or
+ ((out_ptr=break_ptr+4)and(out_buf[break_ptr]=" ")) then
+@^uppercase@>
+  if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and
+    (out_buf[out_ptr-1]="V"))or @/
+     ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and
+    (out_buf[out_ptr-1]="D")) then@/ goto bad_case
+
+@ @<Append the decimal value...@>=
+if v>=0 then
+  begin if out_state=num_or_id then
+    begin break_ptr:=out_ptr; app(" ");
+    end;
+  app_val(v); check_break; out_state:=num_or_id;
+  end
+else  begin app("("); app("-"); app_val(-v); app(")"); check_break;
+  out_state:=misc;
+  end
+
+@* The big output switch.
+To complete the output process, we need a routine that takes the results
+of |get_output| and feeds them to |send_out|, |send_val|, or |send_sign|.
+This procedure `|send_the_output|' will be invoked just once, as follows:
+
+@<Phase II: Output the contents of the compressed tables@>=
+if text_link[0]=0 then
+  begin print_nl('! No output was specified.'); mark_harmless;
+@.No output was specified@>
+  end
+else  begin print_nl('Writing the output file'); update_terminal;@/
+  @<Initialize the output stacks@>;
+  @<Initialize the output buffer@>;
+  send_the_output;@/
+  @<Empty the last line...@>;
+  print_nl('Done.');
+  end
+
+@ A many-way switch is used to send the output:
+
+@d get_fraction=2 {this label is used below}
+
+@p procedure send_the_output;
+label get_fraction, {go here to finish scanning a real constant}
+  reswitch, continue;
+var cur_char:eight_bits; {the latest character received}
+  @!k:0..line_length; {index into |out_contrib|}
+  @!j:0..max_bytes; {index into |byte_mem|}
+  @!w:0..ww-1; {segment of |byte_mem|}
+  @!n:integer; {number being scanned}
+begin while stack_ptr>0 do
+  begin cur_char:=get_output;
+  reswitch: case cur_char of
+  0: do_nothing; {this case might arise if output ends unexpectedly}
+  @t\4@>@<Cases related to identifiers@>@;
+  @t\4@>@<Cases related to constants, possibly leading to
+    |get_fraction| or |reswitch|@>@;
+  "+","-": send_sign(","-cur_char);
+  @t\4@>@<Cases like \.{<>} and \.{:=}@>@;
+  "'": @<Send a string, |goto reswitch|@>;
+  @<Other printable characters@>: send_out(misc,cur_char);
+  @t\4@>@<Cases involving \.{@@\{} and \.{@@\}}@>@;
+  join: begin send_out(frac,0); out_state:=unbreakable;
+    end;
+  verbatim: @<Send verbatim string@>;
+  force_line: @<Force a line break@>;
+  othercases err_print('! Can''t output ASCII code ',cur_char:1)
+@.Can't output ASCII code n@>
+  endcases;@/
+  goto continue;
+  get_fraction: @<Special code to finish real constants@>;
+  continue: end;
+end;
+
+@ @<Cases like \.{<>}...@>=
+and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D";
+@^uppercase@>
+  send_out(ident,3);
+  end;
+not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T";
+  send_out(ident,3);
+  end;
+set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N";
+  send_out(ident,2);
+  end;
+or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2);
+  end;
+left_arrow: begin out_contrib[1]:=":"; out_contrib[2]:="="; send_out(str,2);
+  end;
+not_equal: begin out_contrib[1]:="<"; out_contrib[2]:=">"; send_out(str,2);
+  end;
+less_or_equal: begin out_contrib[1]:="<"; out_contrib[2]:="="; send_out(str,2);
+  end;
+greater_or_equal: begin out_contrib[1]:=">"; out_contrib[2]:="=";
+  send_out(str,2);
+  end;
+equivalence_sign: begin out_contrib[1]:="="; out_contrib[2]:="=";
+  send_out(str,2);
+  end;
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+  end;
+
+@ Please don't ask how all of the following characters can actually get
+through \.{TANGLE} outside of strings. It seems that |""""| and |"{"|
+cannot actually occur at this point of the program, but they have
+been included just in case \.{TANGLE} changes.
+
+If \.{TANGLE} is producing code for a \PASCAL\ compiler that uses `\.{(.}'
+and `\.{.)}' instead of square brackets (e.g., on machines with {\mc EBCDIC}
+code), one should remove |"["| and |"]"| from this list and put them into
+the preceding module in the appropriate way. Similarly, some compilers
+want `\.\^' to be converted to `\.{@@}'.
+@^system dependencies@>@^EBCDIC@>
+
+@<Other printable characters@>=
+"!","""","#","$","%","&","(",")","*",",","/",":",";","<","=",">","?",
+"@@","[","\","]","^","_","`","{","|"
+
+@ Single-character identifiers represent themselves, while longer ones
+appear in |byte_mem|. All must be converted to uppercase,
+with underlines removed. Extremely long identifiers must be chopped.
+
+(Some \PASCAL\ compilers work with lowercase letters instead of
+uppercase. If this module of \.{TANGLE} is changed, it's also necessary
+to change from uppercase to lowercase in the modules that are
+listed in the index under ``uppercase''.)
+@^system dependencies@>
+@^uppercase@>
+
+@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14,
+  #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,#
+
+@<Cases related to identifiers@>=
+"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1);
+  end;
+"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1);
+  end;
+identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww;
+  while (k<max_id_length)and(j<byte_start[cur_val+ww]) do
+    begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j);
+    if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40
+    else if out_contrib[k]="_" then decr(k);
+    end;
+  send_out(ident,k);
+  end;
+
+@ After sending a string, we need to look ahead at the next character, in order
+to see if there were two consecutive single-quote marks. Afterwards we go to
+|reswitch| to process the next character.
+
+@<Send a string...@>=
+begin k:=1; out_contrib[1]:="'";
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]="'")or(stack_ptr=0);
+if k=line_length then err_print('! String too long');
+@.String too long@>
+send_out(str,k); cur_char:=get_output;
+if cur_char="'" then out_state:=unbreakable;
+goto reswitch;
+end
+
+@ Sending a verbatim string is similar, but we don't have to look ahead.
+
+@<Send verbatim string@>=
+begin k:=0;
+repeat if k<line_length then incr(k);
+out_contrib[k]:=get_output;
+until (out_contrib[k]=verbatim)or(stack_ptr=0);
+if k=line_length then err_print('! Verbatim string too long');
+@.Verbatim string too long@>
+send_out(str,k-1);
+end
+
+@ In order to encourage portable software, \.{TANGLE} complains
+if the constants get dangerously close to the largest value representable
+on a 32-bit computer ($2^{31}-1$).
+
+@d digits=="0","1","2","3","4","5","6","7","8","9"
+
+@<Cases related to constants...@>=
+digits: begin n:=0;
+  repeat cur_char:=cur_char-"0";
+  if n>=@'1463146314 then err_print('! Constant too big')
+@.Constant too big@>
+  else n:=10*n+cur_char;
+  cur_char:=get_output;
+  until (cur_char>"9")or(cur_char<"0");
+  send_val(n); k:=0;
+  if cur_char="e" then cur_char:="E";
+@^uppercase@>
+  if cur_char="E" then goto get_fraction
+  else goto reswitch;
+  end;
+check_sum: send_val(pool_check_sum);
+octal: begin n:=0; cur_char:="0";
+  repeat cur_char:=cur_char-"0";
+  if n>=@'2000000000 then err_print('! Constant too big')
+  else n:=8*n+cur_char;
+  cur_char:=get_output;
+  until (cur_char>"7")or(cur_char<"0");
+  send_val(n); goto reswitch;
+  end;
+hex: begin n:=0; cur_char:="0";
+  repeat if cur_char>="A" then cur_char:=cur_char+10-"A"
+  else cur_char:=cur_char-"0";
+  if n>=@"8000000 then err_print('! Constant too big')
+  else n:=16*n+cur_char;
+  cur_char:=get_output;
+  until (cur_char>"F")or(cur_char<"0")or@|
+    ((cur_char>"9")and(cur_char<"A"));
+  send_val(n); goto reswitch;
+  end;
+number: send_val(cur_val);
+".":  begin k:=1; out_contrib[1]:="."; cur_char:=get_output;
+  if cur_char="." then
+    begin out_contrib[2]:="."; send_out(str,2);
+    end
+  else if (cur_char>="0")and(cur_char<="9") then goto get_fraction
+  else  begin send_out(misc,"."); goto reswitch;
+    end;
+  end;
+
+@ The following code appears at label `|get_fraction|', when we want to
+scan to the end of a real constant. The first |k| characters of a fraction
+have already been placed in |out_contrib|, and |cur_char| is the next character.
+
+@<Special code...@>=
+repeat if k<line_length then incr(k);
+out_contrib[k]:=cur_char; cur_char:=get_output;
+if (out_contrib[k]="E")and((cur_char="+")or(cur_char="-")) then
+@^uppercase@>
+  begin if k<line_length then incr(k);
+  out_contrib[k]:=cur_char; cur_char:=get_output;
+  end
+else if cur_char="e" then cur_char:="E";
+until (cur_char<>"E")and((cur_char<"0")or(cur_char>"9"));
+if k=line_length then err_print('! Fraction too long');
+@.Fraction too long@>
+send_out(frac,k); goto reswitch
+
+@ Some \PASCAL\ compilers do not recognize comments in braces, so the
+comments must be delimited by `\.{(*}' and `\.{*)}'.
+@^system dependencies@>
+In such cases the statement `|send_out(misc,"{")|' that appears here should
+be replaced by `\ignorespaces|begin out_contrib[1]:="("; out_contrib[2]:="*";
+send_out(str,2); end|', and a similar change should be made to
+`|send_out(misc,"}")|'.
+
+@<Cases involving \.{@@\{} and \.{@@\}}@>=
+begin_comment: begin if brace_level=0 then send_out(misc,"{")
+  else send_out(misc,"[");
+  incr(brace_level);
+  end;
+end_comment: if brace_level>0 then
+    begin decr(brace_level);
+    if brace_level=0 then send_out(misc,"}")
+    else send_out(misc,"]");
+    end
+  else err_print('! Extra @@}');
+@.Extra \AT!\}@>
+module_number: begin if brace_level=0 then send_out(misc,"{")
+  else send_out(misc,"[");
+  if cur_val<0 then
+    begin send_out(misc,":"); send_val(-cur_val);
+    end
+  else  begin send_val(cur_val); send_out(misc,":");
+    end;
+  if brace_level=0 then send_out(misc,"}")
+  else send_out(misc,"]");
+  end;
+
+@ @<Force a line break@>=
+begin send_out(str,0); {normalize the buffer}
+while out_ptr>0 do
+  begin if out_ptr<=line_length then break_ptr:=out_ptr;
+  flush_buffer;
+  end;
+out_state:=misc;
+end
+
+@* Introduction to the input phase.
+We have now seen that \.{TANGLE} will be able to output the full
+\PASCAL\ program, if we can only get that program into the byte memory in
+the proper format. The input process is something like the output process
+in reverse, since we compress the text as we read it in and we expand it
+as we write it out.
+
+There are three main input routines. The most interesting is the one that gets
+the next token of a \PASCAL\ text; the other two are used to scan rapidly past
+\TeX\ text in the \.{WEB} source code. One of the latter routines will jump to
+the next token that starts with `\.{@@}', and the other skips to the end
+of a \PASCAL\ comment.
+
+@ But first we need to consider the low-level routine |get_line|
+that takes care of merging |change_file| into |web_file|. The |get_line|
+procedure also updates the line numbers for error messages.
+
+@<Globals...@>=
+@!ii:integer; {general purpose |for| loop variable in the outer block}
+@!line:integer; {the number of the current line in the current file}
+@!other_line:integer; {the number of the current line in the input file that
+  is not currently being read}
+@!temp_line:integer; {used when interchanging |line| with |other_line|}
+@!limit:0..buf_size; {the last character position occupied in the buffer}
+@!loc:0..buf_size; {the next character position to be read from the buffer}
+@!input_has_ended: boolean; {if |true|, there is no more input}
+@!changing: boolean; {if |true|, the current line is from |change_file|}
+
+@ As we change |changing| from |true| to |false| and back again, we must
+remember to swap the values of |line| and |other_line| so that the |err_print|
+routine will be sure to report the correct line number.
+
+@d change_changing==
+  changing := not changing;
+  temp_line:=other_line; other_line:=line; line:=temp_line
+    {|line @t$\null\BA\null$@> other_line|}
+
+@ When |changing| is |false|, the next line of |change_file| is kept in
+|change_buffer[0..change_limit]|, for purposes of comparison with the next
+line of |web_file|. After the change file has been completely input, we
+set |change_limit:=0|, so that no further matches will be made.
+
+@<Globals...@>=
+@!change_buffer:array[0..buf_size] of ASCII_code;
+@!change_limit:0..buf_size; {the last position occupied in |change_buffer|}
+
+@ Here's a simple function that checks if the two buffers are different.
+
+@p function lines_dont_match:boolean;
+label exit;
+var k:0..buf_size; {index into the buffers}
+begin lines_dont_match:=true;
+if change_limit<>limit then return;
+if limit>0 then
+  for k:=0 to limit-1 do if change_buffer[k]<>buffer[k] then return;
+lines_dont_match:=false;
+exit: end;
+
+@ Procedure |prime_the_change_buffer| sets |change_buffer| in preparation
+for the next matching operation. Since blank lines in the change file are
+not used for matching, we have |(change_limit=0)and not changing| if and
+only if the change file is exhausted. This procedure is called only
+when |changing| is true; hence error messages will be reported correctly.
+
+@p procedure prime_the_change_buffer;
+label continue, done, exit;
+var k:0..buf_size; {index into the buffers}
+begin change_limit:=0; {this value will be used if the change file ends}
+@<Skip over comment lines in the change file; |return| if end of file@>;
+@<Skip to the next nonblank line; |return| if end of file@>;
+@<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>;
+exit: end;
+
+@ While looking for a line that begins with \.{@@x} in the change file,
+we allow lines that begin with \.{@@}, as long as they don't begin with
+\.{@@y} or \.{@@z} (which would probably indicate that the change file is
+fouled up).
+
+@<Skip over comment lines in the change file...@>=
+loop@+  begin incr(line);
+  if not input_ln(change_file) then return;
+  if limit<2 then goto continue;
+  if buffer[0]<>"@@" then goto continue;
+  if (buffer[1]>="X")and(buffer[1]<="Z") then
+    buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+  if buffer[1]="x" then goto done;
+  if (buffer[1]="y")or(buffer[1]="z") then
+    begin loc:=2; err_print('! Where is the matching @@x?');
+@.Where is the match...@>
+    end;
+continue: end;
+done:
+
+@ Here we are looking at lines following the \.{@@x}.
+
+@<Skip to the next nonblank line...@>=
+repeat incr(line);
+  if not input_ln(change_file) then
+    begin err_print('! Change file ended after @@x');
+@.Change file ended...@>
+    return;
+    end;
+until limit>0;
+
+@ @<Move |buffer| and |limit| to |change_buffer| and |change_limit|@>=
+begin change_limit:=limit;
+if limit>0 then for k:=0 to limit-1 do change_buffer[k]:=buffer[k];
+end
+
+@ The following procedure is used to see if the next change entry should
+go into effect; it is called only when |changing| is false.
+The idea is to test whether or not the current
+contents of |buffer| matches the current contents of |change_buffer|.
+If not, there's nothing more to do; but if so, a change is called for:
+All of the text down to the \.{@@y} is supposed to match. An error
+message is issued if any discrepancy is found. Then the procedure
+prepares to read the next line from |change_file|.
+
+@p procedure check_change; {switches to |change_file| if the buffers match}
+label exit;
+var n:integer; {the number of discrepancies found}
+@!k:0..buf_size; {index into the buffers}
+begin if lines_dont_match then return;
+n:=0;
+loop@+  begin change_changing; {now it's |true|}
+  incr(line);
+  if not input_ln(change_file) then
+    begin err_print('! Change file ended before @@y');
+@.Change file ended...@>
+    change_limit:=0;  change_changing; {|false| again}
+    return;
+    end;
+  @<If the current line starts with \.{@@y},
+    report any discrepancies and |return|@>;
+  @<Move |buffer| and |limit|...@>;
+  change_changing; {now it's |false|}
+  incr(line);
+  if not input_ln(web_file) then
+    begin err_print('! WEB file ended during a change');
+@.WEB file ended...@>
+    input_has_ended:=true; return;
+    end;
+  if lines_dont_match then incr(n);
+  end;
+exit: end;
+
+@ @<If the current line starts with \.{@@y}...@>=
+if limit>1 then if buffer[0]="@@" then
+  begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+    buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+  if (buffer[1]="x")or(buffer[1]="z") then
+    begin loc:=2; err_print('! Where is the matching @@y?');
+@.Where is the match...@>
+    end
+  else if buffer[1]="y" then
+    begin if n>0 then
+      begin loc:=2; err_print('! Hmm... ',n:1,
+        ' of the preceding lines failed to match');
+@.Hmm... n of the preceding...@>
+      end;
+    return;
+    end;
+  end
+
+@ @<Initialize the input system@>=
+open_input; line:=0; other_line:=0;@/
+changing:=true; prime_the_change_buffer; change_changing;@/
+limit:=0; loc:=1; buffer[0]:=" "; input_has_ended:=false;
+
+@ The |get_line| procedure is called when |loc>limit|; it puts the next
+line of merged input into the buffer and updates the other variables
+appropriately. A space is placed at the right end of the line.
+
+@p procedure get_line; {inputs the next line}
+label restart;
+begin restart: if changing then
+  @<Read from |change_file| and maybe turn off |changing|@>;
+if not changing then
+  begin @<Read from |web_file| and maybe turn on |changing|@>;
+  if changing then goto restart;
+  end;
+loc:=0; buffer[limit]:=" ";
+end;
+
+@ @<Read from |web_file|...@>=
+begin incr(line);
+if not input_ln(web_file) then input_has_ended:=true
+else if limit=change_limit then
+  if buffer[0]=change_buffer[0] then
+    if change_limit>0 then check_change;
+end
+
+@ @<Read from |change_file|...@>=
+begin incr(line);
+if not input_ln(change_file) then
+  begin err_print('! Change file ended without @@z');
+@.Change file ended...@>
+  buffer[0]:="@@"; buffer[1]:="z"; limit:=2;
+  end;
+if limit>1 then {check if the change has ended}
+  if buffer[0]="@@" then
+    begin if (buffer[1]>="X")and(buffer[1]<="Z") then
+      buffer[1]:=buffer[1]+"z"-"Z"; {lowercasify}
+    if (buffer[1]="x")or(buffer[1]="y") then
+      begin loc:=2; err_print('! Where is the matching @@z?');
+@.Where is the match...@>
+      end
+    else if buffer[1]="z" then
+      begin prime_the_change_buffer; change_changing;
+      end;
+    end;
+end
+
+@ At the end of the program, we will tell the user if the change file
+had a line that didn't match any relevant line in |web_file|.
+
+@<Check that all changes have been read@>=
+if change_limit<>0 then {|changing| is false}
+  begin for ii:=0 to change_limit do buffer[ii]:=change_buffer[ii];
+  limit:=change_limit; changing:=true; line:=other_line; loc:=change_limit;
+  err_print('! Change file entry did not match');
+@.Change file entry did not match@>
+  end
+
+@ Important milestones are reached during the input phase when certain
+control codes are sensed.
+
+Control codes in \.{WEB} begin with `\.{@@}', and the next character
+identifies the code. Some of these are of interest only to \.{WEAVE},
+so \.{TANGLE} ignores them; the others are converted by \.{TANGLE} into
+internal code numbers by the |control_code| function below. The ordering
+of these internal code numbers has been chosen to simplify the program logic;
+larger numbers are given to the control codes that denote more significant
+milestones.
+
+@d ignore=0 {control code of no interest to \.{TANGLE}}
+@d control_text=@'203 {control code for `\.{@@t}', `\.{@@\^}', etc.}
+@d format=@'204 {control code for `\.{@@f}'}
+@d definition=@'205 {control code for `\.{@@d}'}
+@d begin_Pascal=@'206 {control code for `\.{@@p}'}
+@d module_name=@'207 {control code for `\.{@@<}'}
+@d new_module=@'210 {control code for `\.{@@\ }' and `\.{@@*}'}
+
+@p function control_code(@!c:ASCII_code):eight_bits; {convert |c| after \.{@@}}
+begin case c of
+"@@": control_code:="@@"; {`quoted' at sign}
+"'": control_code:=octal; {precedes octal constant}
+"""": control_code:=hex; {precedes hexadecimal constant}
+"$": control_code:=check_sum; {string pool check sum}
+" ",tab_mark: control_code:=new_module; {beginning of a new module}
+"*": begin print('*',module_count+1:1);
+  update_terminal; {print a progress report}
+  control_code:=new_module; {beginning of a new module}
+  end;
+"D","d": control_code:=definition; {macro definition}
+"F","f": control_code:=format; {format definition}
+"{": control_code:=begin_comment; {begin-comment delimiter}
+"}": control_code:=end_comment; {end-comment delimiter}
+"P","p": control_code:=begin_Pascal; {\PASCAL\ text in unnamed module}
+"T","t","^",".",":": control_code:=control_text; {control text to be ignored}
+"&": control_code:=join; {concatenate two tokens}
+"<": control_code:=module_name; {beginning of a module name}
+"=": control_code:=verbatim; {beginning of \PASCAL\ verbatim mode}
+"\": control_code:=force_line; {force a new line in \PASCAL\ output}
+othercases control_code:=ignore {ignore all other cases}
+endcases;
+end;
+
+@ The |skip_ahead| procedure reads through the input at fairly high speed
+until finding the next non-ignorable control code, which it returns.
+
+@p function skip_ahead:eight_bits; {skip to next control code}
+label done;
+var c:eight_bits; {control code found}
+begin loop begin if loc>limit then
+    begin get_line;
+    if input_has_ended then
+      begin c:=new_module; goto done;
+      end;
+    end;
+  buffer[limit+1]:="@@";
+  while buffer[loc]<>"@@" do incr(loc);
+  if loc<=limit then
+    begin loc:=loc+2; c:=control_code(buffer[loc-1]);
+    if (c<>ignore)or(buffer[loc-1]=">") then goto done;
+    end;
+  end;
+done: skip_ahead:=c;
+end;
+
+@ The |skip_comment| procedure reads through the input at somewhat high speed
+until finding the first unmatched right brace or until coming to the end
+of the file. It ignores characters following `\.\\' characters, since all
+braces that aren't nested are supposed to be hidden in that way. For
+example, consider the process of skipping the first comment below,
+where the string containing the right brace has been typed as \.{\`\\.\\\}\'}
+in the \.{WEB} file.
+
+@p procedure skip_comment; {skips to next unmatched `\.\}'}
+label exit;
+var bal:eight_bits; {excess of left braces}
+@!c:ASCII_code; {current character}
+begin bal:=0;
+loop@+  begin if loc>limit then
+    begin get_line;
+    if input_has_ended then
+      begin err_print('! Input ended in mid-comment');
+@.Input ended in mid-comment@>
+      return;
+      end;
+    end;
+  c:=buffer[loc]; incr(loc);
+  @<Do special things when |c="@@", "\", "{", "}"|; |return| at end@>;
+  end;
+exit:end;
+
+@ @<Do special things when |c="@@"...@>=
+if c="@@" then
+  begin c:=buffer[loc];
+  if (c<>" ")and(c<>tab_mark)and(c<>"*")and(c<>"z")and(c<>"Z") then incr(loc)
+  else  begin err_print('! Section ended in mid-comment');
+@.Section ended in mid-comment@>
+    decr(loc); return;
+    end
+  end
+else if (c="\")and(buffer[loc]<>"@@") then incr(loc)
+else if c="{" then incr(bal)
+else if c="}" then
+  begin if bal=0 then return;
+  decr(bal);
+  end
+
+@* Inputting the next token.
+As stated above, \.{TANGLE}'s most interesting input procedure is the
+|get_next| routine that inputs the next token. However, the procedure
+isn't especially difficult.
+
+In most cases the tokens output by |get_next| have the form used in
+replacement texts, except that two-byte tokens are not produced.
+An identifier that isn't one letter long is represented by the
+output `|identifier|', and in such a case the global variables
+|id_first| and |id_loc| will have been set to the appropriate values
+needed by the |id_lookup| procedure. A string that begins with a
+double-quote is also considered an |identifier|, and in such a case
+the global variable |double_chars| will also have been set appropriately.
+Control codes produce the corresponding output of the |control_code|
+function above; and if that code is |module_name|, the value of |cur_module|
+will point to the |byte_start| entry for that module name.
+
+Another global variable, |scanning_hex|, is |true| during the time that
+the letters \.A through \.F should be treated as if they were digits.
+
+@<Globals...@>=
+@!cur_module: name_pointer; {name of module just scanned}
+@!scanning_hex: boolean; {are we scanning a hexadecimal constant?}
+
+@ @<Set init...@>=
+scanning_hex:=false;
+
+@ At the top level, |get_next| is a multi-way switch based on the next
+character in the input buffer. A |new_module| code is inserted at the
+very end of the input file.
+
+@p function get_next:eight_bits; {produces the next input token}
+label restart,done,found;
+var c:eight_bits; {the current character}
+@!d:eight_bits; {the next character}
+@!j,@!k:0..longest_name; {indices into |mod_text|}
+begin restart: if loc>limit then
+  begin get_line;
+  if input_has_ended then
+    begin c:=new_module; goto found;
+    end;
+  end;
+c:=buffer[loc]; incr(loc);
+if scanning_hex then @<Go to |found| if |c| is a hexadecimal digit,
+  otherwise set |scanning_hex:=false|@>;
+case c of
+"A",up_to("Z"),"a",up_to("z"): @<Get an identifier@>;
+"""": @<Get a preprocessed string@>;
+"@@": @<Get control code and possible module name@>;
+@t\4@>@<Compress two-symbol combinations like `\.{:=}'@>@;
+" ",tab_mark: goto restart; {ignore spaces and tabs}
+"{": begin skip_comment; goto restart;
+  end;
+"}": begin err_print('! Extra }'); goto restart;
+@.Extra \}@>
+  end;
+othercases if c>=128 then goto restart {ignore nonstandard characters}
+  else do_nothing
+endcases;
+found:@!debug if trouble_shooting then debug_help;@;@+gubed@/
+get_next:=c;
+end;
+
+@ @<Go to |found| if |c| is a hexadecimal digit...@>=
+if ((c>="0")and(c<="9"))or((c>="A")and(c<="F")) then goto found
+else scanning_hex:=false
+
+@ Note that the following code substitutes \.{@@\{} and \.{@@\}} for the
+respective combinations `\.{(*}' and `\.{*)}'. Explicit braces should be used
+for \TeX\ comments in \PASCAL\ text.
+
+@d compress(#)==begin if loc<=limit then begin c:=#; incr(loc); end; end
+
+@<Compress two-symbol...@>=
+".": if buffer[loc]="." then compress(double_dot)
+  else if buffer[loc]=")" then compress("]");
+":": if buffer[loc]="=" then compress(left_arrow);
+"=": if buffer[loc]="=" then compress(equivalence_sign);
+">": if buffer[loc]="=" then compress(greater_or_equal);
+"<": if buffer[loc]="=" then compress(less_or_equal)
+  else if buffer[loc]=">" then compress(not_equal);
+"(": if buffer[loc]="*" then compress(begin_comment)
+  else if buffer[loc]="." then compress("[");
+"*": if buffer[loc]=")" then compress(end_comment);
+
+@ We have to look at the preceding character to make sure this isn't part
+of a real constant, before trying to find an identifier starting with
+`\.e' or `\.E'.
+
+@<Get an identifier@>=
+begin if ((c="e")or(c="E"))and(loc>1) then
+  if (buffer[loc-2]<="9")and(buffer[loc-2]>="0") then c:=0;
+if c<>0 then
+  begin decr(loc); id_first:=loc;
+  repeat incr(loc); d:=buffer[loc];
+  until ((d<"0")or((d>"9")and(d<"A"))or((d>"Z")and(d<"a"))or(d>"z")) and
+    (d<>"_");
+  if loc>id_first+1 then
+    begin c:=identifier; id_loc:=loc;
+    end;
+  end
+else c:="E"; {exponent of a real constant}
+end
+
+@ A string that starts and ends with double-quote marks is converted into
+an identifier that behaves like a numeric macro by means of the following
+piece of the program.
+@^preprocessed strings@>
+
+@<Get a preprocessed string@>=
+begin double_chars:=0; id_first:=loc-1;
+repeat d:=buffer[loc]; incr(loc);
+  if (d="""")or(d="@@") then
+    if buffer[loc]=d then
+      begin incr(loc); d:=0; incr(double_chars);
+      end
+    else  begin if d="@@" then err_print('! Double @@ sign missing')
+@.Double \AT! sign missing@>
+      end
+  else if loc>limit then
+    begin err_print('! String constant didn''t end'); d:="""";
+@.String constant didn't end@>
+    end;
+until d="""";
+id_loc:=loc-1; c:=identifier;
+end
+
+@ After an \.{@@} sign has been scanned, the next character tells us
+whether there is more work to do.
+
+@<Get control code and possible module name@>=
+begin c:=control_code(buffer[loc]); incr(loc);
+if c=ignore then goto restart
+else if c=hex then scanning_hex:=true
+else if c=module_name then
+  @<Scan the \(module name and make |cur_module| point to it@>
+else if c=control_text then
+  begin repeat c:=skip_ahead;
+  until c<>"@@";
+  if buffer[loc-1]<>">" then
+    err_print('! Improper @@ within control text');
+@.Improper \AT! within control text@>
+  goto restart;
+  end;
+end
+
+@ @<Scan the \(module name...@>=
+begin @<Put module name into |mod_text[1..k]|@>;
+if k>3 then
+  begin if (mod_text[k]=".")and(mod_text[k-1]=".")and(mod_text[k-2]=".") then
+    cur_module:=prefix_lookup(k-3)
+  else cur_module:=mod_lookup(k);
+  end
+else cur_module:=mod_lookup(k);
+end
+
+@ Module names are placed into the |mod_text| array with consecutive spaces,
+tabs, and carriage-returns replaced by single spaces. There will be no
+spaces at the beginning or the end. (We set |mod_text[0]:=" "| to facilitate
+this, since the |mod_lookup| routine uses |mod_text[1]| as the first
+character of the name.)
+
+@<Set init...@>=mod_text[0]:=" ";
+
+@ @<Put module name...@>=
+k:=0;
+loop@+  begin if loc>limit then
+    begin get_line;
+    if input_has_ended then
+      begin err_print('! Input ended in section name');
+@.Input ended in section name@>
+      goto done;
+      end;
+    end;
+  d:=buffer[loc];
+  @<If end of name, |goto done|@>;
+  incr(loc); if k<longest_name-1 then incr(k);
+  if (d=" ")or(d=tab_mark) then
+    begin d:=" "; if mod_text[k-1]=" " then decr(k);
+    end;
+  mod_text[k]:=d;
+  end;
+done: @<Check for overlong name@>;
+if (mod_text[k]=" ")and(k>0) then decr(k);
+
+@ @<If end of name,...@>=
+if d="@@" then
+  begin d:=buffer[loc+1];
+  if d=">" then
+    begin loc:=loc+2; goto done;
+    end;
+  if (d=" ")or(d=tab_mark)or(d="*") then
+    begin err_print('! Section name didn''t end'); goto done;
+@.Section name didn't end@>
+    end;
+  incr(k); mod_text[k]:="@@"; incr(loc); {now |d=buffer[loc]| again}
+  end
+
+@ @<Check for overlong name@>=
+if k>=longest_name-2 then
+  begin print_nl('! Section name too long: ');
+@.Section name too long@>
+  for j:=1 to 25 do print(xchr[mod_text[j]]);
+  print('...'); mark_harmless;
+  end
+
+@* Scanning a numeric definition.
+When \.{TANGLE} looks at the \PASCAL\ text following the `\.=' of a numeric
+macro definition, it calls on the precedure |scan_numeric(p)|, where |p|
+points to the name that is to be defined. This procedure evaluates the
+right-hand side, which must consist entirely of integer constants and
+defined numeric macros connected with \.+ and \.- signs (no parentheses).
+It also sets the global variable |next_control| to the control code that
+terminated this definition.
+
+A definition ends with the control codes |definition|, |format|, |module_name|,
+|begin_Pascal|, and |new_module|, all of which can be recognized
+by the fact that they are the largest values |get_next| can return.
+
+@d end_of_definition(#)==(#>=format)
+  {is |#| a control code ending a definition?}
+
+@<Global...@>=
+@!next_control:eight_bits; {control code waiting to be acted upon}
+
+@ The evaluation of a numeric expression makes use of two variables called the
+|accumulator| and the |next_sign|. At the beginning, |accumulator| is zero and
+|next_sign| is $+1$. When a \.+ or \.- is scanned, |next_sign| is multiplied
+by the value of that sign. When a numeric value is scanned, it is multiplied by
+|next_sign| and added to the |accumulator|, then |next_sign| is reset to $+1$.
+
+@d add_in(#)==begin accumulator:=accumulator+next_sign*(#); next_sign:=+1;
+  end
+
+@p procedure scan_numeric(@!p:name_pointer); {defines numeric macros}
+label reswitch, done;
+var accumulator:integer; {accumulates sums}
+@!next_sign:-1..+1; {sign to attach to next value}
+@!q:name_pointer; {points to identifiers being evaluated}
+@!val:integer; {constants being evaluated}
+begin @<Set \(|accumulator| to the value of the right-hand side@>;
+if abs(accumulator)>=1073741824 then
+  begin err_print('! Value too big: ',accumulator:1); accumulator:=0;
+@.Value too big@>
+  end;
+equiv[p]:=accumulator+1073741824;
+  {name |p| now is defined to equal |accumulator|}
+end;
+
+@ @<Set \(|accumulator| to the value of the right-hand side@>=
+accumulator:=0; next_sign:=+1;
+loop@+  begin next_control:=get_next;
+  reswitch: case next_control of
+  digits: begin @<Set |val| to value of decimal constant, and
+      set |next_control| to the following token@>;
+    add_in(val); goto reswitch;
+    end;
+  octal: begin @<Set |val| to value of octal constant, and
+      set |next_control| to the following token@>;
+    add_in(val); goto reswitch;
+    end;
+  hex: begin @<Set |val| to value of hexadecimal constant, and
+      set |next_control| to the following token@>;
+    add_in(val); goto reswitch;
+    end;
+  identifier: begin q:=id_lookup(normal);
+    if ilk[q]<>numeric then
+      begin next_control:="*"; goto reswitch; {leads to error}
+      end;
+    add_in(equiv[q]-1073741824);
+    end;
+  "+": do_nothing;
+  "-": next_sign:=-next_sign;
+  format, definition, module_name, begin_Pascal, new_module: goto done;
+  ";": err_print('! Omit semicolon in numeric definition');
+@.Omit semicolon in numeric def...@>
+  othercases @<Signal error, flush rest of the definition@>
+  endcases;
+  end;
+done:
+
+@ @<Signal error, flush rest...@>=
+begin err_print('! Improper numeric definition will be flushed');
+@.Improper numeric definition...@>
+repeat next_control:=skip_ahead
+until end_of_definition(next_control);
+if next_control=module_name then
+  begin {we want to scan the module name too}
+  loc:=loc-2; next_control:=get_next;
+  end;
+accumulator:=0; goto done;
+end
+
+@ @<Set |val| to value of decimal...@>=
+val:=0;
+repeat val:=10*val+next_control-"0"; next_control:=get_next;
+until (next_control>"9")or(next_control<"0")
+
+@ @<Set |val| to value of octal...@>=
+val:=0; next_control:="0";
+repeat val:=8*val+next_control-"0"; next_control:=get_next;
+until (next_control>"7")or(next_control<"0")
+
+@ @<Set |val| to value of hex...@>=
+val:=0; next_control:="0";
+repeat if next_control>="A" then next_control:=next_control+"0"+10-"A";
+val:=16*val+next_control-"0"; next_control:=get_next;
+until (next_control>"F")or(next_control<"0")or@|
+  ((next_control>"9")and(next_control<"A"))
+
+@* Scanning a macro definition.
+The rules for generating the replacement texts corresponding to simple
+macros, parametric macros, and \PASCAL\ texts of a module are almost
+identical, so a single procedure is used for all three cases. The
+differences are that
+
+\yskip\item{a)} The sign |#| denotes a parameter only when it appears
+outside of strings in a parametric macro; otherwise it stands for the
+ASCII character |#|. (This is not used in standard \PASCAL, but some
+\PASCAL s allow, for example, `\.{/\#}' after a certain kind of file name.)
+
+\item{b)}Module names are not allowed in simple macros or parametric macros;
+in fact, the appearance of a module name terminates such macros and denotes
+the name of the current module.
+
+\item{c)}The symbols \.{@@d} and \.{@@f} and \.{@@p} are not allowed after
+module names, while they terminate macro definitions.
+
+@ Therefore there is a procedure |scan_repl| whose parameter |t| specifies
+either |simple| or |parametric| or |module_name|. After |scan_repl| has
+acted, |cur_repl_text| will point to the replacement text just generated, and
+|next_control| will contain the control code that terminated the activity.
+
+@<Globals...@>=
+@!cur_repl_text:text_pointer; {replacement text formed by |scan_repl|}
+
+@ @p procedure scan_repl(@!t:eight_bits); {creates a replacement text}
+label continue, done, found, reswitch;
+var a:sixteen_bits; {the current token}
+@!b:ASCII_code; {a character from the buffer}
+@!bal:eight_bits; {left parentheses minus right parentheses}
+begin bal:=0;
+loop@+  begin continue: a:=get_next;
+  case a of
+  "(": incr(bal);
+  ")": if bal=0 then err_print('! Extra )')
+@.Extra )@>
+    else decr(bal);
+  "'": @<Copy a string from the buffer to |tok_mem|@>;
+  "#": if t=parametric then a:=param;
+  @t\4@>@<In cases that |a| is a non-ASCII token (|identifier|,
+  |module_name|, etc.), either process it and change |a| to a byte
+  that should be stored, or |goto continue| if |a| should be ignored,
+  or |goto done| if |a| signals the end of this replacement text@>@;
+  othercases do_nothing
+  endcases;@/
+  app_repl(a); {store |a| in |tok_mem|}
+  end;
+done: next_control:=a;
+@<Make sure the parentheses balance@>;
+if text_ptr>max_texts-zz then overflow('text');
+cur_repl_text:=text_ptr; tok_start[text_ptr+zz]:=tok_ptr[z];
+incr(text_ptr);
+if z=zz-1 then z:=0@+else incr(z);
+end;
+
+@ @<Make sure the parentheses balance@>=
+if bal>0 then
+  begin if bal=1 then err_print('! Missing )')
+  else err_print('! Missing ',bal:1,' )''s');
+@.Missing n )@>
+  while bal>0 do
+    begin app_repl(")"); decr(bal);
+    end;
+  end
+
+@ @<In cases that |a| is...@>=
+identifier: begin a:=id_lookup(normal); app_repl((a div @'400)+@'200);
+  a:=a mod @'400;
+  end;
+module_name: if t<>module_name then goto done
+  else  begin app_repl((cur_module div @'400)+@'250);
+    a:=cur_module mod @'400;
+    end;
+verbatim: @<Copy verbatim string from the buffer to |tok_mem|@>;
+definition, format, begin_Pascal: if t<>module_name then goto done
+  else  begin err_print('! @@',xchr[buffer[loc-1]],
+@.\AT!p is ignored in Pascal text@>
+@.\AT!d is ignored in Pascal text@>
+@.\AT!f is ignored in Pascal text@>
+      ' is ignored in Pascal text'); goto continue;
+    end;
+new_module: goto done;
+
+@ @<Copy a string...@>=
+begin b:="'";
+loop@+  begin app_repl(b);
+  if b="@@" then
+    if buffer[loc]="@@" then incr(loc) {store only one \.{@@}}
+    else err_print('! You should double @@ signs in strings');
+@.You should double \AT! signs@>
+  if loc=limit then
+    begin err_print('! String didn''t end');
+@.String didn't end@>
+    buffer[loc]:="'"; buffer[loc+1]:=0;
+    end;
+  b:=buffer[loc]; incr(loc);
+  if b="'" then
+    begin if buffer[loc]<>"'" then goto found
+    else  begin incr(loc); app_repl("'");
+      end;
+    end;
+  end;
+found: end {now |a| holds the final |"'"| that will be stored}
+
+@ @<Copy verbatim string...@>=
+begin app_repl(verbatim);
+buffer[limit+1]:="@@";
+reswitch: if buffer[loc]="@@" then
+  begin if loc<limit then if buffer[loc+1]="@@" then
+    begin app_repl("@@");
+    loc:=loc+2;
+    goto reswitch;
+    end;
+  end
+else begin app_repl(buffer[loc]);
+  incr(loc);
+  goto reswitch;
+  end;
+if loc>=limit then err_print('! Verbatim string didn''t end')
+@.Verbatim string didn't end@>
+else if buffer[loc+1]<>">" then
+  err_print('! You should double @@ signs in verbatim strings');
+@.You should double \AT! signs@>
+loc:=loc+2;
+end {another |verbatim| byte will be stored, since |a=verbatim|}
+
+@ The following procedure is used to define a simple or parametric macro,
+just after the `\.{==}' of its definition has been scanned.
+
+@p procedure define_macro(@!t:eight_bits);
+var p:name_pointer; {the identifier being defined}
+begin p:=id_lookup(t); scan_repl(t);@/
+equiv[p]:=cur_repl_text; text_link[cur_repl_text]:=0;
+end;
+
+@* Scanning a module.
+The |scan_module| procedure starts when `\.{@@\ }' or `\.{@@*}' has been
+sensed in the input, and it proceeds until the end of that module.  It
+uses |module_count| to keep track of the current module number; with luck,
+\.{WEAVE} and \.{TANGLE} will both assign the same numbers to modules.
+
+@<Globals...@>=
+@!module_count:0..@'27777; {the current module number}
+
+@ The top level of |scan_module| is trivial.
+@p procedure scan_module;
+label continue, done, exit;
+var p:name_pointer; {module name for the current module}
+begin incr(module_count);
+@<Scan the \(definition part of the current module@>;
+@<Scan the \PASCAL\ part of the current module@>;
+exit: end;
+
+@ @<Scan the \(definition part...@>=
+next_control:=0;
+loop@+  begin continue: while next_control<=format do
+    begin next_control:=skip_ahead;
+    if next_control=module_name then
+      begin {we want to scan the module name too}
+      loc:=loc-2; next_control:=get_next;
+      end;
+    end;
+  if next_control<>definition then goto done;
+  next_control:=get_next; {get identifier name}
+  if next_control<>identifier then
+    begin err_print('! Definition flushed, must start with ',
+@.Definition flushed...@>
+      'identifier of length > 1'); goto continue;
+    end;
+  next_control:=get_next; {get token after the identifier}
+  if next_control="=" then
+    begin scan_numeric(id_lookup(numeric)); goto continue;
+    end
+  else if next_control=equivalence_sign then
+    begin define_macro(simple); goto continue;
+    end
+  else @<If the next text is `|(#)==|', call |define_macro|
+    and |goto continue|@>;
+  err_print('! Definition flushed since it starts badly');
+@.Definition flushed...@>
+  end;
+done:
+
+@ @<If the next text is `|(#)==|'...@>=
+if next_control="(" then
+  begin next_control:=get_next;
+  if next_control="#" then
+    begin next_control:=get_next;
+    if next_control=")" then
+      begin next_control:=get_next;
+      if next_control="=" then
+        begin err_print('! Use == for macros');
+@.Use == for macros@>
+        next_control:=equivalence_sign;
+        end;
+      if next_control=equivalence_sign then
+        begin define_macro(parametric); goto continue;
+        end;
+      end;
+    end;
+  end;
+
+@ @<Scan the \PASCAL...@>=
+case next_control of
+begin_Pascal:p:=0;
+module_name: begin p:=cur_module;
+  @<Check that |=| or |==| follows this module name, otherwise |return|@>;
+  end;
+othercases return
+endcases;@/
+@<Insert the module number into |tok_mem|@>;
+scan_repl(module_name); {now |cur_repl_text| points to the replacement text}
+@<Update the data structure so that the replacement text is accessible@>;
+
+@ @<Check that |=|...@>=
+repeat next_control:=get_next;
+until next_control<>"+"; {allow optional `\.{+=}'}
+if (next_control<>"=")and(next_control<>equivalence_sign) then
+  begin err_print('! Pascal text flushed, = sign is missing');
+@.Pascal text flushed...@>
+  repeat next_control:=skip_ahead;
+  until next_control=new_module;
+  return;
+  end
+
+@ @<Insert the module number...@>=
+store_two_bytes(@'150000+module_count); {|@'150000=@'320*@'400|}
+
+@ @<Update the data...@>=
+if p=0 then {unnamed module}
+  begin text_link[last_unnamed]:=cur_repl_text; last_unnamed:=cur_repl_text;
+  end
+else if equiv[p]=0 then equiv[p]:=cur_repl_text {first module of this name}
+else  begin p:=equiv[p];
+  while text_link[p]<module_flag do p:=text_link[p]; {find end of list}
+  text_link[p]:=cur_repl_text;
+  end;
+text_link[cur_repl_text]:=module_flag;
+  {mark this replacement text as a nonmacro}
+
+@* Debugging.
+The \PASCAL\ debugger with which \.{TANGLE} was developed allows breakpoints
+to be set, and variables can be read and changed, but procedures cannot be
+executed. Therefore a `|debug_help|' procedure has been inserted in the main
+loops of each phase of the program; when |ddt| and |dd| are set to appropriate
+values, symbolic printouts of various tables will appear.
+
+The idea is to set a breakpoint inside the |debug_help| routine, at the
+place of `\ignorespaces|breakpoint:|\unskip' below.  Then when
+|debug_help| is to be activated, set |trouble_shooting| equal to |true|.
+The |debug_help| routine will prompt you for values of |ddt| and |dd|,
+discontinuing this when |ddt<=0|; thus you type $2n+1$ integers, ending
+with zero or a negative number. Then control either passes to the
+breakpoint, allowing you to look at and/or change variables (if you typed
+zero), or to exit the routine (if you typed a negative value).
+
+Another global variable, |debug_cycle|, can be used to skip silently
+past calls on |debug_help|. If you set |debug_cycle>1|, the program stops
+only every |debug_cycle| times |debug_help| is called; however,
+any error stop will set |debug_cycle| to zero.
+
+@<Globals...@>=
+@!debug@!trouble_shooting:boolean; {is |debug_help| wanted?}
+@!ddt:integer; {operation code for the |debug_help| routine}
+@!dd:integer; {operand in procedures performed by |debug_help|}
+@!debug_cycle:integer; {threshold for |debug_help| stopping}
+@!debug_skipped:integer; {we have skipped this many |debug_help| calls}
+@!term_in:text_file; {the user's terminal as an input file}
+gubed
+
+@ The debugging routine needs to read from the user's terminal.
+@^system dependencies@>
+@<Set init...@>=
+@!debug trouble_shooting:=true; debug_cycle:=1; debug_skipped:=0;@/
+trouble_shooting:=false; debug_cycle:=99999; {use these when it almost works}
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+gubed
+
+@ @d breakpoint=888 {place where a breakpoint is desirable}
+@^system dependencies@>
+
+@p @!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k:integer; {index into various arrays}
+begin incr(debug_skipped);
+if debug_skipped<debug_cycle then return;
+debug_skipped:=0;
+loop@+  begin write(term_out,'#'); update_terminal; {prompt}
+  read(term_in,ddt); {read a list of integers}
+  if ddt<0 then return
+  else if ddt=0 then
+    begin goto breakpoint;@\ {go to every label at least once}
+    breakpoint: ddt:=0;@\
+    end
+  else  begin read(term_in,dd);
+    case ddt of
+    1: print_id(dd);
+    2: print_repl(dd);
+    3: for k:=1 to dd do print(xchr[buffer[k]]);
+    4: for k:=1 to dd do print(xchr[mod_text[k]]);
+    5: for k:=1 to out_ptr do print(xchr[out_buf[k]]);
+    6: for k:=1 to dd do print(xchr[out_contrib[k]]);
+    othercases print('?')
+    endcases;
+    end;
+  end;
+exit:end;
+gubed
+
+@* The main program.
+We have defined plenty of procedures, and it is time to put the last
+pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where
+it ends.
+@^system dependencies@>
+
+@p begin initialize;
+@<Initialize the input system@>;
+print_ln(banner); {print a ``banner line''}
+@<Phase I: Read all the user's text and compress it into |tok_mem|@>;
+stat for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];@+tats@;@/
+@<Phase II:...@>;
+end_of_TANGLE:
+if string_ptr>number_chars then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@<Print the job |history|@>;
+end.
+
+@ @<Phase I:...@>=
+phase_one:=true;
+module_count:=0;
+repeat next_control:=skip_ahead;
+until next_control=new_module;
+while not input_has_ended do scan_module;
+@<Check that all changes have been read@>;
+phase_one:=false;
+
+@ @<Finish off the string pool file@>=
+begin print_nl(string_ptr-number_chars:1,
+               ' strings written to string pool file.');
+write(pool,'*');
+for ii:=1 to 9 do
+  begin out_buf[ii]:=pool_check_sum mod 10;
+  pool_check_sum:=pool_check_sum div 10;
+  end;
+for ii:=9 downto 1 do write(pool,xchr["0"+out_buf[ii]]);
+write_ln(pool);
+end
+
+@ @<Glob...@>=
+stat @!wo:0..ww-1; {segment of memory for which statistics are being printed}
+tats
+
+@ @<Print statistics about memory usage@>=
+print_nl('Memory usage statistics:');
+print_nl(name_ptr:1, ' names, ', text_ptr:1, ' replacement texts;');
+print_nl(byte_ptr[0]:1);
+for wo:=1 to ww-1 do print('+',byte_ptr[wo]:1);
+if phase_one then
+  for ii:=0 to zz-1 do max_tok_ptr[ii]:=tok_ptr[ii];
+print(' bytes, ', max_tok_ptr[0]:1);
+for ii:=1 to zz-1 do print('+',max_tok_ptr[ii]:1);
+print(' tokens.');
+
+@ Some implementations may wish to pass the |history| value to the
+operating system so that it can be used to govern whether or not other
+programs are started. Here we simply report the history to the user.
+@^system dependencies@>
+
+@<Print the job |history|@>=
+case history of
+spotless: print_nl('(No errors were found.)');
+harmless_message: print_nl('(Did you see the warning message above?)');
+error_message: print_nl('(Pardon me, but I think I spotted something wrong.)');
+fatal_message: print_nl('(That was a fatal error, my friend.)');
+end {there are no other cases}
+
+@* System-dependent changes.
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@^system dependencies@>
+
+@* Index.
+Here is a cross-reference table for the \.{TANGLE} processor.
+All modules in which an identifier is
+used are listed with that identifier, except that reserved words are
+indexed only when they appear in format definitions, and the appearances
+of identifiers in module names are not indexed. Underlined entries
+correspond to where the identifier was declared. Error messages and
+a few other things like ``ASCII code'' are indexed here too.
diff --git a/Build/source/texk/web2c/luatexdir/luatex-api.h b/Build/source/texk/web2c/luatexdir/luatex-api.h
new file mode 100644
index 00000000000..3585e01dea7
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex-api.h
@@ -0,0 +1,104 @@
+/* $Id */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdarg.h>
+#include <../lua51/lua.h>
+#include <../lua51/lauxlib.h>
+#include <../lua51/lualib.h>
+
+
+typedef struct LoadS {
+    const char *s;
+    size_t size;
+} LoadS;
+
+extern lua_State *Luas[];
+
+extern void make_table (lua_State *L, char *tab, char *getfunc, char*setfunc);
+
+extern int luac_main (int argc, char* argv[]);
+
+extern int luaopen_tex (lua_State *L);
+
+extern int luaopen_pdf (lua_State *L);
+
+#define LUA_TEXFILEHANDLE		"TEXFILE*"
+
+extern int luaopen_texio (lua_State *L);
+
+extern int luaopen_lang (lua_State *L);
+
+extern void luatex_load_init (int s, LoadS *ls);
+
+extern lua_State *luatex_error (lua_State *L, int fatal);
+
+extern int luaopen_unicode (lua_State *L);
+extern int luaopen_zip (lua_State *L);
+extern int luaopen_lfs (lua_State *L);
+extern int luaopen_lpeg (lua_State *L);
+extern int luaopen_md5 (lua_State *L);
+extern int luaopen_zlib (lua_State *L);
+extern int luaopen_gzip (lua_State *L);
+extern int luaopen_ff  (lua_State *L);
+
+extern int luaopen_img  (lua_State *L);
+extern int luaopen_mp (lua_State *L);
+
+extern void open_oslibext (lua_State *L, int safer_option);
+
+extern void initfilecallbackids    (int max);
+extern void setinputfilecallbackid (int n, int i) ;
+extern void setreadfilecallbackid  (int n, int i) ;
+extern int  getinputfilecallbackid (int n);
+extern int  getreadfilecallbackid  (int n);
+
+extern void lua_initialize (int ac, char **av);
+
+extern int luaopen_kpse (lua_State *L);
+
+extern int luaopen_callback (lua_State *L);
+
+extern int luaopen_lua (lua_State *L, int n, char *fname);
+
+extern int luaopen_stats (lua_State *L);
+
+extern int luaopen_font (lua_State *L);
+extern int font_to_lua   (lua_State *L, int f) ;
+extern int font_from_lua (lua_State *L, int f) ; /* return is boolean */
+
+extern int   luaopen_token (lua_State *L);
+extern char *tokenlist_to_cstring (int p , int inhibit_par, int *siz);
+extern void  tokenlist_to_lua(lua_State *L, int p);
+extern void  tokenlist_to_luastring(lua_State *L, int p) ;
+extern int   tokenlist_from_lua(lua_State *L);
+
+extern void  lua_nodelib_push (lua_State *L) ;
+extern int   luaopen_node (lua_State *L);
+extern void  nodelist_to_lua (lua_State *L, int n) ;
+extern int   nodelist_from_lua (lua_State *L); 
+
+extern int dimen_to_number (lua_State *L, char *s);
+
+extern void dump_luac_registers (void);
+
+extern void undump_luac_registers (void);
+
+
+extern void unhide_lua_table(lua_State *lua, char *name, int r);
+extern int  hide_lua_table  (lua_State *lua, char *name);
+
+extern void unhide_lua_value(lua_State *lua, char *name, char *item, int r);
+extern int  hide_lua_value  (lua_State *lua, char *name, char *item);
+
+typedef struct command_item_ {
+  char *cmd_name;
+  int command_offset;
+  char **commands;
+} command_item;
+ 
+extern command_item command_names[];
+extern int callback_callbacks_id;
+
+void  luainterpreter (int n) ;
+
diff --git a/Build/source/texk/web2c/luatexdir/luatex.ch b/Build/source/texk/web2c/luatexdir/luatex.ch
new file mode 100644
index 00000000000..dd1c17e44af
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex.ch
@@ -0,0 +1,2623 @@
+@x
+  \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+  }
+@y
+  \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+  }
+\let\maybe=\iftrue
+@z
+
+@x
+@d banner==luaTeX_banner
+@y
+@d luaTeXk_banner=='This is luaTeXk, Version ',luatex_version_string
+@#
+@d banner==luaTeX_banner
+@d banner_k==luaTeXk_banner
+@z
+
+@x
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+@y
+@z
+
+@x
+program TEX; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+@y
+program TEX; {all file names are defined dynamically}
+@z
+
+@x
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+  {key control points}
+@y
+@ For Web2c, labels are not declared in the main program, but
+we still have to declare the symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d final_end=9999 {this label marks the ending of the program}
+@z
+
+@x
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug== ifdef('TEXMF_DEBUG')
+@d gubed== endif('TEXMF_DEBUG')
+@z
+
+@x
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+  usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+  usage statistics}
+@y
+@d stat==ifdef('STAT')
+@d tats==endif('STAT')
+@z
+
+@x
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y
+the codewords `$|init|\ldots|tini|$' for declarations and by the codewords
+`$|Init|\ldots|Tini|$' for executable code.  This distinction is helpful for
+implementations where a run-time switch differentiates between the two
+versions of the program.
+
+@d init==ifdef('INITEX')
+@d tini==endif('INITEX')
+@d Init==init if ini_version then begin
+@d Tini==end;@+tini
+@f Init==begin
+@f Tini==end
+@z
+
+@x
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+@y
+@!Init @<Initialize table entries (done by \.{INITEX} only)@>@;@+Tini
+@z
+
+@x
+@<Constants...@>=
+@!buf_size=500; {maximum number of characters simultaneously present in
+  current lines of open files and in control sequences between
+  \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+  error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+  can be going on simultaneously}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+  available for the user's control sequences and font names,
+  after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+  error messages and help texts, and the names of all fonts and
+  control sequences; must exceed |string_vacancies| by the total
+  length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+  at most |max_halfword|}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!expand_depth=10000; {limits recursive calls of the |expand| procedure}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:TEX.POOL                     ';
+  {string of length |file_name_size|; tells where the string pool appears}
+@y
+@d file_name_size == max_halfword-1 { has to be big enough to force namelength into integer }
+@d ssup_error_line = 255
+@d ssup_max_strings == 262143
+{Larger values than 65536 cause the arrays consume much more memory.}
+
+@<Constants...@>=
+@!hash_offset=514; {smallest index in hash array, i.e., |hash_base| }
+  {Use |hash_offset=0| for compilers which cannot decrement pointers.}
+@!engine_name='luatex'; {the name of this engine}
+@#
+
+@!inf_main_memory = 2000000;
+@!sup_main_memory = 32000000;
+
+@!inf_max_strings = 100000;
+@!sup_max_strings = ssup_max_strings;
+@!inf_strings_free = 100;
+@!sup_strings_free = sup_max_strings;
+
+@!inf_buf_size = 500;
+@!sup_buf_size = 100000000;
+
+@!inf_nest_size = 40;
+@!sup_nest_size = 4000;
+
+@!inf_max_in_open = 6;
+@!sup_max_in_open = 127;
+
+@!inf_param_size = 60;
+@!sup_param_size = 6000;
+
+@!inf_save_size = 600;
+@!sup_save_size = 80000;
+
+@!inf_stack_size = 200;
+@!sup_stack_size = 30000;
+
+@!inf_dvi_buf_size = 800;
+@!sup_dvi_buf_size = 65536;
+
+@!inf_pool_size = 128000;
+@!sup_pool_size = 40000000;
+@!inf_pool_free = 1000;
+@!sup_pool_free = sup_pool_size;
+@!inf_string_vacancies = 8000;
+@!sup_string_vacancies = sup_pool_size - 23000;
+
+@!sup_hash_extra = sup_max_strings;
+@!inf_hash_extra = 0;
+
+@!sup_ocp_list_size  = 1000000;
+@!inf_ocp_list_size  = 1000;
+@!sup_ocp_buf_size   = 100000000;
+@!inf_ocp_buf_size   = 1000;
+@!sup_ocp_stack_size = 1000000;
+@!inf_ocp_stack_size = 1000;
+
+@!inf_expand_depth = 100;
+@!sup_expand_depth = 1000000;
+@z
+
+@x
+@d font_base=0 {smallest internal font number; must not be less
+  than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+  about |(fix_mem_max-fix_mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@y
+@d font_base=0 {smallest internal font number; must not be less
+  than |min_quarterword|}
+@d hash_size=65536 {maximum number of control sequences; it should be at most
+  about |(mem_max-mem_min)/10|}
+@d hash_prime=55711 {a prime number equal to about 85\pct! of |hash_size|}
+@z
+
+@x
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@y
+@z
+
+@x
+@d text_char == char {the data type of characters in text files}
+@y
+@d text_char == ASCII_code {the data type of characters in text files}
+@z
+
+@x
+@!nameoffile:packed array[1..file_name_size] of char;@;@/
+  {on some systems this may be a \&{record} variable}
+@y
+@!nameoffile:^packed_ASCII_code;
+@z
+
+@x
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|.  This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|nameoffile| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+  {open a text file for input}
+begin reset(f,nameoffile,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+  {open a text file for output}
+begin rewrite(f,nameoffile,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+  {open a binary file for input}
+begin reset(f,nameoffile,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+  {open a binary file for output}
+begin rewrite(f,nameoffile,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+  {open a word file for input}
+begin reset(f,nameoffile,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+  {open a word file for output}
+begin rewrite(f,nameoffile,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@ All of the file opening functions are defined in C.
+@z
+
+@x
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+@y
+@ And all the file closing routines as well.
+@z
+
+@x
+@!buffer:array[0..buf_size] of packed_ASCII_code; {lines of characters being read}
+@y
+@!buffer:^packed_ASCII_code; {lines of characters being read}
+@z
+
+@x
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+  {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+  {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else  begin last_nonblank:=first;
+  while not eoln(f) do
+    begin if last>=max_buf_stack then
+      begin max_buf_stack:=last+1;
+      if max_buf_stack=buf_size then
+        @<Report overflow of the input buffer, and abort@>;
+      end;
+    buffer[last]:=f^; get(f); incr(last);
+    if buffer[last-1]<>" " then last_nonblank:=last;
+    end;
+  last:=last_nonblank; input_ln:=true;
+  end;
+end;
+@y
+We define |input_ln| in C, for efficiency. Nevertheless we quote the module
+`Report overflow of the input buffer, and abort' here in order to make
+\.{WEAVE} happy, since part of that module is needed by e-TeX.
+
+@p @{ @<Report overflow of the input buffer, and abort@> @}
+@z
+
+@x
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@d term_in==stdin {the terminal as an input file}
+@d term_out==stdout {the terminal as an output file}
+
+@<Glob...@>=
+@!init
+@!ini_version:boolean; {are we \.{INITEX}?}
+@!dump_option:boolean; {was the dump name option used?}
+@!dump_line:boolean; {was a \.{\%\AM format} line seen?}
+tini@/
+@#
+@!bound_default:integer; {temporary for setup}
+@!bound_name:^char; {temporary for setup}
+@#
+@!error_line:integer; {width of context lines on terminal error messages}
+@!half_error_line:integer; {width of first lines of contexts in terminal
+  error messages; should be between 30 and |error_line-15|}
+@!max_print_line:integer;
+  {width of longest text lines output; should be at least 60}
+@!ocp_list_size:integer;
+@!ocp_buf_size:integer;
+@!ocp_stack_size:integer;
+@!max_strings:integer; {maximum number of strings; must not exceed |max_halfword|}
+@!strings_free:integer; {strings available after format loaded}
+@!string_vacancies:integer; {the minimum number of characters that should be
+  available for the user's control sequences and font names,
+  after \TeX's own error messages are stored}
+@!pool_size:integer; {maximum number of characters in strings, including all
+  error messages and help texts, and the names of all fonts and
+  control sequences; must exceed |string_vacancies| by the total
+  length of \TeX's own strings, which is currently about 23000}
+@!pool_free:integer;{pool space free after format loaded}
+@!font_k:integer; {loop variable for initialization}
+@!buf_size:integer; {maximum number of characters simultaneously present in
+  current lines of open files and in control sequences between
+  \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!stack_size:integer; {maximum number of simultaneous input sources}
+@!max_in_open:integer; {maximum number of input files and error insertions that
+  can be going on simultaneously}
+@!param_size:integer; {maximum number of simultaneous macro parameters}
+@!nest_size:integer; {maximum number of semantic levels simultaneously active}
+@!save_size:integer; {space for saving values outside of current group; must be
+  at most |max_halfword|}
+@!dvi_buf_size:integer; {size of the output buffer; must be a multiple of 8}
+@!expand_depth:integer; {limits recursive calls of the |expand| procedure}
+@!parsefirstlinep:cinttype; {parse the first line for options}
+@!filelineerrorstylep:cinttype; {format messages as file:line:error}
+@!haltonerrorp:cinttype; {stop at first error}
+@!quoted_filename:boolean; {current filename is quoted}
+{Variables for source specials}
+@!srcspecialsp : boolean;{Whether |src_specials| are enabled at all}
+@!insertsrcspecialauto : boolean;
+@!insertsrcspecialeverypar : boolean;
+@!insertsrcspecialeveryparend : boolean;
+@!insertsrcspecialeverycr : boolean;
+@!insertsrcspecialeverymath : boolean;
+@!insertsrcspecialeveryhbox : boolean;
+@!insertsrcspecialeveryvbox : boolean;
+@!insertsrcspecialeverydisplay : boolean;
+@z
+
+@x
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@ Here is how to open the terminal files.  |t_open_out| does nothing.
+|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting
+any command line arguments the user has provided.  It's defined in C.
+
+@d t_open_out == {output already open for text output}
+@z
+
+@x
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+these operations can be specified with {\mc UNIX}.  |update_terminal|
+does an |fflush|. |clear_terminal| is redefined
+to do nothing, since the user should control the terminal.
+@^system dependencies@>
+
+@d update_terminal == fflush (term_out)
+@d clear_terminal == do_nothing
+@z
+
+@x
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+  begin writeln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+  end
+else 
+  check_buffer_overflow(buf_size+10) { need  a little bit more}
+@y
+@<Report overflow of the input buffer, and abort@>=
+  check_buffer_overflow(buf_size+10) { need  a little bit more}
+@z
+
+@x
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+@y
+@ The following program does the required initialization.
+Iff anything has been specified on the command line, then |t_open_in|
+will return with |last > first|.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+if last > first then
+  begin loc := first;
+  while (loc < last) and (buffer[loc]=' ') do incr(loc);
+  if loc < last then
+    begin init_terminal := true; goto exit;
+    end;
+  end;
+@z
+
+@x
+    write(term_out,'! End of file on the terminal... why?');
+@y
+    writeln(term_out,'! End of file on the terminal... why?');
+@z
+
+@x
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@!str_pool: ^packed_ASCII_code; {the characters}
+@!str_start : ^pool_pointer; {the starting pointers}
+@z
+
+@x
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+@y
+@p @t\4@>@<Declare additional routines for string recycling@>@/
+
+@!init function get_strings_started:boolean; {initializes the string pool,
+@z
+
+@x
+would like string @'32 to be the single character @'32 instead of the
+@y
+would like string @'32 to be printed as the single character @'32
+instead of the
+@z
+
+@x
+@!trick_buf:array[0..error_line] of packed_ASCII_code; {circular buffer for
+@y
+@!trick_buf:array[0..ssup_error_line] of packed_ASCII_code; {circular buffer for
+@z
+
+@x
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@y
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d unspecified_mode=4 {extra value for command-line switch}
+@z
+
+@x
+  print_nl("! "); print(#);
+@y
+  if filelineerrorstylep then print_file_line
+  else print_nl("! ");
+  print(#);
+@z
+
+@x
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@y
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!interactionoption:batch_mode..unspecified_mode; {set from command line}
+@z
+
+@x
+@ @<Set init...@>=interaction:=error_stop_mode;
+@y
+@ @<Set init...@>=if interactionoption=unspecified_mode then
+  interaction:=error_stop_mode
+else
+  interaction:=interactionoption;
+@z
+
+@x
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+@d do_final_end==begin
+   update_terminal;
+   ready_already:=0;
+   if (history <> spotless) and (history <> warning_issued) then
+       uexit(1)
+   else
+       uexit(0);
+   end
+
+@<Error hand...@>=
+procedure jump_out;
+begin
+close_files_and_terminate;
+do_final_end;
+end;
+@z
+
+@x
+show_context;
+@y
+show_context;
+if (haltonerrorp) then begin
+  history:=fatal_error_stop; jump_out;
+end;
+@z
+
+@x
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@y
+line ready to be edited.
+We do this by calling the external procedure |calledit| with a pointer to
+the filename, its length, and the line number.
+However, here we just set up the variables that will be used as arguments,
+since we don't want to do the switch-to-editor until after TeX has closed
+its files.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+@d edit_file==input_stack[base_ptr]
+@z
+
+@x
+"E": if base_ptr>0 then
+  begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+  slow_print(input_stack[base_ptr].name_field);
+  print(" at line "); print_int(line);
+  interaction:=scroll_mode; jump_out;
+@y
+"E": if base_ptr>0 then
+    begin edit_name_start:=str_start_macro(edit_file.name_field);
+    edit_name_length:=str_start_macro(edit_file.name_field+1) -
+                      str_start_macro(edit_file.name_field);
+    edit_line:=line;
+    jump_out;
+@z
+
+@x
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@y
+|remainder|, holds the remainder after a division.
+
+@d remainder==tex_remainder
+
+@<Glob...@>=
+@z
+
+@x
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@z
+
+@x
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+  {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+  {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+  {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+  {to take a sixteen-bit item from a halfword}
+@y
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+@x
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+  @!rh:halfword;
+  case two_choices of
+  1: (@!lh:halfword);
+  2: (@!b0:quarterword; @!b1:quarterword);
+  end;
+@!four_quarters = packed record@;@/
+  @!b0:quarterword;
+  @!b1:quarterword;
+  @!b2:quarterword;
+  @!b3:quarterword;
+  end;
+@!memory_word = record@;@/
+  case four_choices of
+  1: (@!int:integer);
+  2: (@!gr:glue_ratio);
+  3: (@!hh:two_halves);
+  4: (@!qqqq:four_quarters);
+  end;
+@y
+@!quarterword = min_quarterword..max_quarterword;
+@!halfword = min_halfword..max_halfword;
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@=#include "texmfmem.h";@>
+@z
+
+@x
+  if abs(vmem(p+glue_offset).int)<@'4000000 then print("?.?")
+  else if abs(g)>float_constant(20000) then
+@y
+  { The Unix |pc| folks removed this restriction with a remark that
+    invalid bit patterns were vanishingly improbable, so we follow
+    their example without really understanding it.
+  |if abs(vmem(p+glue_offset).int)<@'4000000 then print('?.?')|
+  |else| }
+  if fabs(g)>float_constant(20000) then
+@z
+
+@x
+begin if m>0 then
+  case m div (max_command+1) of
+  0:print("vertical");
+  1:print("horizontal");
+  2:print("display math");
+  end
+else if m=0 then print("no")
+else  case (-m) div (max_command+1) of
+  0:print("internal vertical");
+  1:print("restricted horizontal");
+  2:print("math");
+  end;
+print(" mode");
+end;
+@y
+begin if m>0 then
+  case m div (max_command+1) of
+  0:print("vertical mode");
+  1:print("horizontal mode");
+  2:print("display math mode");
+  end
+else if m=0 then print("no mode")
+else  case (-m) div (max_command+1) of
+  0:print("internal vertical mode");
+  1:print("restricted horizontal mode");
+  2:print("math mode");
+  end;
+end;
+
+procedure print_in_mode(@!m:integer); {prints the mode represented by |m|}
+begin if m>0 then
+  case m div (max_command+1) of
+  0:print("' in vertical mode");
+  1:print("' in horizontal mode");
+  2:print("' in display math mode");
+  end
+else if m=0 then print("' in no mode")
+else  case (-m) div (max_command+1) of
+  0:print("' in internal vertical mode");
+  1:print("' in restricted horizontal mode");
+  2:print("' in math mode");
+  end;
+end;
+@z
+
+@x
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@!nest:^list_state_record;
+@z
+
+@x
+local_par:=null; local_par_bool:=false;
+@<Start a new current page@>;
+@y
+local_par:=null; local_par_bool:=false;
+@/{The following piece of code is a copy of module 991:}
+page_contents:=empty; page_tail:=page_head; {|link(page_head):=null;|}@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+page_depth:=0; page_max_depth:=0;
+@z
+
+@x
+    print_int(nest[p].pg_field); print(" line");
+    if nest[p].pg_field<>1 then print_char("s");
+@y
+    print_int(nest[p].pg_field);
+    if nest[p].pg_field<>1 then print(" lines")
+    else print(" line");
+@z
+
+@x
+@d frozen_null_font=frozen_control_sequence+12
+  {permanent `\.{\\nullfont}'}
+@y
+@d frozen_special=frozen_control_sequence+12
+  {permanent `\.{\\special}'}
+@d frozen_null_font=frozen_control_sequence+13
+  {permanent `\.{\\nullfont}'}
+@z
+
+@x
+for k:=active_base to undefined_control_sequence-1 do
+  eqtb[k]:=eqtb[undefined_control_sequence];
+@y
+for k:=active_base to eqtb_top do
+  eqtb[k]:=eqtb[undefined_control_sequence];
+@z
+
+@x
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+It calls a macro-defined |date_and_time| routine.  |date_and_time|
+in turn is a C macro, which calls |get_date_and_time|, passing
+it the addresses of the day, month, etc., so they can be set by the
+routine.  |get_date_and_time| also sets up interrupt catching if that
+is conditionally compiled in the C code.
+@^system dependencies@>
+
+@d fix_date_and_time==dateandtime(time,day,month,year)
+@z
+
+@x
+else if n<glue_base then @<Show equivalent |n|, in region 1 or 2@>
+@y
+else if (n<glue_base) or ((n>eqtb_size)and(n<=eqtb_top)) then
+  @<Show equivalent |n|, in region 1 or 2@>
+@z
+
+@x
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@y
+@!zeqtb:^memory_word;
+@z
+
+@x
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+  {the hash table}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@y
+@!hash: ^two_halves; {the hash table}
+@!yhash: ^two_halves; {auxiliary pointer for freeing hash}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!hash_extra:pointer; {|hash_extra=hash| above |eqtb_size|}
+@!hash_top:pointer; {maximum of the hash array}
+@!eqtb_top:pointer; {maximum of the |eqtb|}
+@!hash_high:pointer; {pointer to next high hash location}
+@z
+
+@x
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+@y
+@z
+
+@x
+hash_used:=frozen_control_sequence; {nothing is used}
+@y
+hash_used:=frozen_control_sequence; {nothing is used}
+hash_high:=0;
+@z
+
+@x
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+  begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+  decr(hash_used);
+  until text(hash_used)=0; {search for an empty location in |hash|}
+  next(p):=hash_used; p:=hash_used;
+  end;
+@y
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+  begin if hash_high<hash_extra then
+      begin incr(hash_high);
+      next(p):=hash_high+eqtb_size; p:=hash_high+eqtb_size;
+      end
+    else begin
+      repeat if hash_is_full then overflow("hash size",hash_size+hash_extra);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+      decr(hash_used);
+      until text(hash_used)=0; {search for an empty location in |hash|}
+    next(p):=hash_used; p:=hash_used;
+    end;
+  end;
+@z
+
+@x
+else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.")
+@y
+else if ((p>=undefined_control_sequence)and(p<=eqtb_size))or(p>eqtb_top) then
+  print_esc("IMPOSSIBLE.")
+@z
+
+@x
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@y
+else if (text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@z
+
+@x
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@!save_stack : ^memory_word;
+@z
+
+@x
+if p<int_base then
+@y
+if (p<int_base)or(p>eqtb_size) then
+@z
+
+@x
+if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
+@y
+if cs_token_flag+eqtb_size+hash_extra>max_halfword then bad:=21;
+if (hash_offset<0)or(hash_offset>hash_base) then bad:=42;
+@z
+
+@x
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@!input_stack : ^in_state_record;
+@z
+
+@x
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!input_file : ^alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : ^integer;
+@!source_filename_stack : ^str_number;
+@!full_source_filename_stack : ^str_number;
+@z
+
+@x
+  begin print_nl("Runaway ");
+@.Runaway...@>
+  case scanner_status of
+  defining: begin print("definition"); p:=def_ref;
+    end;
+  matching: begin print("argument"); p:=temp_token_head;
+    end;
+  aligning: begin print("preamble"); p:=hold_token_head;
+    end;
+  absorbing: begin print("text"); p:=def_ref;
+    end;
+  end; {there are no other cases}
+@y
+  begin
+@.Runaway...@>
+  case scanner_status of
+  defining: begin print_nl("Runaway definition"); p:=def_ref;
+    end;
+  matching: begin print_nl("Runaway argument"); p:=temp_token_head;
+    end;
+  aligning: begin print_nl("Runaway preamble"); p:=hold_token_head;
+    end;
+  absorbing: begin print_nl("Runaway text"); p:=def_ref;
+    end;
+  end; {there are no other cases}
+@z
+
+@x
+@!param_stack:array [0..param_size] of pointer;
+  {token list pointers for parameters}
+@y
+@!param_stack: ^pointer;
+  {token list pointers for parameters}
+@z
+
+@x
+incr(in_open); push_input; index:=in_open;
+@y
+incr(in_open); push_input; index:=in_open;
+source_filename_stack[index]:=0;full_source_filename_stack[index]:=0;
+@z
+
+@x
+begin input_ptr:=0; max_in_stack:=0;
+@y
+begin input_ptr:=0; max_in_stack:=0;
+source_filename_stack[0]:=0;full_source_filename_stack[0]:=0;
+@z
+
+@x
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+  end;
+@y
+if_eof_code: begin scan_four_bit_int_or_18;
+  if cur_val=18 then b:=not shellenabledp
+  else b:=(read_open[cur_val]=closed);
+  end;
+@z
+
+@x
+@ The file names we shall deal with for illustrative purposes have the
+following structure:  If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null.  If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@y
+@ The file names we shall deal with have the
+following structure:  If the name contains `\./' or `\.:'
+(for Amiga only), the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null.  If the remaining file name contains
+`\..', the file extension consists of all such characters from the last
+`\..' to the end, otherwise the file extension is null.
+@z
+
+@x
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\./', if any}
+@!ext_delimiter:pool_pointer; {the most recent `\..', if any}
+@z
+
+@x
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+In C, the default paths are specified separately.
+@z
+
+@x
+begin area_delimiter:=0; ext_delimiter:=0;
+@y
+begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false;
+@z
+
+@x
+begin if c=" " then more_name:=false
+@y
+begin if (c=" ") and stop_at_space and (not quoted_filename) then
+  more_name:=false
+else  if c="""" then begin
+  quoted_filename:=not quoted_filename;
+  more_name:=true;
+  end
+@z
+
+@x
+  if (c=">")or(c=":") then
+@y
+  if ISDIRSEP(c) then
+@z
+
+@x
+  else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+@y
+  else if c="." then ext_delimiter:=cur_length;
+@z
+
+@x
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+@y
+@ The third.
+@^system dependencies@>
+If a string is already in the string pool, the function
+|slow_make_string| does not create a new string but returns this string
+number, thus saving string space.  Because of this new property of the
+returned string number it is not possible to apply |flush_string| to
+these strings.
+
+@p procedure end_name;
+var temp_str: str_number; {result of file name cache lookups}
+@!j,@!s,@!t: pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+@z
+
+@x
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+@y
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+str_room(6); {Room for quotes, if needed.}
+{add quotes if needed}
+if area_delimiter<>0 then begin
+  {maybe quote |cur_area|}
+  must_quote:=false;
+  s:=str_start_macro(str_ptr);
+  t:=str_start_macro(str_ptr)+area_delimiter;
+  j:=s;
+  while (not must_quote) and (j<t) do begin
+    must_quote:=str_pool[j]=" "; incr(j);
+    end;
+  if must_quote then begin
+    for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+    str_pool[t+1]:="""";
+    for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+    str_pool[s]:="""";
+    if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+    area_delimiter:=area_delimiter+2;
+    pool_ptr:=pool_ptr+2;
+    end;
+  end;
+{maybe quote |cur_name|}
+s:=str_start_macro(str_ptr)+area_delimiter;
+if ext_delimiter=0 then t:=pool_ptr else t:=str_start_macro(str_ptr)+ext_delimiter-1;
+must_quote:=false;
+j:=s;
+while (not must_quote) and (j<t) do begin
+  must_quote:=str_pool[j]=" "; incr(j);
+  end;
+if must_quote then begin
+  for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j];
+  str_pool[t+1]:="""";
+  for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+  str_pool[s]:="""";
+  if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2;
+  pool_ptr:=pool_ptr+2;
+  end;
+if ext_delimiter<>0 then begin
+  {maybe quote |cur_ext|}
+  s:=str_start_macro(str_ptr)+ext_delimiter-1;
+  t:=pool_ptr;
+  must_quote:=false;
+  j:=s;
+  while (not must_quote) and (j<t) do begin
+    must_quote:=str_pool[j]=" "; incr(j);
+    end;
+  if must_quote then begin
+    str_pool[t+1]:="""";
+    for j:=t-1 downto s do str_pool[j+1]:=str_pool[j];
+    str_pool[s]:="""";
+    pool_ptr:=pool_ptr+2;
+    end;
+  end;
+@z
+
+@x
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr);
+  end;
+if ext_delimiter=0 then
+  begin cur_ext:=""; cur_name:=make_string;
+@y
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr);
+  temp_str:=search_string(cur_area);
+  if temp_str>0 then
+    begin cur_area:=temp_str;
+    decr(str_ptr);  {no |flush_string|, |pool_ptr| will be wrong!}
+    for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
+      begin str_pool[j-area_delimiter]:=str_pool[j];
+      end;
+    pool_ptr:=pool_ptr-area_delimiter; {update |pool_ptr|}
+    end;
+  end;
+if ext_delimiter=0 then
+  begin cur_ext:=""; cur_name:=slow_make_string;
+@z
+
+@x
+else  begin cur_name:=str_ptr;
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1;
+  incr(str_ptr); cur_ext:=make_string;
+@y
+else  begin cur_name:=str_ptr;
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1;
+  incr(str_ptr); cur_ext:=make_string;
+  decr(str_ptr); {undo extension string to look at name part}
+  temp_str:=search_string(cur_name);
+  if temp_str>0 then
+    begin cur_name:=temp_str;
+    decr(str_ptr);  {no |flush_string|, |pool_ptr| will be wrong!}
+    for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
+      begin str_pool[j-ext_delimiter+area_delimiter+1]:=str_pool[j];
+      end;
+    pool_ptr:=pool_ptr-ext_delimiter+area_delimiter+1;  {update |pool_ptr|}
+    end;
+  cur_ext:=slow_make_string;  {remake extension string}
+@z
+
+@x
+begin slow_print(a); slow_print(n); slow_print(e);
+@y
+var must_quote: boolean; {whether to quote the filename}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+if a<>0 then begin
+  j:=str_start_macro(a);
+  while (not must_quote) and (j<str_start_macro(a+1)) do begin
+    must_quote:=str_pool[j]=" "; incr(j);
+  end;
+end;
+if n<>0 then begin
+  j:=str_start_macro(n);
+  while (not must_quote) and (j<str_start_macro(n+1)) do begin
+    must_quote:=str_pool[j]=" "; incr(j);
+  end;
+end;
+if e<>0 then begin
+  j:=str_start_macro(e);
+  while (not must_quote) and (j<str_start_macro(e+1)) do begin
+    must_quote:=str_pool[j]=" "; incr(j);
+  end;
+end;
+{FIXME: Alternative is to assume that any filename that has to be quoted has
+ at least one quoted component...if we pick this, a number of insertions
+ of |print_file_name| should go away.
+|must_quote|:=((|a|<>0)and(|str_pool|[|str_start|[|a|]]=""""))or
+              ((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or
+              ((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));}
+if must_quote then print_char("""");
+if a<>0 then
+  for j:=str_start_macro(a) to str_start_macro(a+1)-1 do
+    if so(str_pool[j])<>"""" then
+      print(so(str_pool[j]));
+if n<>0 then
+  for j:=str_start_macro(n) to str_start_macro(n+1)-1 do
+    if so(str_pool[j])<>"""" then
+      print(so(str_pool[j]));
+if e<>0 then
+  for j:=str_start_macro(e) to str_start_macro(e+1)-1 do
+    if so(str_pool[j])<>"""" then
+      print(so(str_pool[j]));
+if must_quote then print_char("""");
+@z
+
+@x
+@d append_to_name(#)==begin c:=#; incr(k);
+  if k<=file_name_size then nameoffile[k]:=xchr[c];
+  end
+@y
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+  if k<=file_name_size then nameoffile[k]:=xchr[c];
+  end end
+@z
+
+@x
+for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j]));
+@y
+if nameoffile then libcfree (nameoffile);
+nameoffile:= xmallocarray (packed_ASCII_code, length(a)+length(n)+length(e)+1);
+for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j]));
+@z
+
+@x
+for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
+@y
+nameoffile[namelength+1]:=0;
+@z
+
+@x
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@y
+Under {\mc UNIX} we don't give the area part, instead depending
+on the path searching that will happen during file opening.  Also, the
+length will be set in the main program.
+
+@d format_area_length=0 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@z
+
+@x
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+@!format_default_length: integer;
+@!TEX_format_default: ^char;
+
+@ We set the name of the default format file and the length of that name
+in C, instead of Pascal, since we want them to depend on the name of the
+program.
+@z
+
+@x
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@y
+if nameoffile then libcfree (nameoffile);
+nameoffile := xmallocarray (packed_ASCII_code, n+(b-a+1)+format_ext_length+1);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x
+for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
+@y
+nameoffile[namelength+1]:=0;
+@z
+
+@x
+  pack_buffered_name(0,loc,j-1); {try first without the system file area}
+  if w_open_in(fmt_file) then goto found;
+  pack_buffered_name(format_area_length,loc,j-1);
+    {now try the system format file area}
+  if w_open_in(fmt_file) then goto found;
+@y
+  pack_buffered_name(0,loc,j-1); {Kpathsea does everything}
+  if w_open_in(fmt_file) then goto found;
+@z
+
+@x
+  wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@y
+  wterm ('Sorry, I can''t find the format `');
+  fputs (stringcast(nameoffile + 1), stdout);
+  wterm ('''; will try `');
+  fputs (TEX_format_default + 1, stdout);
+  wterm_ln ('''.');
+@z
+
+@x
+  wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@y
+  wterm ('I can''t find the format file `');
+  fputs (TEX_format_default + 1, stdout);
+  wterm_ln ('''!');
+@.I can't find the format...@>
+@z
+
+@x
+@p function make_name_string:str_number;
+var k:1..file_name_size; {index into |nameoffile|}
+begin if (pool_ptr+namelength>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+  make_name_string:="?"
+else  begin for k:=1 to namelength do append_char(nameoffile[k]);
+  make_name_string:=make_string;
+  end;
+@y
+@p function make_name_string:str_number;
+var k:1..file_name_size; {index into |nameoffile|}
+save_area_delimiter, save_ext_delimiter: pool_pointer;
+save_name_in_progress, save_stop_at_space: boolean;
+begin if (pool_ptr+namelength>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+  make_name_string:="?"
+else  begin for k:=1 to namelength do append_char(nameoffile[k]);
+  make_name_string:=make_string;
+  {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to
+   match the contents of |nameoffile|.}
+  save_area_delimiter:=area_delimiter; 
+  save_ext_delimiter:=ext_delimiter;
+  save_name_in_progress:=name_in_progress; 
+  save_stop_at_space:=stop_at_space;
+  name_in_progress:=true;
+  begin_name;
+  stop_at_space:=false;
+  k:=1;
+  while (k<=namelength)and(more_name(nameoffile[k])) do
+    incr(k);
+  stop_at_space:=save_stop_at_space;
+  end_name;
+  name_in_progress:=save_name_in_progress;
+  area_delimiter:=save_area_delimiter; 
+  ext_delimiter:=save_ext_delimiter;
+  end;
+@z
+
+@x
+  if not more_name(cur_chr) then goto done;
+@y
+  {If |cur_chr| is a space and we're not scanning a token list, check
+   whether we're at the end of the buffer. Otherwise we end up adding
+   spurious spaces to file names in some cases.}
+  if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done;
+  if not more_name(cur_chr) then goto done;
+@z
+
+@x
+var k:0..buf_size; {index into |buffer|}
+@y
+var k:0..buf_size; {index into |buffer|}
+@!saved_cur_name:str_number; {to catch empty terminal input}
+@z
+
+@x
+if e=".tex" then show_context;
+@y
+if (e=".tex") or (e="") then show_context;
+@z
+
+@x
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+@y
+saved_cur_name:=cur_name;
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if length(cur_name)=0 then cur_name:=saved_cur_name;
+@z
+
+@x
+@d ensure_dvi_open==if output_file_name=0 then
+@y
+@d log_name == texmf_log_name
+@d ensure_dvi_open==if output_file_name=0 then
+@z
+
+@x
+@!months:packed array [1..36] of char; {abbreviations of month names}
+@y
+@!months:^char;
+@z
+
+@x
+if job_name=0 then job_name:="texput";
+@.texput@>
+@y
+if job_name=0 then job_name:=getjobname("texput");
+@.texput@>
+pack_job_name(".fls");
+recorder_change_filename(stringcast(nameoffile+1));
+@z
+
+@x
+begin wlog(banner);
+@y
+begin if srcspecialsp or filelineerrorstylep or parsefirstlinep
+then
+  wlog(banner_k)
+else
+  wlog(banner);
+@z
+
+@x
+slow_print(format_ident); print("  ");
+@y
+wlog(versionstring);
+slow_print(format_ident); print("  ");
+@z
+
+@x
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@y
+months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+@z
+
+@x
+end
+@y
+if shellenabledp then begin
+  wlog_cr;
+  wlog('\write18 enabled.')
+  end;
+if srcspecialsp then begin
+  wlog_cr;
+  wlog(' Source specials enabled.')
+  end;
+if filelineerrorstylep then begin
+  wlog_cr;
+  wlog(' file:line:error style messages enabled.')
+  end;
+if parsefirstlinep then begin
+  wlog_cr;
+  wlog(' %&-line parsing enabled.');
+  end;
+end
+@z
+
+@x
+  prompt_file_name("input file name",".tex");
+@y
+  prompt_file_name("input file name","");
+@z
+
+@x
+name:=a_make_name_string(cur_file);
+@y
+name:=a_make_name_string(cur_file);
+source_filename_stack[in_open]:=name;
+full_source_filename_stack[in_open]:=makefullnamestring;
+if name=str_ptr-1 then {we can try to conserve string pool space now}
+  begin temp_str:=search_string(name);
+  if temp_str>0 then
+    begin name:=temp_str; flush_string;
+    end;
+  end;
+@z
+
+@x
+  begin job_name:=cur_name; open_log_file;
+@y
+  begin job_name:=getjobname(cur_name); open_log_file;
+@z
+
+@x
+if name=str_ptr-1 then {we can conserve string pool space now}
+  begin flush_string; name:=cur_name;
+  end;
+@y
+@z
+
+@x
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+  {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+  {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+@y
+@!ocp_list_info:^memory_word;
+  {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:^memory_word;
+  {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:^ocp_list_index;
+@z
+
+@x
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@y
+@!dvi_buf:^real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:integer; {half of |dvi_buf_size|}
+@!dvi_limit:integer; {end of the current half buffer}
+@!dvi_ptr:integer; {the next available buffer address}
+@z
+
+@x
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+In C, we use a macro to call |fwrite| or |write| directly, writing all
+the bytes in one shot.  Much better even than writing four
+bytes at a time.
+@z
+
+@x
+  old_setting:=selector; selector:=new_string;
+@y
+if output_comment then
+  begin l:=strlen(output_comment); dvi_out(l);
+  for s:=0 to l-1 do dvi_out(output_comment[s]);
+  end
+else begin {the default code is unchanged}
+  old_setting:=selector; selector:=new_string;
+@z
+
+@x
+  pool_ptr:=str_start_macro(str_ptr); {flush the current string}
+@y
+  pool_ptr:=str_start_macro(str_ptr); {flush the current string}
+end;
+@z
+
+@x
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+@y
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+ifdef ('IPC')
+if ipcon>0 then
+  begin if dvi_limit=half_buf then
+    begin write_dvi(half_buf, dvi_buf_size-1);
+    flush_dvi;
+    dvi_gone:=dvi_gone+half_buf;
+    end;
+  if dvi_ptr>0 then
+    begin write_dvi(0, dvi_ptr-1);
+    flush_dvi;
+    dvi_offset:=dvi_offset+dvi_ptr; dvi_gone:=dvi_gone+dvi_ptr;
+    end;
+  dvi_ptr:=0; dvi_limit:=dvi_buf_size;
+  ipcpage(dvi_gone);
+  end;
+endif ('IPC');
+@z
+
+@x
+  k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+@y
+ifdef ('IPC')
+  k:=7-((3+dvi_offset+dvi_ptr) mod 4); {the number of 223's}
+endif ('IPC')
+ifndef ('IPC')
+  k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+endifn ('IPC')
+@z
+
+@x
+    print_nl("Output written on "); slow_print(output_file_name);
+@y
+    print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+@z
+
+@x
+    print(" ("); print_int(total_pages); print(" page");
+    if total_pages<>1 then print_char("s");
+@y
+    print(" ("); print_int(total_pages);
+    if total_pages<>1 then print(" pages")
+    else print(" page");
+@z
+
+@x
+@<Append character |cur_chr|...@>=
+continue: adjust_space_factor;@/
+@y
+@<Append character |cur_chr|...@>=
+if ((head=tail) and (mode>0)) then begin
+  if (insertsrcspecialauto) then append_src_special;
+end;
+continue: adjust_space_factor;@/
+@z
+
+@x
+print("' in "); print_mode(mode);
+@y
+print_in_mode(mode);
+@z
+
+@x
+if indented then begin
+  p:=new_null_box; box_dir(p):=par_direction;
+  width(p):=par_indent;@+
+  tail_append(p);
+@y
+if indented then begin
+  p:=new_null_box; box_dir(p):=par_direction;
+  width(p):=par_indent;@+
+  tail_append(p);
+  if (insertsrcspecialeverypar) then insert_src_special;@+
+@z
+
+@x
+begin print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+help1("I'm ignoring this, since I wasn't doing a \csname.");
+@y
+begin
+if cur_chr = 10 then
+begin
+  print_err("Extra "); print_esc("endmubyte");
+@.Extra \\endmubyte@>
+  help1("I'm ignoring this, since I wasn't doing a \mubyte.");
+end else begin
+  print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+  help1("I'm ignoring this, since I wasn't doing a \csname.");
+end;
+@z
+
+@x
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+if (insertsrcspecialeverymath) then insert_src_special;
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+@x
+  if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@y
+  if (insertsrcspecialeveryvbox) then insert_src_special;
+  if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+@z
+
+@x
+if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
+@y
+if (cur_cs=0)or(cur_cs>eqtb_top)or
+  ((cur_cs>frozen_control_sequence)and(cur_cs<=eqtb_size)) then
+@z
+
+@x
+@!flushable_string:str_number; {string not yet referenced}
+@y
+@z
+
+@x
+interaction:=cur_chr;
+@y
+interaction:=cur_chr;
+if interaction = batch_mode
+then kpsemaketexdiscarderrors := 1
+else kpsemaketexdiscarderrors := 0;
+@z
+
+@x
+slow_print(s); update_terminal;
+@y
+print(s); update_terminal;
+@z
+
+@x
+begin print_err(""); slow_print(s);
+@y
+begin print_err(""); print(s);
+@z
+
+@x
+format_ident:=" (INITEX)";
+@y
+if ini_version then format_ident:=" (INITEX)";
+@z
+
+@x
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^packed_ASCII_code;
+@z
+
+@x
+@!w: four_quarters; {four ASCII codes}
+@y
+@!format_engine: ^packed_ASCII_code;
+@z
+
+@x
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@z
+
+@x
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@z
+
+@x
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@y
+@d format_debug_end(#)==
+    writeln (stderr, ' = ', #);
+  end;
+@d format_debug(#)==
+  if debug_format_file then begin
+    write (stderr, 'fmtdebug:', #);
+    format_debug_end
+@d undump_size_end_end(#)==
+  too_small(#)@+else format_debug (#)(x); undump_end_end
+@z
+
+@x
+dump_int(@$);@/
+@y
+dump_int(@"57325458);  {Web2C \TeX's magic constant: "W2TX"}
+{Align engine to 4 bytes with one or more trailing NUL}
+x:=strlen(engine_name);
+format_engine:=xmallocarray(packed_ASCII_code,x+4);
+strcpy(stringcast(format_engine), stringcast(engine_name));
+for k:=x to x+3 do format_engine[k]:=0;
+x:=x+4-(x mod 4);
+dump_int(x);dump_things(format_engine[0], x);
+libcfree(format_engine);@/
+dump_int(@$);@/
+dump_int(max_halfword);@/
+dump_int(hash_high);
+@z
+
+@x
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+@y
+@+Init
+libcfree(str_pool); libcfree(str_start);
+libcfree(yhash); libcfree(zeqtb); libcfree(fixmem); libcfree(varmem);
+@+Tini
+undump_int(x);
+format_debug('format magic number')(x);
+if x<>@"57325458 then goto bad_fmt; {not a format file}
+undump_int(x);
+format_debug('engine name size')(x);
+if (x<0) or (x>256) then goto bad_fmt; {corrupted format file}
+format_engine:=xmallocarray(packed_ASCII_code, x);
+undump_things(format_engine[0], x);
+format_engine[x-1]:=0; {force string termination, just in case}
+if strcmp(stringcast(engine_name), stringcast(format_engine)) then
+  begin wake_up_terminal;
+  wterm_ln('---! ', stringcast(nameoffile+1), ' was written by ', format_engine);
+  libcfree(format_engine);
+  goto bad_fmt;
+end;
+libcfree(format_engine);
+undump_int(x);
+format_debug('string pool checksum')(x);
+if x<>@$ then begin {check that strings are the same}
+  wake_up_terminal;
+  wterm_ln('---! ', stringcast(nameoffile+1), ' was written by an older version');
+  goto bad_fmt;
+end;
+undump_int(x);
+if x<>max_halfword then goto bad_fmt; {check |max_halfword|}
+undump_int(hash_high);
+  if (hash_high<0)or(hash_high>sup_hash_extra) then goto bad_fmt;
+  if hash_extra<hash_high then hash_extra:=hash_high;
+  eqtb_top:=eqtb_size+hash_extra;
+  if hash_extra=0 then hash_top:=undefined_control_sequence else
+        hash_top:=eqtb_top;
+  yhash:=xmallocarray(two_halves,1+hash_top-hash_offset);
+  hash:=yhash - hash_offset;
+  next(hash_base):=0; text(hash_base):=0;
+  for x:=hash_base+1 to hash_top do hash[x]:=hash[hash_base];
+  zeqtb:=xmallocarray (memory_word,eqtb_top+1);
+  eqtb:=zeqtb;
+
+  eq_type(undefined_control_sequence):=undefined_cs;
+  equiv(undefined_control_sequence):=null;
+  eq_level(undefined_control_sequence):=level_zero;
+  for x:=eqtb_size+1 to eqtb_top do
+    eqtb[x]:=eqtb[undefined_control_sequence];
+@z
+
+@x
+dump_int(str_ptr);
+for k:=string_offset to str_ptr do dump_int(str_start_macro(k));
+k:=0;
+while k+4<pool_ptr do
+  begin dump_four_ASCII; k:=k+4;
+  end;
+k:=pool_ptr-4; dump_four_ASCII;
+@y
+dump_int((str_ptr-string_offset));
+dump_things(str_start[0], (str_ptr-string_offset)+1);
+dump_things(str_pool[0], pool_ptr);
+@z
+
+@x
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=string_offset to str_ptr do undump(0)(pool_ptr)(str_start_macro(k));
+k:=0;
+while k+4<pool_ptr do
+  begin undump_four_ASCII; k:=k+4;
+  end;
+k:=pool_ptr-4; undump_four_ASCII;
+@y
+undump_size(0)(sup_pool_size-pool_free)('string pool size')(pool_ptr);
+if pool_size<pool_ptr+pool_free then
+  pool_size:=pool_ptr+pool_free;
+undump_size(0)(sup_max_strings-strings_free)('sup strings')(str_ptr);@/
+if max_strings<str_ptr+strings_free then
+  max_strings:=str_ptr+strings_free;
+str_start:=xmallocarray(pool_pointer, max_strings);
+str_ptr:=str_ptr + string_offset;
+undump_checked_things(0, pool_ptr, str_start[0], (str_ptr-string_offset)+1);@/
+str_pool:=xmallocarray(packed_ASCII_code, pool_size);
+undump_things(str_pool[0], pool_ptr);
+@z
+
+@x
+for k:=fix_mem_min to fix_mem_end do dump_wd(mem(k));
+@y
+dump_things(mem(fix_mem_min), fix_mem_end-fix_mem_min+1);
+@z
+
+@x
+for k:=fix_mem_min to fix_mem_end do undump_wd(mem(k));
+@y
+undump_things (mem(fix_mem_min), fix_mem_end-fix_mem_min+1);
+@z
+
+@x
+undump(hash_base)(frozen_control_sequence)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+@y
+undump(hash_base)(hash_top)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(hash_top)(write_loc);@/
+@z
+
+@x
+while k<l do
+  begin dump_wd(eqtb[k]); incr(k);
+  end;
+@y
+dump_things(eqtb[k], l-k);
+@z
+
+@x
+while k<l do
+  begin dump_wd(eqtb[k]); incr(k);
+  end;
+@y
+dump_things(eqtb[k], l-k);
+@z
+
+@x
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+@y
+k:=j+1; dump_int(k-l);
+until k>eqtb_size;
+if hash_high>0 then dump_things(eqtb[eqtb_size+1],hash_high);
+  {dump |hash_extra| part}
+@z
+
+@x
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+@y
+undump_things(eqtb[k], x);
+@z
+
+@x
+until k>eqtb_size
+@y
+until k>eqtb_size;
+if hash_high>0 then undump_things(eqtb[eqtb_size+1],hash_high);
+  {undump |hash_extra| part}
+@z
+
+@x
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+@y
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used+hash_high;
+@z
+
+@x
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+@y
+dump_things(hash[hash_used+1], undefined_control_sequence-1-hash_used);
+if hash_high>0 then dump_things(hash[eqtb_size+1], hash_high);
+@z
+
+@x
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+@y
+undump_things (hash[hash_used+1], undefined_control_sequence-1-hash_used);
+if debug_format_file then begin
+  print_csnames (hash_base, undefined_control_sequence - 1);
+end;
+if hash_high > 0 then begin
+  undump_things (hash[eqtb_size+1], hash_high);
+  if debug_format_file then begin
+    print_csnames (eqtb_size + 1, hash_high - (eqtb_size + 1));
+  end;
+end;
+@z
+
+@x
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font(k);@/
+end
+@y
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font(k);@/
+end;
+make_pdftex_banner
+@z
+
+@x
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+if active_max_ptr>0 then begin
+  print_ln; print_int(active_max_ptr); print(" words of active ocps");
+  end;
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+@y
+if active_max_ptr>0 then
+  dump_things(active_info[0], active_max_ptr);
+if active_max_ptr>0 then begin
+  print_ln; print_int(active_max_ptr); print(" words of active ocps");
+  end;
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+if active_max_ptr>0 then
+  undump_things(active_info[0], active_max_ptr);
+@z
+
+@x
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+  dump_int(ocp_list_list[k]);
+  if null_ocp_list<>ocp_list_ptr then begin
+    print_nl("\ocplist"); 
+    print_esc(ocp_list_id_text(k)); 
+    print_char("=");
+    print_ocp_list(ocp_list_list[k]);
+    end;
+  end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+@y
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+dump_things(ocp_list_info[0], ocp_listmem_ptr);
+dump_int(ocp_list_ptr);
+dump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+for k:=null_ocp_list to ocp_list_ptr do begin
+  if null_ocp_list<>ocp_list_ptr then begin
+    print_nl("\ocplist"); 
+    print_esc(ocp_list_id_text(k)); 
+    print_char("=");
+    print_ocp_list(ocp_list_list[k]);
+    end;
+  end;
+dump_int(ocp_lstackmem_ptr);
+dump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+
+@x
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+  undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+@y
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+undump_things(ocp_list_info[0], ocp_listmem_ptr);
+undump_size(0)(1000000)('ocp list max')(ocp_list_ptr);
+undump_things(ocp_list_list[null_ocp_list], ocp_list_ptr+1-null_ocp_list);
+undump_size(0)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+undump_things(ocp_lstack_info[0], ocp_lstackmem_ptr)
+@z
+
+@x
+undump(batch_mode)(error_stop_mode)(interaction);
+@y
+undump(batch_mode)(error_stop_mode)(interaction);
+if interactionoption<>unspecified_mode then interaction:=interactionoption;
+@z
+
+@x
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+@y
+if x<>69069 then goto bad_fmt
+@z
+
+@x
+print(" (preloaded format="); print(job_name); print_char(" ");
+@y
+print(" (format="); print(job_name); print_char(" ");
+@z
+
+@x
+@p begin @!{|start_here|}
+@y
+@d const_chk(#)==begin if # < inf_@&# then # := inf_@&# else
+                         if # > sup_@&# then # := sup_@&# end
+
+{|setup_bound_var| stuff duplicated in \.{mf.ch}.}
+@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end
+@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end
+@d setup_bound_var_end_end(#)==if luainit>0 then begin
+	get_lua_number('texconfig',bound_name,addressof(#));
+	if #=0 then #:=bound_default;
+    end
+  else
+    setupboundvariable(addressof(#), bound_name, bound_default);
+
+@p procedure main_body;
+begin @!{|start_here|}
+
+{Bounds that may be set from the configuration file. We want the user to
+ be able to specify the names with underscores, but \.{TANGLE} removes
+ underscores, so we're stuck giving the names twice, once as a string,
+ once as the identifier. How ugly.}
+
+  setup_bound_var (100000)('pool_size')(pool_size);
+  setup_bound_var (75000)('string_vacancies')(string_vacancies);
+  setup_bound_var (5000)('pool_free')(pool_free); {min pool avail after fmt}
+  setup_bound_var (15000)('max_strings')(max_strings);
+  setup_bound_var (100)('strings_free')(strings_free);
+  setup_bound_var (3000)('buf_size')(buf_size);
+  setup_bound_var (50)('nest_size')(nest_size);
+  setup_bound_var (15)('max_in_open')(max_in_open);
+  setup_bound_var (60)('param_size')(param_size);
+  setup_bound_var (4000)('save_size')(save_size);
+  setup_bound_var (300)('stack_size')(stack_size);
+  setup_bound_var (16384)('dvi_buf_size')(dvi_buf_size);
+  setup_bound_var (79)('error_line')(error_line);
+  setup_bound_var (50)('half_error_line')(half_error_line);
+  setup_bound_var (79)('max_print_line')(max_print_line);
+  setup_bound_var(1000)('ocp_list_size')(ocp_list_size);
+  setup_bound_var(1000)('ocp_buf_size')(ocp_buf_size);
+  setup_bound_var(1000)('ocp_stack_size')(ocp_stack_size);
+  setup_bound_var (0)('hash_extra')(hash_extra);
+  setup_bound_var (72)('pk_dpi')(pk_dpi);
+  setup_bound_var (10000)('expand_depth')(expand_depth);
+
+  {Check other constants against their sup and inf.}
+  const_chk (buf_size);
+  const_chk (nest_size);
+  const_chk (max_in_open);
+  const_chk (param_size);
+  const_chk (save_size);
+  const_chk (stack_size);
+  const_chk (dvi_buf_size);
+  const_chk (pool_size);
+  const_chk (string_vacancies);
+  const_chk (pool_free);
+  const_chk (max_strings);
+  const_chk (strings_free);
+  const_chk (hash_extra);
+  const_chk (obj_tab_size);
+  const_chk (pdf_mem_size);
+  const_chk (dest_names_size);
+  const_chk (pk_dpi);
+  if error_line > ssup_error_line then error_line := ssup_error_line;
+
+  {array memory allocation}
+  buffer:=xmallocarray (packed_ASCII_code, buf_size);
+  nest:=xmallocarray (list_state_record, nest_size);
+  save_stack:=xmallocarray (memory_word, save_size);
+  input_stack:=xmallocarray (in_state_record, stack_size);
+  input_file:=xmallocarray (alpha_file, max_in_open);
+  input_file_callback_id:=xmallocarray (integer, max_in_open);
+  line_stack:=xmallocarray (integer, max_in_open);
+  eof_seen:=xmallocarray (boolean, max_in_open);
+  grp_stack:=xmallocarray (save_pointer, max_in_open);
+  if_stack:=xmallocarray (pointer, max_in_open);
+  source_filename_stack:=xmallocarray (str_number, max_in_open);
+  full_source_filename_stack:=xmallocarray (str_number, max_in_open);
+  param_stack:=xmallocarray (halfword, param_size);
+  dvi_buf:=xmallocarray (real_eight_bits, dvi_buf_size);
+  ocp_list_info:=xmallocarray (memory_word, ocp_list_size);
+  memset(ocp_list_info,0,sizeof(memory_word)* ocp_list_size);
+  ocp_lstack_info:=xmallocarray (memory_word, ocp_list_size);
+  memset(ocp_lstack_info,0,sizeof(memory_word)* ocp_list_size);
+  ocp_list_list:=xmallocarray (ocp_list_index, ocp_list_size);
+  otp_init_input_buf:=xmallocarray (quarterword, ocp_buf_size);
+  otp_input_buf:=xmallocarray (quarterword, ocp_buf_size);
+  otp_output_buf:=xmallocarray (quarterword, ocp_buf_size);
+  otp_stack_buf:=xmallocarray (quarterword, ocp_stack_size);
+  otp_calcs:=xmallocarray (halfword, ocp_stack_size);
+  otp_states:=xmallocarray (halfword, ocp_stack_size);
+  obj_tab:=xmallocarray (obj_entry, inf_obj_tab_size); {will grow dynamically}
+  obj_offset(0):=0;
+  pdf_mem:=xmallocarray (integer, inf_pdf_mem_size); {will grow dynamically}
+  dest_names:=xmallocarray (dest_name_entry, inf_dest_names_size); {will grow dynamically}
+  pdf_op_buf:=xmallocarray (real_eight_bits, pdf_op_buf_size);
+  pdf_os_buf:=xmallocarray (real_eight_bits, inf_pdf_os_buf_size); {will grow dynamically}
+  pdf_os_objnum:=xmallocarray (integer, pdf_os_max_objs);
+  pdf_os_objoff:=xmallocarray (integer, pdf_os_max_objs);
+@+Init
+  fixmem:=xmallocarray (smemory_word, fix_mem_init+1);
+  memset (voidcast(fixmem), 0, (fix_mem_init+1)*sizeof(smemory_word));
+  fix_mem_min:=0;
+  fix_mem_max:=fix_mem_init;
+
+  eqtb_top := eqtb_size+hash_extra;
+  if hash_extra=0 then hash_top:=undefined_control_sequence else
+        hash_top:=eqtb_top;
+  yhash:=xmallocarray (two_halves,1+hash_top-hash_offset);
+  hash:=yhash - hash_offset;   {Some compilers require |hash_offset=0|}
+  next(hash_base):=0; text(hash_base):=0;
+  for hash_used:=hash_base+1 to hash_top do hash[hash_used]:=hash[hash_base];
+  zeqtb:=xmallocarray (memory_word, eqtb_top);
+  eqtb:=zeqtb;
+
+  str_start:=xmallocarray (pool_pointer, max_strings);
+  str_pool:=xmallocarray (packed_ASCII_code, pool_size);
+@+Tini
+@z
+
+@x
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+@y
+@!Init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+Tini@/
+@z
+
+@x
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+@y
+close_files_and_terminate;
+final_end: do_final_end;
+end {|main_body|};
+@z
+
+@x
+  wterm(banner);
+@y
+  if srcspecialsp or filelineerrorstylep or parsefirstlinep then
+    wterm(banner_k)
+  else
+    wterm(banner);
+@z
+
+@x
+  if format_ident=0 then wterm_ln(' (no format preloaded)')
+  else  begin slow_print(format_ident); print_ln;
+    end;
+@y
+  wterm(versionstring);
+  if format_ident>0 then slow_print(format_ident);
+  print_ln;
+  if shellenabledp then begin
+    wterm_ln(' \write18 enabled.')
+  end;
+  if srcspecialsp then begin
+    wterm_ln(' Source specials enabled.')
+  end;
+  if filelineerrorstylep then begin
+    wterm_ln(' file:line:error style messages enabled.')
+  end;
+  if parsefirstlinep then begin
+   wterm_ln(' %&-line parsing enabled.')
+  end;
+@z
+
+
+
+@x
+     slow_print(log_name); print_char(".");
+@y
+     print_file_name(0, log_name, 0); print_char(".");
+@z
+
+@x
+  end;
+@y
+  end;
+print_ln;
+if (edit_name_start<>0) and (interaction>batch_mode) then
+  calledit(str_pool,edit_name_start,edit_name_length,edit_line);
+@z
+
+@x
+  wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+    hash_size:1);@/
+@y
+  wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+    hash_size:1, '+', hash_extra:1);@/
+@z
+
+@x
+  begin @!init for i:=0 to biggest_used_mark do begin
+@y
+  begin @!Init for i:=0 to biggest_used_mark do begin
+@z
+
+@x
+  store_fmt_file; return;@+tini@/
+@y
+  store_fmt_file; return;@+Tini@/
+@z
+
+@x
+if (format_ident=0)or(buffer[loc]="&") then
+@y
+if (format_ident=0)or(buffer[loc]="&")or dump_line then
+@z
+
+@x
+  w_close(fmt_file);
+@y
+  w_close(fmt_file);
+  eqtb:=zeqtb;
+@z
+
+@x
+fix_date_and_time;@/
+@y
+fix_date_and_time;@/
+@!init
+make_pdftex_banner;
+tini@/
+@z
+
+@x
+    begin goto breakpoint;@\ {go to every label at least once}
+    breakpoint: m:=0; @{'BREAKPOINT'@}@\
+    end
+@y
+    abort {do something to cause a core dump}
+@z
+
+@x
+primitive("special",extension,special_node);@/
+@y
+primitive("special",extension,special_node);@/
+text(frozen_special):="special"; eqtb[frozen_special]:=eqtb[cur_val];@/
+@z
+
+@x
+  else if cur_val>15 then cur_val:=16;
+@y
+  else if (cur_val>15) and (cur_val <> 18) then cur_val:=16;
+@z
+
+@x
+begin @<Expand macros in the token list
+@y
+@!d:integer; {number of characters in incomplete current string}
+@!clobbered:boolean; {system string is ok?}
+begin @<Expand macros in the token list
+@z
+
+@x
+if write_open[j] then selector:=j
+@y
+if j=18 then selector := new_string
+else if write_open[j] then selector:=j
+@z
+
+@x
+flush_list(def_ref); selector:=old_setting;
+@y
+flush_list(def_ref);
+if j=18 then
+  begin if (tracing_online<=0) then
+    selector:=log_only  {Show what we're doing in the log file.}
+  else selector:=term_and_log;  {Show what we're doing.}
+  {If the log file isn't open yet, we can only send output to the terminal.
+   Calling |open_log_file| from here seems to result in bad data in the log.}
+  if not log_opened then selector:=term_only;
+  print_nl("system(");
+  for d:=0 to cur_length-1 do
+    begin {|print| gives up if passed |str_ptr|, so do it by hand.}
+    print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|}
+    end;
+  print(")...");
+  if shellenabledp then
+    begin str_room(1); append_char(0); {Append a null byte to the expansion.}
+    clobbered:=false;
+    for d:=0 to cur_length-1 do {Convert to external character set.}
+      begin str_pool[str_start_macro(str_ptr)+d]:=xchr[str_pool[str_start_macro(str_ptr)+d]];
+      if (str_pool[str_start_macro(str_ptr)+d]=null_code)
+         and (d<cur_length-1) then clobbered:=true;
+        {minimal checking: NUL not allowed in argument string of |system|()}
+      end;
+    if clobbered then print("clobbered")
+    else begin {We have the string; run system(3). We don't have anything
+            reasonable to do with the return status, unfortunately discard it.}
+      system(stringcast(addressof(str_pool[str_start_macro(str_ptr)])));
+      print("executed");
+      end;
+    end
+  else begin print("disabled");
+  end;
+  print_char("."); print_nl(""); print_ln;
+  pool_ptr:=str_start_macro(str_ptr);  {erase the string}
+end;
+selector:=old_setting;
+@z
+
+@x
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+@y
+@!grp_stack : ^save_pointer; {initial |cur_boundary|}
+@!if_stack : ^pointer; {initial |cond_ptr|}
+@z
+
+@x
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+@y
+@!otp_init_input_buf:^quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:^quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:^quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:^quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:^halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:^halfword;
+@z
+
+@x
+@* \[54] System-dependent changes.
+@y
+@* \[54/web2c] System-dependent changes for Web2c.
+Here are extra variables for Web2c.  (This numbering of the
+system-dependent section allows easy integration of Web2c and e-\TeX, etc.)
+@^<system dependencies@>
+
+@<Glob...@>=
+@!edit_name_start: pool_pointer; {where the filename to switch to starts}
+@!edit_name_length,@!edit_line: integer; {what line to start editing at}
+@!ipcon: cinttype; {level of IPC action, 0 for none [default]}
+@!stop_at_space: boolean; {whether |more_name| returns false for space}
+
+@ The |edit_name_start| will be set to point into |str_pool| somewhere after
+its beginning if \TeX\ is supposed to switch to an editor on exit.
+
+@<Set init...@>=
+edit_name_start:=0;
+stop_at_space:=true;
+
+@ These are used when we regenerate the representation of the first 256
+strings.
+
+@<Global...@> =
+@!save_str_ptr: str_number;
+@!save_pool_ptr: pool_pointer;
+@!shellenabledp: cinttype;
+@!output_comment: ^char;
+@!k,l: 0..255; {used by `Make the first 256 strings', etc.}
+
+@ When debugging a macro package, it can be useful to see the exact
+control sequence names in the format file.  For example, if ten new
+csnames appear, it's nice to know what they are, to help pinpoint where
+they came from.  (This isn't a truly ``basic'' printing procedure, but
+that's a convenient module in which to put it.)
+
+@<Basic printing procedures@> =
+procedure print_csnames (hstart:integer; hfinish:integer);
+var c,h:integer;
+begin
+  writeln(stderr, 'fmtdebug:csnames from ', hstart, ' to ', hfinish, ':');
+  for h := hstart to hfinish do begin
+    if text(h) > 0 then begin {if have anything at this position}
+      for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1
+      do begin
+        putbyte(str_pool[c], stderr); {print the characters}
+      end;
+      writeln(stderr, '|');
+    end;
+  end;
+end;
+
+@ Are we printing extra info as we read the format file?
+
+@<Glob...@> =
+@!debug_format_file: boolean;
+
+
+@ A helper for printing file:line:error style messages.  Look for a
+filename in |full_source_filename_stack|, and if we fail to find
+one fall back on the non-file:line:error style.
+
+@<Basic print...@>=
+procedure print_file_line;
+var level: 0..max_in_open;
+begin
+  level:=in_open;
+  while (level>0) and (full_source_filename_stack[level]=0) do
+    decr(level);
+  if level=0 then
+    print_nl("! ")
+  else begin
+    print_nl (""); print (full_source_filename_stack[level]); print (":");
+    if level=in_open then print_int (line)
+    else print_int (line_stack[index+1-(in_open-level)]);
+    print (": ");
+  end;
+end;
+
+@ To be able to determine whether \.{\\write18} is enabled from within
+\TeX\ we also implement \.{\\eof18}.  We sort of cheat by having an
+additional route |scan_four_bit_int_or_18| which is the same as
+|scan_four_bit_int| except it also accepts the value 18.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int_or_18;
+begin scan_int;
+if (cur_val<0)or((cur_val>15)and(cur_val<>18)) then
+  begin print_err("Bad number");
+@.Bad number@>
+  help2("Since I expected to read a number between 0 and 15,")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+
+@* \[54/web2c-string] The string recycling routines.  \TeX{} uses 2
+upto 4 {\it new\/} strings when scanning a filename in an \.{\\input},
+\.{\\openin}, or \.{\\openout} operation.  These strings are normally
+lost because the reference to them are not saved after finishing the
+operation.  |search_string| searches through the string pool for the
+given string and returns either 0 or the found string number.
+
+@<Declare additional routines for string recycling@>=
+function search_string(@!search:str_number):str_number;
+label found;
+var result: str_number;
+@!s: str_number; {running index}
+@!len: integer; {length of searched string}
+begin result:=0; len:=length(search);
+if len=0 then  {trivial case}
+  begin result:=""; goto found;
+  end
+else  begin s:=search-1;  {start search with newest string below |s|; |search>1|!}
+  while s>=string_offset do  {first |string_offset| strings depend on implementation!!}
+    begin if length(s)=len then
+      if str_eq_str(s,search) then
+        begin result:=s; goto found;
+        end;
+    decr(s);
+    end;
+  end;
+found:search_string:=result;
+end;
+
+@ The following routine is a variant of |make_string|.  It searches
+the whole string pool for a string equal to the string currently built
+and returns a found string.  Otherwise a new string is created and
+returned.  Be cautious, you can not apply |flush_string| to a replaced
+string!
+
+@<Declare additional routines for string recycling@>=
+function slow_make_string : str_number;
+label exit;
+var s: str_number; {result of |search_string|}
+@!t: str_number; {new string}
+begin t:=make_string; s:=search_string(t);
+if s>0 then
+  begin flush_string; slow_make_string:=s; return;
+  end;
+slow_make_string:=t;
+exit:end;
+
+
+@* \[54] System-dependent changes.
+@z
+
+
+@x
+@* \[55] Index.
+@y
+
+@ @<Declare action procedures for use by |main_control|@>=
+
+procedure insert_src_special;
+var toklist, p, q,r : pointer;
+begin
+  if (source_filename_stack[in_open] > 0 and isnewsource (source_filename_stack[in_open]
+, line)) then begin
+    toklist := get_avail;
+    p := toklist;
+    info(p) := cs_token_flag+frozen_special;
+    r := get_avail; link(p):=r; p := link(p);
+    info(p) := left_brace_token+"{";
+    q := str_toks (makesrcspecial (source_filename_stack[in_open], line));
+    link(p) := link(temp_token_head);
+    p := q;
+    r := get_avail; link(p):=r; p := link(p);
+    info(p) := right_brace_token+"}";
+    ins_list (toklist);
+    remembersourceinfo (source_filename_stack[in_open], line);
+  end;
+end;
+
+procedure append_src_special;
+var q : pointer;
+begin
+  if (source_filename_stack[in_open] > 0 and isnewsource (source_filename_stack[in_open]
+, line)) then begin
+    new_whatsit (special_node);
+    write_stream(tail) := 0;
+    q:=get_avail; def_ref := q;
+    token_ref_count(def_ref) := null;
+    q := str_toks (makesrcspecial (source_filename_stack[in_open], line));
+    link(def_ref) := link(temp_head);
+    write_tokens(tail) := def_ref;
+    remembersourceinfo (source_filename_stack[in_open], line);
+  end;
+end;
+
+@ This function used to be in pdftex, but is useful in tex too.
+
+@p function get_nullstr: str_number;
+begin
+    get_nullstr := "";
+end;
+
+@* \[55] Index.
+@z
+
diff --git a/Build/source/texk/web2c/luatexdir/luatex.defines b/Build/source/texk/web2c/luatexdir/luatex.defines
new file mode 100644
index 00000000000..b2d296671dc
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex.defines
@@ -0,0 +1,560 @@
+{
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+}
+
+{ luatex.defines: additions for luaTeX }
+
+@define function new_node();
+@define function new_glyph_node;
+@define procedure flush_node();
+@define function copy_node();
+@define procedure couple_nodes();
+@define function copy_node_list();
+@define procedure flush_node_list();
+@define function string_to_pseudo();
+@define function do_set_attribute();
+@define function copy_attribute_list();
+@define procedure add_node_attr_ref();
+@define procedure replace_attribute_list();
+@define procedure update_attribute_cache;
+
+@define function new_span_node();
+
+@define function sizeof();
+@define procedure memset();
+@define function realloc();
+@define function malloc();
+@define function voidcast();
+@define function fixmemcast();
+@define function varmemcast();
+@define type void;
+@define procedure init_node_mem();
+@define procedure print_node_mem_stats();
+@define procedure dump_node_mem;
+@define procedure undump_node_mem;
+@define function visible_last_node_type();
+@define var NULL;
+@define var varmem;
+@define var var_mem_max;
+@define procedure check_buffer_overflow();
+@define procedure check_pool_overflow();
+
+@define function new_ligkern();
+@define function make_lang_data();
+@define procedure ext_do_line_break();
+@define procedure initialize_active;
+@define var active_node_size;
+@define var prev_char_p;
+@define function cur_break();
+@define function break_node();
+
+@define function divide_scaled();
+@define function divide_scaled_n();
+
+@define procedure new_hyphenation();
+@define procedure load_tex_hyphenation();
+@define procedure load_tex_patterns();
+@define procedure dump_language_data;
+@define procedure undump_language_data;
+@define function insert_discretionary();
+@define procedure set_pre_hyphen_char();
+@define procedure set_post_hyphen_char();
+@define function get_pre_hyphen_char();
+@define function get_post_hyphen_char();
+
+{ macros from luatex.h }
+@define function pdf_char_marked();
+@define function tex_b_open_in();
+@define function vf_b_open_in ();
+@define procedure pdf_mark_char();
+@define procedure writepdf();
+@define procedure pdfassert();
+
+@define procedure luacall();
+@define procedure luatokencall();
+@define procedure closelua();
+
+@define function  luacstring_input;
+@define function  luacstring_penultimate;
+@define function  luacstring_detokenized;
+@define function  luacstring_cattable;
+@define function  luacstring_defaultcattable;
+@define function  luacstring_simple;
+@define procedure luacstring_close();
+@define procedure luacstring_start();
+
+{ for callbacks }
+
+@define function  run_callback();
+@define function  run_and_save_callback();
+@define function  run_saved_callback();
+@define procedure destroy_saved_callback();
+@define function  callback_defined();
+@define function  callbackluaid();
+@define var find_write_file_callback;
+@define var find_output_file_callback;
+@define var find_image_file_callback;
+@define var find_format_file_callback;
+@define var find_read_file_callback;      
+@define var open_read_file_callback;
+@define var find_ocp_file_callback;
+@define var read_ocp_file_callback;
+@define var find_vf_file_callback;
+@define var read_vf_file_callback;
+@define var find_data_file_callback;
+@define var read_data_file_callback;
+@define var find_font_file_callback;
+@define var read_font_file_callback;
+@define var find_map_file_callback;
+@define var read_map_file_callback;
+@define var find_enc_file_callback;
+@define var read_enc_file_callback;
+@define var find_type1_file_callback;
+@define var read_type1_file_callback;
+@define var find_truetype_file_callback;
+@define var read_truetype_file_callback;
+@define var find_opentype_file_callback;
+@define var read_opentype_file_callback;
+@define var find_sfd_file_callback;
+@define var read_sfd_file_callback;
+@define var find_pk_file_callback;
+@define var read_pk_file_callback;
+@define var show_error_hook_callback;
+@define var process_input_buffer_callback;
+@define var start_page_number_callback;
+@define var stop_page_number_callback;
+@define var start_run_callback;
+@define var stop_run_callback;
+@define var define_font_callback;
+@define var token_filter_callback;
+@define var pre_linebreak_filter_callback;
+@define var post_linebreak_filter_callback;
+@define var buildpage_filter_callback;
+@define var hyphenate_callback;
+
+@define function lua_hyphenate_callback();
+
+@define procedure get_saved_lua_boolean();
+@define procedure get_saved_lua_number();
+@define procedure get_saved_lua_string();
+@define procedure get_lua_boolean();
+@define procedure get_lua_number();
+@define procedure get_lua_string();
+
+@define procedure get_token_lua;
+@define procedure lua_node_filter();
+@define procedure lua_node_filter_s();
+@define function lua_hpack_filter();
+@define function lua_vpack_filter();
+
+{ bits for extended char code access }
+
+@define function get_math_code();
+@define procedure set_math_code();
+@define function get_del_code_a();
+@define function get_del_code_b();
+@define procedure set_del_code();
+
+@define procedure unsave_math_codes ();
+@define procedure initialize_math_codes;
+@define procedure dump_math_codes;
+@define procedure undump_math_codes;
+
+@define function get_lc_code();
+@define procedure set_lc_code();
+
+@define function get_uc_code();
+@define procedure set_uc_code();
+
+@define function get_sf_code();
+@define procedure set_sf_code();
+
+@define function get_cat_code();
+@define procedure set_cat_code();
+
+@define function valid_catcode_table ();
+@define procedure clear_catcode_stack ();
+@define procedure copy_cat_codes ();
+@define procedure initex_cat_codes ();
+@define procedure unsave_cat_codes ();
+@define procedure unsave_text_codes ();
+@define procedure initializetextcodes;
+@define procedure dumptextcodes;
+@define procedure undumptextcodes;
+
+@define procedure dumpluacregisters;
+@define procedure undumpluacregisters;
+
+@define function do_a_open_out();
+@define function do_b_open_out();
+
+@define procedure flush_loggable_info;
+
+@define var extra_version_info;
+
+{ bits and pieces from aleph }
+
+@define procedure btestin ;
+
+@define function readtfmfile();
+@define function next_vf_byte;
+@define function read_vf_file();
+@define function read_ocp_file();
+@define function read_data_file();
+
+@define var ocp_tables;
+
+@define procedure allocate_ocp_table ();
+@define procedure dump_ocp_table ();
+@define procedure undump_ocp_table ();
+@define procedure run_external_ocp ();
+
+@define function loadpoolstrings();
+
+{ 'texfont' library definitions }
+
+@define procedure dump_font ();
+@define procedure undump_font ();
+@define function  is_valid_font();
+@define function  copy_font();
+@define function  scale_font();
+@define function  max_font_id;
+@define procedure set_max_font_id();
+
+@define function font_name();
+@define function font_area();
+@define function get_font_name();
+@define function get_font_area();
+@define function font_bc();
+@define function font_ec();
+
+@define function tex_font_name();
+@define function tex_font_area();
+@define procedure set_tex_font_name();
+
+@define procedure set_pdf_font_size();
+@define procedure set_pdf_font_num();
+@define procedure set_pdf_font_blink();
+@define procedure set_pdf_font_elink();
+@define procedure set_pdf_font_expand_ratio();
+@define procedure set_pdf_font_shrink();
+@define procedure set_pdf_font_stretch();
+@define procedure set_pdf_font_step();
+@define procedure set_pdf_font_auto_expand();
+@define procedure set_pdf_font_attr();
+
+@define function pdf_font_size();
+@define function pdf_font_num();
+@define function pdf_font_blink();
+@define function pdf_font_elink();
+@define function pdf_font_expand_ratio();
+@define function pdf_font_shrink();
+@define function pdf_font_stretch();
+@define function pdf_font_step();
+@define function pdf_font_auto_expand();
+@define function pdf_font_attr();
+
+@define function cmp_font_area();
+@define function cmp_font_name();
+@define function font_shareable();
+
+@define function fontglue();
+@define procedure setfontglue();
+
+@define function font_check_0();
+@define function font_check_1();
+@define function font_check_2();
+@define function font_check_3();
+
+@define function font_size();
+@define function font_slant();
+@define function font_extend();
+@define function font_used();
+@define procedure set_font_used();
+@define function font_touched();
+@define procedure set_font_touched();
+
+@define function font_dsize();
+@define function font_natural_dir();
+
+@define function font_params();
+@define function font_param();
+@define procedure set_font_params();
+@define procedure set_font_param();
+@define function slant();
+@define function quad();
+@define function x_height();
+@define function space();
+@define function extra_space();
+@define function space_stretch();
+@define function space_shrink();
+
+@define function font_kerns();
+@define function font_kern_sc();
+@define procedure adjust_font_kern();
+
+@define function font_italics();
+@define function font_italic();
+@define procedure set_font_italic();
+
+@define function has_lig();
+@define function has_kern();
+
+@define type liginfo;
+
+@define function get_ligature();
+@define function is_valid_ligature();
+@define function lig_type();
+@define function lig_replacement();
+
+@define function is_ligature();
+@define function is_leftboundary();
+@define function is_rightboundary();
+
+@define procedure set_to_character();
+@define procedure set_to_glyph();
+@define procedure set_is_leftghost();
+@define procedure set_is_rightghost();
+
+@define var non_boundarychar;
+
+@define function ext_top();
+@define function ext_mid();
+@define function ext_bot();
+@define function ext_rep();
+
+@define var ext_tag;
+@define var list_tag;
+
+@define var virtual_font_type;
+@define function font_type();
+
+@define function font_format();
+@define function char_index();
+@define function font_cidregistry();
+@define function font_encodingbytes();
+
+@define function font_map();
+@define procedure set_font_map();
+
+
+@define function hyphen_char();
+@define function skew_char();
+@define procedure set_hyphen_char();
+@define procedure set_skew_char();
+@define function char_exists();
+
+@define function char_used();
+@define function char_name();
+@define function char_width();
+@define function char_height();
+@define function char_depth();
+@define function char_italic();
+@define function char_tag();
+@define procedure set_char_tag();
+@define function char_remainder();
+
+@define function char_info_short();
+
+@define function has_packet();
+@define procedure do_vf_packet();
+@define function expand_font_name();
+@define function auto_expand_font();
+@define procedure vf_expand_local_fonts();
+@define function letter_space_font();
+@define function read_font_info();
+
+@define function get_tag_code();
+@define function get_lp_code();
+@define function get_rp_code();
+@define function get_ef_code();
+@define procedure set_tag_code();
+@define procedure set_lp_code();
+@define procedure set_rp_code();
+@define procedure set_ef_code();
+
+@define function test_no_ligatures();
+@define procedure set_no_ligatures();
+
+@define function get_kern();
+@define function charkern();
+
+{ functions from mapfile.c }
+@define function hasfmentry();
+@define procedure checkextfm();
+@define procedure pdfmapfile();
+@define procedure pdfmapline();
+@define procedure pdf_init_map_file();
+
+@define procedure writefontstuff;
+
+{ functions from utils.c }
+@define procedure escapehex();
+@define procedure escapename();
+@define procedure escapestring();
+@define function ext_xn_over_d();
+@define procedure getcreationdate;
+@define function get_resname_prefix;
+@define function makecstring();
+
+@define procedure append_string();
+@define procedure matchstrings();
+@define procedure libpdffinish;
+@define procedure makepdftexbanner;
+@define procedure printcreationdate;
+@define procedure printmoddate;
+@define procedure print_ID();
+@define procedure set_job_id();
+@define procedure unescapehex();
+@define procedure write_stream_length();
+@define procedure removepdffile;
+@define procedure garbagewarning;
+@define function newcolorstack();
+@define function colorstackset();
+@define function colorstackpush();
+@define function colorstackpop();
+@define function colorstackcurrent();
+@define function colorstackused;
+@define function colorstackskippagestart();
+@define procedure checkpdfsave();
+@define procedure checkpdfrestore();
+@define procedure pdfshipoutbegin();
+@define procedure pdfshipoutend();
+@define procedure pdfsetmatrix();
+@define procedure matrixtransformpoint();
+@define procedure matrixtransformrect();
+@define function matrixused;
+@define procedure matrixrecalculate();
+@define function getllx;
+@define function getlly;
+@define function geturx;
+@define function getury;
+
+{functions from texpdf.c }
+
+@define procedure pdf_print_char();
+@define procedure pdf_print();
+@define procedure pdf_print_int();
+@define procedure pdf_print_real();
+@define procedure pdf_print_str();
+
+{functions from textoken.c }
+
+@define function get_next;
+
+{ functions from vfpacket.c }
+@define function new_vf_packet();
+@define function packet_byte;
+@define procedure start_packet();
+@define procedure store_packet();
+
+{ functions from writefont.c }
+@define procedure do_pdf_font();
+
+{ functions from writeimg.c }
+@define function check_image_b();
+@define function check_image_c();
+@define function check_image_i();
+@define function epdf_orig_x();
+@define function epdf_orig_y();
+@define function image_pages();
+@define function image_colordepth();
+@define function image_index();
+@define function image_width();
+@define function image_height();
+@define function image_depth();
+@define function image_objnum();
+@define function image_imgnum();
+@define function is_pdf_image();
+@define function read_image();
+@define function new_image_entry;
+@define procedure update_image_procset();
+@define procedure write_image();
+@define procedure scale_image();
+@define procedure set_image_dimensions();
+@define procedure set_image_index();
+@define procedure out_image();
+
+{ functions from limglib.c }
+@define procedure lua_setximage();
+
+{ functions from writet3.c }
+@define function get_pk_char_width();
+
+{ functions from writezip.c }
+@define procedure write_zip();
+
+{ functions from avlstuff.c }
+@define procedure avl_put_obj();
+@define function avl_find_obj();
+
+{ functions from tounicode.c }
+@define procedure def_tounicode();
+
+{ end of luatex.defines }
+
+{texmf.defines}
+
+@define type two_halves;
+@define type four_quarters;
+
+@define function input_ln ();
+@define function is_new_source ();
+@define function get_job_name ();
+@define function make_full_name_string;
+
+@define procedure seconds_and_micros ();
+@define function ocp_open_in ();
+@define function open_in_name_ok ();
+@define function open_out_name_ok ();
+
+@define function w_open_in ();
+@define function w_open_out ();
+
+@define procedure dump_hh ();
+@define procedure dump_int ();
+@define procedure dump_things ();
+@define procedure dump_wd ();
+
+@define procedure undump_hh ();
+@define procedure undump_int ();
+@define procedure undump_qqqq ();
+@define procedure undump_things ();
+@define procedure undump_checked_things ();
+@define procedure undump_upper_check_things ();
+@define procedure undump_wd ();
+@define procedure w_close ();
+
+{common.defines}
+
+@define type memory_word; {for gftodvi, TeX, and Metafont}
+
+@define function a_open_in ();
+@define procedure a_close ();
+@define procedure b_close ();
+@define function a_open_out ();
+@define function b_open_out ();
+
+@define procedure write_dvi ();
+@define procedure write_pdf ();
+@define procedure write_ln ();
+
+@define procedure recorder_change_filename ();
diff --git a/Build/source/texk/web2c/luatexdir/luatex.h b/Build/source/texk/web2c/luatexdir/luatex.h
new file mode 100644
index 00000000000..aef2f355396
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex.h
@@ -0,0 +1,173 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+*/
+
+/* some code array functions */
+
+extern void     set_math_code (integer n, halfword v, quarterword grouplevel);
+extern halfword get_math_code (integer n);
+
+extern void     set_del_code (integer n, halfword v,  halfword w, quarterword grouplevel);
+extern halfword get_del_code_a (integer n);
+extern halfword get_del_code_b (integer n);
+
+extern void unsavemathcodes (quarterword grouplevel);
+extern void initializemathcodes ();
+extern void dumpmathcodes ();
+extern void undumpmathcodes ();
+
+extern void     set_lc_code  (integer n, halfword v, quarterword grouplevel);
+extern halfword get_lc_code  (integer n);
+extern void     set_uc_code  (integer n, halfword v, quarterword grouplevel);
+extern halfword get_uc_code  (integer n);
+extern void     set_sf_code  (integer n, halfword v, quarterword grouplevel);
+extern halfword get_sf_code  (integer n);
+extern void     set_cat_code (integer h, integer n, halfword v, quarterword grouplevel);
+extern halfword get_cat_code (integer h, integer n);
+
+extern void unsavetextcodes (quarterword grouplevel);
+extern void unsavecatcodes (integer h,quarterword grouplevel);
+extern void copy_cat_codes (int from, int to);
+extern void initex_cat_codes (int h);
+extern void clearcatcodestack (integer h);
+extern boolean validcatcodetable (int h);
+
+extern void initializetextcodes ();
+extern void dumptextcodes ();
+extern void undumptextcodes ();
+
+typedef enum {
+  escape, left_brace, right_brace, math_shift, 
+  tab_mark, car_ret, mac_param, sup_mark, 
+  sub_mark, ignore, spacer, letter, 
+  other_char, active_char, comment, invalid_char } cat_codes;
+
+
+extern void do_vf(internal_font_number tmp_f);
+
+extern int readbinfile(FILE *f, unsigned char **b, integer *s);
+
+#define read_tfm_file  readbinfile
+#define read_vf_file   readbinfile
+#define read_ocp_file  readbinfile
+#define read_data_file readbinfile
+
+extern int **ocp_tables;
+
+extern void allocate_ocp_table();
+extern void dump_ocp_table();
+extern void undump_ocp_table();
+
+extern void run_external_ocp();
+extern void b_test_in();
+
+/* Additions to texmfmp.h for pdfTeX */
+
+/* mark a char in font */
+#define pdf_mark_char(f,c) set_char_used(f,c,true)
+
+/* test whether a char in font is marked */
+#define pdf_char_marked char_used
+
+/* writepdf() always writes by fwrite() */
+#define       write_pdf(a, b) \
+  (void) fwrite ((char *) &pdf_buf[a], sizeof (pdf_buf[a]), \
+                 (int) ((b) - (a) + 1), pdf_file)
+
+#define tex_b_open_in(f) \
+    open_input (&(f), kpse_tex_format, FOPEN_RBIN_MODE)
+#define ovf_b_open_in(f) \
+    open_input (&(f), kpse_ovf_format, FOPEN_RBIN_MODE)
+#define vf_b_open_in(f) \
+    open_input (&(f), kpse_vf_format, FOPEN_RBIN_MODE)
+
+extern int open_outfile(FILE **f, char *name, char *mode);
+
+#define do_a_open_out(f) open_outfile(&(f),(char *)(nameoffile+1),FOPEN_W_MODE)
+#define do_b_open_out(f) open_outfile(&(f),(char *)(nameoffile+1),FOPEN_WBIN_MODE)
+
+#define pdfassert assert
+#define voidcast(a) (void *)(a)
+#define varmemcast(a) (memory_word *)(a)
+#define fixmemcast(a) (smemory_word *)(a)
+extern volatile memory_word *varmem;
+extern halfword var_mem_min;
+extern halfword var_mem_max;
+extern halfword  get_node (integer s);
+extern void free_node (halfword p, integer s) ;
+extern void init_node_mem (integer r, integer s) ;
+extern void dump_node_mem (void) ;
+extern void undump_node_mem (void);
+
+
+typedef enum {
+  find_write_file_callback = 1,
+  find_output_file_callback,
+  find_image_file_callback,
+  find_format_file_callback,
+  find_read_file_callback,      open_read_file_callback,
+  find_ocp_file_callback,       read_ocp_file_callback,
+  find_vf_file_callback,        read_vf_file_callback,
+  find_data_file_callback,      read_data_file_callback,
+  find_font_file_callback,      read_font_file_callback,
+  find_map_file_callback,       read_map_file_callback,
+  find_enc_file_callback,       read_enc_file_callback,
+  find_type1_file_callback,     read_type1_file_callback,
+  find_truetype_file_callback,  read_truetype_file_callback,
+  find_opentype_file_callback,  read_opentype_file_callback,
+  find_sfd_file_callback,       read_sfd_file_callback,
+  find_pk_file_callback,        read_pk_file_callback,
+  show_error_hook_callback,
+  process_input_buffer_callback,
+  start_page_number_callback,  stop_page_number_callback,
+  start_run_callback,          stop_run_callback,
+  define_font_callback,
+  token_filter_callback,
+  pre_output_filter_callback,
+  buildpage_filter_callback,
+  hpack_filter_callback,  vpack_filter_callback,
+  char_exists_callback, 
+  hyphenate_callback,
+  ligaturing_callback,
+  kerning_callback,
+  pre_linebreak_filter_callback,
+  linebreak_filter_callback, 
+  post_linebreak_filter_callback,
+  total_callbacks } callback_callback_types;
+
+extern int callback_set[];
+
+#define callback_defined(a) callback_set[a]
+
+extern int  run_callback          (int i, char *values, ...);
+extern int  run_saved_callback     (int i, char *name, char *values, ...);
+extern int  run_and_save_callback   (int i, char *values, ...);
+extern void destroy_saved_callback (int i);
+
+extern void get_saved_lua_boolean   (int i, char *name, boolean *target);
+extern void get_saved_lua_number    (int i, char *name, integer *target);
+extern void get_saved_lua_string    (int i, char *name, char **target);
+
+extern void get_lua_boolean        (char *table, char *name, boolean *target);
+extern void get_lua_number         (char *table, char *name, integer *target);
+extern void get_lua_string         (char *table, char *name, char **target);
+
+#include <luatexdir/ptexlib.h>
diff --git a/Build/source/texk/web2c/luatexdir/luatex.mk b/Build/source/texk/web2c/luatexdir/luatex.mk
new file mode 100644
index 00000000000..ed745cd261d
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex.mk
@@ -0,0 +1,170 @@
+# Makefile fragment for pdfeTeX and web2c. --infovore@xs4all.nl. Public domain.
+# This fragment contains the parts of the makefile that are most likely to
+# differ between releases of pdfeTeX.
+
+# We build luatex
+luatex = @LTEX@ luatex
+luatexdir = luatexdir
+
+# libz
+ZLIBDIR=../../libs/zlib
+ZLIBSRCDIR=$(srcdir)/$(ZLIBDIR)
+# libpng
+LIBPNGDIR=../../libs/libpng
+LIBPNGSRCDIR=$(srcdir)/$(LIBPNGDIR)
+# libxpdf
+LIBXPDFDIR=../../libs/xpdf
+LIBXPDFSRCDIR=$(srcdir)/$(LIBXPDFDIR)
+# libobsdcompa
+LIBOBSDCOMPATDIR=../../libs/obsdcompat
+LIBOBSDCOMPATFSRCDIR=$(srcdir)/$(LIBOBSDCOMPATDIR)
+
+XCPPFLAGS=-I$(LIBOBSDCOMPATDIR) -I$(LIBOBSDCOMPATDIR)/.. -I$(LIBOBSDCOMPATFSRCDIR) -I$(LIBOBSDCOMPATFSRCDIR)/..  -I$(ZLIBSRCDIR) -I$(LIBPNGSRCDIR) -I$(LIBXPDFSRCDIR) -Dextra_version_info=`date +-%Y%m%d%H`
+
+Makefile: $(srcdir)/$(luatexdir)/luatex.mk
+
+# luatex_bin = luatex ttf2afm pdftosrc
+luatex_bin = luatex
+linux_build_dir = $(HOME)/luatex/build/linux/texk/web2c
+
+
+# Extract luatex version
+$(luatexdir)/luatex.version: $(srcdir)/$(luatexdir)/luatex.web
+	test -d $(luatexdir) || mkdir $(luatexdir)
+	grep '^@d luatex_version_string==' $(srcdir)/$(luatexdir)/luatex.web \
+	  | sed "s/^.*=='//;s/' .*$$//" \
+	  >$(luatexdir)/luatex.version
+
+# The C sources.
+luatex_c = luatexini.c luatex0.c luatex1.c luatex2.c luatex3.c
+luatex_o = luatexini.o luatex0.o luatex1.o luatex2.o luatex3.o luatexextra.o loadpool.o
+
+# Making luatex
+luatex: luatexd.h $(luatex_o) $(luatexextra_o) $(luatexlibsdep)
+	@CXXHACKLINK@ $(luatex_o) $(luatexextra_o) $(luatexlibs) $(socketlibs) @CXXHACKLDLIBS@ @CXXLDEXTRA@
+
+# C file dependencies.
+$(luatex_c) luatexcoerce.h luatexd.h: luatex.p $(web2c_texmf) $(srcdir)/$(luatexdir)/luatex.defines $(srcdir)/$(luatexdir)/luatex.h
+	$(web2c) luatex
+luatexextra.c: $(luatexdir)/luatexextra.h lib/texmfmp.c
+	test -d $(luatexdir) || mkdir $(luatexdir)
+	sed s/TEX-OR-MF-OR-MP/luatex/ $(srcdir)/lib/texmfmp.c >$@
+$(luatexdir)/luatexextra.h: $(luatexdir)/luatexextra.in $(luatexdir)/luatex.version
+	test -d $(luatexdir) || mkdir $(luatexdir)
+	sed -e s/LUATEX-VERSION/`cat $(luatexdir)/luatex.version`/ \
+	  $(srcdir)/$(luatexdir)/luatexextra.in >$@
+loadpool.c: luatex.pool $(luatexdir)/makecpool
+	$(native)/$(luatexdir)/makecpool luatex.pool luatexdir/ptexlib.h > loadpool.c
+
+# luatangle we need a private version of tangle
+
+luatangle: luatangle.o
+	$(kpathsea_link) luatangle.o $(LOADLIBES)
+
+luatangle.c luatangle.h: luatangle.p
+	$(web2c) luatangle
+
+luatangle.p: tangle $(srcdir)/$(luatexdir)/luatangle.web $(srcdir)/$(luatexdir)/luatangle.ch
+	$(TANGLE) $(srcdir)/$(luatexdir)/luatangle.web $(srcdir)/$(luatexdir)/luatangle.ch
+
+# Tangling
+luatex.p luatex.pool: luatangle $(srcdir)/$(luatexdir)/luatex.web $(srcdir)/$(luatexdir)/luatex.ch
+	$(native)/luatangle --underlines $(srcdir)/$(luatexdir)/luatex.web $(srcdir)/$(luatexdir)/luatex.ch
+
+#   Sources for luatex.ch:
+#luatex_ch_srcs = $(srcdir)/$(luatexdir)/luatex.web \
+#  $(srcdir)/$(luatexdir)/lua.ch \
+#  $(srcdir)/$(luatexdir)/lua.ch0
+
+#   Rules:
+#luatex.ch: $(TIE) $(luatex_ch_srcs)
+#	$(TIE) -c luatex.ch $(luatex_ch_srcs)
+
+# for developing only
+#luatex-org.web: $(TIE) $(luatex_ch_srcs_org)
+#	$(TIE) -m $@ $(luatex_ch_srcs_org)
+#luatex-all.web: $(TIE) $(srcdir)/$(luatexdir)/luatex.web luatex.ch
+#	$(TIE) -m $@ $(srcdir)/$(luatexdir)/luatex.web luatex.ch
+#luatex-all.tex: luatex-all.web
+#	$(WEAVE) luatex-all.web
+#	echo -e '1s/ webmac/ pdfwebmac/\nw\nq' | ed $@ >/dev/null 2>&1
+#luatex-all.pdf: luatex-all.tex
+#	$(luatex) luatex-all.tex
+
+check: @PETEX@ luatex-check
+luatex-check: luatex luatex.fmt
+
+clean:: luatex-clean
+luatex-clean:
+	$(LIBTOOL) --mode=clean $(RM) luatex
+	rm -f $(luatex_o) $(luatex_c) luatexextra.c luatexcoerce.h
+	rm -f $(luatexdir)/luatexextra.h
+	rm -f luatexd.h luatex.p luatex.pool luatex.ch strpool.c
+	rm -f luatex.fmt luatex.log
+
+# Dumps
+all_luafmts = @FMU@ luatex.fmt $(luafmts)
+
+dumps: @LTEX@ luafmts
+luafmts: $(all_luafmts)
+
+luafmtdir = $(web2cdir)/luatex
+$(luafmtdir)::
+	$(SHELL) $(top_srcdir)/../mkinstalldirs $(luafmtdir)
+
+luatex.fmt: luatex
+	$(dumpenv) $(MAKE) progname=luatex files="etex.src plain.tex cmr10.tfm" prereq-check
+	$(dumpenv) ./luatex --progname=luatex --jobname=luatex --ini \*\\pdfoutput=1\\input etex.src \\dump </dev/null
+
+# 
+# Installation.
+install-luatex: install-luatex-exec
+install-luatex-exec: install-luatex-links
+
+# The actual binary executables and pool files.
+install-programs: @PETEX@ install-luatex-programs
+install-luatex-programs: $(luatex) $(bindir)
+	for p in luatex; do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done
+
+install-links: @PETEX@ install-luatex-links
+install-luatex-links: install-luatex-programs
+	#cd $(bindir) && (rm -f luainitex luavirtex; \
+	#  $(LN) luatex luainitex; $(LN) luatex luavirtex)
+
+install-fmts: @PETEX@ install-luatex-fmts
+install-luatex-fmts: luafmts $(luafmtdir)
+	luafmts="$(all_luafmts)"; \
+	  for f in $$luafmts; do $(INSTALL_DATA) $$f $(luafmtdir)/$$f; done
+	luafmts="$(luafmts)"; \
+	  for f in $$luafmts; do base=`basename $$f .fmt`; \
+	    (cd $(bindir) && (rm -f $$base; $(LN) luatex $$base)); done
+
+# 
+# luatex binaries archive
+luatexbin:
+	$(MAKE) $(luatex_bin)
+
+luatex-cross:
+	$(MAKE) web2c-cross
+	$(MAKE) luatexbin
+
+web2c-cross: $(web2c_programs)
+	@if test ! -x $(linux_build_dir)/luatangle; then echo Error: linux_build_dir not ready; exit -1; fi
+	rm -f web2c/fixwrites web2c/splitup web2c/web2c
+	cp -f $(linux_build_dir)/web2c/fixwrites web2c
+	cp -f $(linux_build_dir)/web2c/splitup web2c
+	cp -f $(linux_build_dir)/web2c/web2c web2c
+	touch web2c/fixwrites web2c/splitup web2c/web2c
+	$(MAKE) tangleboot && rm -f tangleboot && \
+	cp -f $(linux_build_dir)/tangleboot .  && touch tangleboot
+	$(MAKE) ctangleboot && rm -f ctangleboot && \
+	cp -f $(linux_build_dir)/ctangleboot .  && touch ctangleboot
+	$(MAKE) ctangle && rm -f ctangle && \
+	cp -f $(linux_build_dir)/ctangle .  && touch ctangle
+	$(MAKE) tie && rm -f tie && \
+	cp -f $(linux_build_dir)/tie .  && touch tie
+	$(MAKE) luatangle && rm -f luatangle && \
+	cp -f $(linux_build_dir)/luatangle .  && touch luatangle
+
+# vim: set noexpandtab
+# end of luatex.mk
diff --git a/Build/source/texk/web2c/luatexdir/luatex.web b/Build/source/texk/web2c/luatexdir/luatex.web
new file mode 100644
index 00000000000..b1c977706ff
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatex.web
@@ -0,0 +1,35760 @@
+% Copyright (c) 2007 Hartmut Henkel, Taco Hoekwater
+
+% This file is part of luaTeX.
+
+% luaTeX 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.
+
+% luaTeX 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 luaTeX; if not, write to the Free Software Foundation, Inc.,
+% 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
+
+% pdfTeX is copyright (C) 1996-2006 Han The Thanh, <thanh@@pdftex.org>.
+% e-TeX is copyright (C) 1994,98 by Peter Breitenlohner.
+
+% This program is directly derived from Donald E. Knuth's TeX;
+% the change history which follows and the reward offered for finders of
+% bugs refer specifically to TeX; they should not be taken as referring
+% to e-TeX, although the change history is relevant in that it
+% demonstrates the evolutionary path followed.  This program is not TeX;
+% that name is reserved strictly for the program which is the creation
+% and sole responsibility of Professor Knuth.
+
+% Version 0 was released in September 1982 after it passed a variety of tests.
+% Version 1 was released in November 1983 after thorough testing.
+% Version 1.1 fixed ``disappearing font identifiers'' et alia (July 1984).
+% Version 1.2 allowed `0' in response to an error, et alia (October 1984).
+% Version 1.3 made memory allocation more flexible and local (November 1984).
+% Version 1.4 fixed accents right after line breaks, et alia (April 1985).
+% Version 1.5 fixed \the\toks after other expansion in \edefs (August 1985).
+% Version 2.0 (almost identical to 1.5) corresponds to "Volume B" (April 1986).
+% Version 2.1 corrected anomalies in discretionary breaks (January 1987).
+% Version 2.2 corrected "(Please type...)" with null \endlinechar (April 1987).
+% Version 2.3 avoided incomplete page in premature termination (August 1987).
+% Version 2.4 fixed \noaligned rules in indented displays (August 1987).
+% Version 2.5 saved cur_order when expanding tokens (September 1987).
+% Version 2.6 added 10sp slop when shipping leaders (November 1987).
+% Version 2.7 improved rounding of negative-width characters (November 1987).
+% Version 2.8 fixed weird bug if no \patterns are used (December 1987).
+% Version 2.9 made \csname\endcsname's "relax" local (December 1987).
+% Version 2.91 fixed \outer\def\a0{}\a\a bug (April 1988).
+% Version 2.92 fixed \patterns, also file names with complex macros (May 1988).
+% Version 2.93 fixed negative halving in allocator when mem_min<0 (June 1988).
+% Version 2.94 kept open_log_file from calling fatal_error (November 1988).
+% Version 2.95 solved that problem a better way (December 1988).
+% Version 2.96 corrected bug in "Infinite shrinkage" recovery (January 1989).
+% Version 2.97 corrected blunder in creating 2.95 (February 1989).
+% Version 2.98 omitted save_for_after at outer level (March 1989).
+% Version 2.99 caught $$\begingroup\halign..$$ (June 1989).
+% Version 2.991 caught .5\ifdim.6... (June 1989).
+% Version 2.992 introduced major changes for 8-bit extensions (September 1989).
+% Version 2.993 fixed a save_stack synchronization bug et alia (December 1989).
+% Version 3.0 fixed unusual displays; was more \output robust (March 1990).
+% Version 3.1 fixed nullfont, disabled \write{\the\prevgraf} (September 1990).
+% Version 3.14 fixed unprintable font names and corrected typos (March 1991).
+% Version 3.141 more of same; reconstituted ligatures better (March 1992).
+% Version 3.1415 preserved nonexplicit kerns, tidied up (February 1993).
+% Version 3.14159 allowed fontmemsize to change; bulletproofing (March 1995).
+% Version 3.141592 fixed \xleaders, glueset, weird alignments (December 2002).
+
+
+% Although considerable effort has been expended to make the luaTeX program
+% correct and reliable, no warranty is implied; the authors disclaim any
+% obligation or liability for damages, including but not limited to
+% special, indirect, or consequential damages arising out of or in
+% connection with the use or performance of this software. This work has
+% been a ``labor of love'' and the authors hope that users enjoy it.
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\hangg#1 {\hang\hbox{#1 }}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\def\PASCAL{Pascal}
+\def\pdfTeX{pdf\TeX}
+\def\pdfeTeX{pdf\eTeX}
+\def\PDF{PDF}
+\def\Aleph{Aleph}
+\def\eTeX{e\TeX}
+\def\LuaTeX{Lua\TeX}
+\def\THANH{H\`an Th\^e\llap{\raise 0.5ex\hbox{\'{}}} Th\`anh}
+\def\ph{\hbox{Pascal-H}}
+\def\pct!{{\char`\%}} % percent sign in ordinary text
+\def\grp{\.{\char'173...\char'175}}
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\outer\def\N#1. \[#2]#3.{\MN#1.\vfil\eject % begin starred section
+  \def\rhead{PART #2:\uppercase{#3}} % define running headline
+  \message{*\modno} % progress report
+  \edef\next{\write\cont{\Z{\?#2]#3}{\modno}{\the\pageno}}}\next
+  \ifon\startsection{\bf\ignorespaces#3.\quad}\ignorespaces}
+\let\?=\relax % we want to be able to \write a \?
+
+\def\title{LuaTeX}
+\let\maybe=\iffalse % print only changed modules
+\def\topofcontents{\hsize 5.5in
+  \vglue 0pt plus 1fil minus 1.5in
+  \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+  }
+\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
+\pageno=3
+\def\glob{13} % this should be the section number of "<Global...>"
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+
+@* \[1] Introduction.
+
+This is LuaTeX, a continuation of $\pdfTeX$ and $\Aleph$.  LuaTeX is a
+document compiler intended to simplify high-quality typesetting for
+many of the world's languages.  It is an extension of D. E. Knuth's
+\TeX, which was designed essentially for the typesetting of languages
+using the Latin alphabet.
+
+The $\Aleph$ subsystem loosens many of the restrictions imposed by~\TeX:
+register numbers are no longer limited to 8~bits;  fonts may have more
+than 256~characters;  more than 256~fonts may be used;  etc.
+
+The \PASCAL\ program that follows is the definition of \TeX82, a standard
+@:PASCAL}{\PASCAL@>
+@!@:TeX82}{\TeX82@>
+version of \TeX\ that is designed to be highly portable so that
+identical output will be obtainable on a great variety of computers.
+
+The main purpose of the following program is to explain the algorithms of \TeX\
+as clearly as possible. As a result, the program will not necessarily be very
+efficient when a particular \PASCAL\ compiler has translated it into a
+particular machine language. However, the program has been written so that it
+can be tuned to run efficiently in a wide variety of operating environments
+by making comparatively few changes. Such flexibility is possible because
+the documentation that follows is written in the \.{WEB} language, which is
+at a higher level than \PASCAL; the preprocessing step that converts \.{WEB}
+to \PASCAL\ is able to introduce most of the necessary refinements.
+Semi-automatic translation to other languages is also feasible, because the
+program below does not make extensive use of features that are peculiar to
+\PASCAL.
+
+A large piece of software like \TeX\ has inherent complexity that cannot
+be reduced below a certain level of difficulty, although each individual
+part is fairly simple by itself. The \.{WEB} language is intended to make
+the algorithms as readable as possible, by reflecting the way the
+individual program pieces fit together and by providing the
+cross-references that connect different parts. Detailed comments about
+what is going on, and about why things were done in certain ways, have
+been liberally sprinkled throughout the program.  These comments explain
+features of the implementation, but they rarely attempt to explain the
+\TeX\ language itself, since the reader is supposed to be familiar with
+{\sl The \TeX book}.
+@.WEB@>
+@:TeXbook}{\sl The \TeX book@>
+
+@ The present implementation has a long ancestry, beginning in the summer
+of~1977, when Michael~F. Plass and Frank~M. Liang designed and coded
+a prototype
+@^Plass, Michael Frederick@>
+@^Liang, Franklin Mark@>
+@^Knuth, Donald Ervin@>
+based on some specifications that the author had made in May of that year.
+This original proto\TeX\ included macro definitions and elementary
+manipulations on boxes and glue, but it did not have line-breaking,
+page-breaking, mathematical formulas, alignment routines, error recovery,
+or the present semantic nest; furthermore,
+it used character lists instead of token lists, so that a control sequence
+like \.{\\halign} was represented by a list of seven characters. A
+complete version of \TeX\ was designed and coded by the author in late
+1977 and early 1978; that program, like its prototype, was written in the
+{\mc SAIL} language, for which an excellent debugging system was
+available. Preliminary plans to convert the {\mc SAIL} code into a form
+somewhat like the present ``web'' were developed by Luis Trabb~Pardo and
+the author at the beginning of 1979, and a complete implementation was
+created by Ignacio~A. Zabala in 1979 and 1980. The \TeX82 program, which
+@^Zabala Salelles, Ignacio Andr\'es@>
+was written by the author during the latter part of 1981 and the early
+part of 1982, also incorporates ideas from the 1979 implementation of
+@^Guibas, Leonidas Ioannis@>
+@^Sedgewick, Robert@>
+@^Wyatt, Douglas Kirk@>
+\TeX\ in {\mc MESA} that was written by Leonidas Guibas, Robert Sedgewick,
+and Douglas Wyatt at the Xerox Palo Alto Research Center.  Several hundred
+refinements were introduced into \TeX82 based on the experiences gained with
+the original implementations, so that essentially every part of the system
+has been substantially improved. After the appearance of ``Version 0'' in
+September 1982, this program benefited greatly from the comments of
+many other people, notably David~R. Fuchs and Howard~W. Trickey.
+A final revision in September 1989 extended the input character set to
+eight-bit codes and introduced the ability to hyphenate words from
+different languages, based on some ideas of Michael~J. Ferguson.
+@^Fuchs, David Raymond@>
+@^Trickey, Howard Wellington@>
+@^Ferguson, Michael John@>
+
+No doubt there still is plenty of room for improvement, but the author
+is firmly committed to keeping \TeX82 ``frozen'' from now on; stability
+and reliability are to be its main virtues.
+
+On the other hand, the \.{WEB} description can be extended without changing
+the core of \TeX82 itself, and the program has been designed so that such
+extensions are not extremely difficult to make.
+The |banner| string defined here should be changed whenever \TeX\
+undergoes any modifications, so that it will be clear which version of
+\TeX\ might be the guilty party when a problem arises.
+@^extensions to \TeX@>
+@^system dependencies@>
+
+This program contains code for various features extending \TeX,
+therefore this program is called `\eTeX' and not
+`\TeX'; the official name `\TeX' by itself is reserved
+for software systems that are fully compatible with each other.
+A special test suite called the ``\.{TRIP} test'' is available for
+helping to determine whether a particular implementation deserves to be
+known as `\TeX' [cf.~Stanford Computer Science report CS1027,
+November 1984].
+
+A similar test suite called the ``\.{e-TRIP} test'' is available for
+helping to determine whether a particular implementation deserves to be
+known as `\eTeX'.
+
+@d eTeX_version_string=="2.2" {current \eTeX\ version}
+@d Omega_version_string=="1.15" { \.{\\OmegaVersion} }
+@d Aleph_version_string=="0.0" { \.{\\AlephVersion} }
+@d eTeX_version=2 { \.{\\eTeXversion} }
+@d Omega_version=1 { \.{\\Omegaversion} }
+@d Aleph_version=0 { \.{\\Alephversion} }
+@d eTeX_minor_version=1 { \.{\\eTeXminorversion} }
+@d Omega_minor_version=15 { \.{\\Omegaminorversion} }
+@d Aleph_minor_version=0 { \.{\\Alephminorversion} }
+@d eTeX_revision==".2" { \.{\\eTeXrevision} }
+@d Omega_revision==".15" { \.{\\Omegarevision} }
+@d Aleph_revision==".0" { \.{\\Alephrevision} }
+@#
+@d pdftex_version==200 { \.{\\pdftexversion} }
+@d pdftex_revision=="0" { \.{\\pdftexrevision} }
+@d pdftex_version_string=='-2.00.0' {current \pdfTeX\ version}
+@#
+@d luatex_version==25 { \.{\\luatexversion} }
+@d luatex_revision=="1" { \.{\\luatexrevision} }
+@d luatex_version_string=='snapshot-0.25.1' {current \LuaTeX\ version}
+@d luatex_date_info==-extra_version_info { the compile date is negated }
+@#
+@d luaTeX_banner=='This is LuaTeX, Version ',luatex_version_string,extra_version_info
+   {printed when \LuaTeX\ starts}
+@#
+@d banner==luaTeX_banner
+@#
+@d TEX==ETEX {change program name into |ETEX|}
+
+@ Different \PASCAL s have slightly different conventions, and the present
+@!@:PASCAL H}{\ph@>
+program expresses \TeX\ in terms of the \PASCAL\ that was
+available to the author in 1982. Constructions that apply to
+this particular compiler, which we shall call \ph, should help the
+reader see how to make an appropriate interface for other systems
+if necessary. (\ph\ is Charles Hedrick's modification of a compiler
+@^Hedrick, Charles Locke@>
+for the DECsystem-10 that was originally developed at the University of
+Hamburg; cf.\ {\sl SOFTWARE---Practice \AM\ Experience \bf6} (1976),
+29--42. The \TeX\ program below is intended to be adaptable, without
+extensive changes, to most other versions of \PASCAL, so it does not fully
+use the admirable features of \ph. Indeed, a conscious effort has been
+made here to avoid using several idiosyncratic features of standard
+\PASCAL\ itself, so that most of the code can be translated mechanically
+into other high-level languages. For example, the `\&{with}' and `\\{new}'
+features are not used, nor are pointer types, set types, or enumerated
+scalar types; there are no `\&{var}' parameters, except in the case of files
+--- \eTeX, however, does use `\&{var}' parameters for the |reverse| function;
+there are no tag fields on variant records; there are no assignments
+|real:=integer|; no procedures are declared local to other procedures.)
+
+The portions of this program that involve system-dependent code, where
+changes might be necessary because of differences between \PASCAL\ compilers
+and/or differences between
+operating systems, can be identified by looking at the sections whose
+numbers are listed under `system dependencies' in the index. Furthermore,
+the index entries for `dirty \PASCAL' list all places where the restrictions
+of \PASCAL\ have not been followed perfectly, for one reason or another.
+@!@^system dependencies@>
+@!@^dirty \PASCAL@>
+
+Incidentally, \PASCAL's standard |round| function can be problematical,
+because it disagrees with the IEEE floating-point standard.
+Many implementors have
+therefore chosen to substitute their own home-grown rounding procedure.
+
+@ The program begins with a normal \PASCAL\ program heading, whose
+components will be filled in later, using the conventions of \.{WEB}.
+@.WEB@>
+For example, the portion of the program called `\X\glob:Global
+variables\X' below will be replaced by a sequence of variable declarations
+that starts in $\section\glob$ of this documentation. In this way, we are able
+to define each individual global variable when we are prepared to
+understand what it means; we do not have to define all of the globals at
+once.  Cross references in $\section\glob$, where it says ``See also
+sections \gglob, \dots,'' also make it possible to look at the set of
+all global variables, if desired.  Similar remarks apply to the other
+portions of the program heading.
+
+Actually the heading shown here is not quite normal: The |program| line
+does not mention any |output| file, because \ph\ would ask the \TeX\ user
+to specify a file name if |output| were specified here.
+@^system dependencies@>
+
+@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:}
+@f mtype==type {`\&{mtype}' will be equivalent to `\&{type}'}
+@f type==true {but `|type|' will not be treated as a reserved word}
+
+@p @t\4@>@<Compiler directives@>@/
+program TEX; {all file names are defined dynamically}
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+mtype @<Types in the outer block@>@/
+var @<Global variables@>@/
+@#
+procedure initialize; {this procedure gets things started properly}
+  var @<Local variables for initialization@>@/
+  begin @<Initialize whatever \TeX\ might access@>@;
+  end;@#
+@t\4@>@<Basic printing procedures@>@/
+@t\4@>@<Error handling procedures@>@/
+
+@ The overall \TeX\ program begins with the heading just shown, after which
+comes a bunch of procedure declarations and function declarations.
+Finally we will get to the main program, which begins with the
+comment `|start_here|'. If you want to skip down to the
+main program now, you can look up `|start_here|' in the index.
+But the author suggests that the best way to understand this program
+is to follow pretty much the order of \TeX's components as they appear in the
+\.{WEB} description you are now reading, since the present ordering is
+intended to combine the advantages of the ``bottom up'' and ``top down''
+approaches to the problem of understanding a somewhat complicated system.
+
+@ Three labels must be declared in the main program, so we give them
+symbolic names.
+
+@d start_of_TEX=1 {go here when \TeX's variables are initialized}
+@d end_of_TEX=9998 {go here to close files and terminate gracefully}
+@d final_end=9999 {this label marks the ending of the program}
+
+@<Labels in the out...@>=
+start_of_TEX@t\hskip-2pt@>, end_of_TEX@t\hskip-2pt@>,@,final_end;
+  {key control points}
+
+@ Some of the code below is intended to be used only when diagnosing the
+strange behavior that sometimes occurs when \TeX\ is being installed or
+when system wizards are fooling around with \TeX\ without quite knowing
+what they are doing. Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English.
+
+Similarly, there is some conditional code delimited by
+`$|stat|\ldots|tats|$' that is intended for use when statistics are to be
+kept about \TeX's memory usage.  The |stat| $\ldots$ |tats| code also
+implements diagnostic information for \.{\\tracingparagraphs} and
+\.{\\tracingpages}.
+@^debugging@>
+
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
+  usage statistics}
+@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
+  usage statistics}
+@f stat==begin
+@f tats==end
+
+@ This program has two important variations: (1) There is a long and slow
+version called \.{INITEX}, which does the extra calculations needed to
+@.INITEX@>
+initialize \TeX's internal tables; and (2)~there is a shorter and faster
+production version, which cuts the initialization to a bare minimum.
+Parts of the program that are needed in (1) but not in (2) are delimited by
+the codewords `$|init|\ldots|tini|$'.
+
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@f init==begin
+@f tini==end
+
+@<Initialize whatever...@>=
+@<Set initial values of key variables@>@/
+@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini
+
+@ If the first character of a \PASCAL\ comment is a dollar sign,
+\ph\ treats the comment as a list of ``compiler directives'' that will
+affect the translation of this program into machine language.  The
+directives shown below specify full checking and inclusion of the \PASCAL\
+debugger when \TeX\ is being debugged, but they cause range checking and other
+redundant code to be eliminated when the production system is being generated.
+Arithmetic overflow will be detected in all cases.
+@^system dependencies@>
+@^Overflow in arithmetic@>
+
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+
+@ This \TeX\ implementation conforms to the rules of the {\sl Pascal User
+@:PASCAL}{\PASCAL@>
+@^system dependencies@>
+Manual} published by Jensen and Wirth in 1975, except where system-dependent
+@^Wirth, Niklaus@>
+@^Jensen, Kathleen@>
+code is necessary to make a useful system program, and except in another
+respect where such conformity would unnecessarily obscure the meaning
+and clutter up the code: We assume that |case| statements may include a
+default case that applies if no matching label is found. Thus, we shall use
+constructions like
+$$\vbox{\halign{\ignorespaces#\hfil\cr
+|case x of|\cr
+1: $\langle\,$code for $x=1\,\rangle$;\cr
+3: $\langle\,$code for $x=3\,\rangle$;\cr
+|othercases| $\langle\,$code for |x<>1| and |x<>3|$\,\rangle$\cr
+|endcases|\cr}}$$
+since most \PASCAL\ compilers have plugged this hole in the language by
+incorporating some sort of default mechanism. For example, the \ph\
+compiler allows `|others|:' as a default label, and other \PASCAL s allow
+syntaxes like `\&{else}' or `\&{otherwise}' or `\\{otherwise}:', etc. The
+definitions of |othercases| and |endcases| should be changed to agree with
+local conventions.  Note that no semicolon appears before |endcases| in
+this program, so the definition of |endcases| should include a semicolon
+if the compiler wants one. (Of course, if no default mechanism is
+available, the |case| statements of \TeX\ will have to be laboriously
+extended by listing all remaining cases. People who are stuck with such
+\PASCAL s have, in fact, done this, successfully but not happily!)
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The following parameters can be changed at compile time to extend or
+reduce \TeX's capacity. They may have different values in \.{INITEX} and
+in production versions of \TeX.
+@.INITEX@>
+@^system dependencies@>
+
+@<Constants...@>=
+@!buf_size=500; {maximum number of characters simultaneously present in
+  current lines of open files and in control sequences between
+  \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_line=42; {width of first lines of contexts in terminal
+  error messages; should be between 30 and |error_line-15|}
+@!max_print_line=79; {width of longest text lines output; should be at least 60}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+  can be going on simultaneously}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+  available for the user's control sequences and font names,
+  after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+  error messages and help texts, and the names of all fonts and
+  control sequences; must exceed |string_vacancies| by the total
+  length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+  at most |max_halfword|}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!expand_depth=10000; {limits recursive calls of the |expand| procedure}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TeXformats:TEX.POOL                     ';
+  {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@!active_mem_size=50000; {number of words of |active_info| for active ocps}
+@!ocp_maxint=@"10000000;
+
+
+@ Like the preceding parameters, the following quantities can be changed
+at compile time to extend or reduce \TeX's capacity. But if they are changed,
+it is necessary to rerun the initialization program \.{INITEX}
+@.INITEX@>
+to generate new tables for the production \TeX\ program.
+One can't simply make helter-skelter changes to the following constants,
+since certain rather complex initialization
+numbers are computed from them. They are defined here using
+\.{WEB} macros, instead of being put into \PASCAL's |const| list, in order to
+emphasize this distinction.
+
+@d font_base=0 {smallest internal font number; must not be less
+  than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+  about |(fix_mem_max-fix_mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d ocp_base=0 {smallest internal ocp number; must not be less
+  than |min_quarterword|}
+@d ocp_biggest=32767 {the real biggest ocp}
+@d number_ocps=ocp_biggest-ocp_base+1
+@d ocp_list_base=0 {smallest internal ocp list number; must not be less
+  than |min_quarterword|}
+@d ocp_list_biggest=32727 {the real biggest ocp list}
+@d number_ocp_lists=ocp_list_biggest-ocp_list_base+1
+@d max_active_ocp_lists=32768
+@d biggest_reg=65535 {the largest allowed register number; must be |<=max_quarterword|}
+@d number_regs=65536 {|biggest_reg+1|}
+@d number_attrs=65536 {total numbeer of attributes}
+@d biggest_mark=65535 {the largest allowed marks class; must be |<=max_quarterword|}
+@d number_marks=65536 {|biggest_mark+1|}
+{using |2^20+2^16| characters instead of |2^21| saves 286MB on the virtual memory size
+ of the running executable}
+@d biggest_char=1114111 {2097151} {the largest allowed character number; must be |<=max_halfword|}
+@d too_big_char=1114112 {2097152} {|biggest_char+1|}
+@d special_char=1114113 {2097153} {|biggest_char+2|}
+@d number_chars=1114112 {2097152} {|biggest_char+1|}
+@d number_active_chars=65536+65536 {to reduce the memory req. only two planes }
+@d string_offset=2097152
+@d font_biggest=5535 {the real biggest font}
+@d number_fonts=font_biggest-font_base+1
+@d number_math_fonts=768
+@d math_font_biggest=767
+@d biggest_lang=32767
+@d too_big_lang=32768
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=256 {size code for the medium size in a family}
+@d script_script_size=512 {size code for the smallest size in a family}
+
+
+@ In case somebody has inadvertently made bad settings of the ``constants,''
+\TeX\ checks them using a global variable called |bad|.
+
+This is the first of many sections of \TeX\ where global variables are
+defined.
+
+@<Glob...@>=
+@!bad:integer; {is some ``constant'' wrong?}
+@!luainit:boolean; {are we using lua for initializations }
+@!tracefilenames:boolean; { print file open-close  info? }
+
+@ Later on we will say `\ignorespaces|if X>=max_halfword then bad:=14|',
+or something similar. (We can't do that until |max_halfword| has been defined.)
+
+@<Check the ``constant'' values for consistency@>=
+bad:=0;
+if not luainit then  tracefilenames:=true;
+if (half_error_line<30)or(half_error_line>error_line-15) then bad:=1;
+if max_print_line<60 then bad:=2;
+if dvi_buf_size mod 8<>0 then bad:=3;
+if hash_prime>hash_size then bad:=5;
+if max_in_open>=128 then bad:=6;
+{ |if null_list<256 then bad:=7;| } {we will want |null_list>255|}
+
+@ Labels are given symbolic names by the following definitions, so that
+occasional |goto| statements will be meaningful. We insert the label
+`|exit|' just before the `\ignorespaces|end|\unskip' of a procedure in
+which we have used the `|return|' statement defined below; the label
+`|restart|' is occasionally used at the very beginning of a procedure; and
+the label `|reswitch|' is occasionally used just prior to a |case|
+statement in which some cases change the conditions and we wish to branch
+to the newly applicable case.  Loops that are set up with the |loop|
+construction defined below are commonly exited by going to `|done|' or to
+`|found|' or to `|not_found|', and they are sometimes repeated by going to
+`|continue|'.  If two or more parts of a subroutine start differently but
+end up the same, the shared code may be gathered together at
+`|common_ending|'.
+
+Incidentally, this program never declares a label that isn't actually used,
+because some fussy \PASCAL\ compilers will complain about redundant labels.
+
+@d exit=10 {go here to leave a procedure}
+@d restart=20 {go here to start a procedure again}
+@d reswitch=21 {go here to start a case statement again}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d done1=31 {like |done|, when there is more than one loop}
+@d done2=32 {for exiting the second loop in a long block}
+@d done3=33 {for exiting the third loop in a very long block}
+@d done4=34 {for exiting the fourth loop in an extremely long block}
+@d done5=35 {for exiting the fifth loop in an immense block}
+@d done6=36 {for exiting the sixth loop in a block}
+@d found=40 {go here when you've found it}
+@d found1=41 {like |found|, when there's more than one per routine}
+@d found2=42 {like |found|, when there's more than two per routine}
+@d not_found=45 {go here when you've found nothing}
+@d not_found1=46 {like |not_found|, when there's more than one}
+@d not_found2=47 {like |not_found|, when there's more than two}
+@d not_found3=48 {like |not_found|, when there's more than three}
+@d not_found4=49 {like |not_found|, when there's more than four}
+@d common_ending=50 {go here when you want to merge with another branch}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@f loop == xclause
+  {\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
+@d do_nothing == pdfassert(1) {empty statement}
+@d return == goto exit {terminate a procedure call}
+@f return == nil
+@d empty=0 {symbolic name for a null constant}
+
+@* \[2] The character set.
+In order to make \TeX\ readily portable to a wide variety of
+computers, all of its input text is converted to an internal
+twenty-one-bit code that covers all of unicode, including ASCII, the
+``American Standard Code for Information Interchange.''  This
+conversion is done immediately when each character is read
+in. Conversely, characters are converted from ASCII to the user's
+external representation just before they are output to a text file.
+
+Such an internal code is relevant to users of \TeX\ primarily because it
+governs the positions of characters in the fonts. For example, the
+character `\.A' has ASCII code $65=@'101$, and when \TeX\ typesets
+this letter it specifies character number 65 in the current font.
+If that font actually has `\.A' in a different position, \TeX\ doesn't
+know what the real position is; the program that does the actual printing from
+\TeX's device-independent files is responsible for converting from ASCII to
+a particular font encoding.
+@^ASCII code@>
+
+\TeX's internal code also defines the value of constants
+that begin with a reverse apostrophe; and it provides an index to the
+\.{\\catcode}, \.{\\mathcode}, \.{\\uccode}, \.{\\lccode}, and \.{\\delcode}
+tables.
+
+@ Characters of text that have been converted to \TeX's internal form
+are said to be of type |ASCII_code|, which is a subrange of the integers.
+
+@<Types...@>=
+@!ASCII_code=0..biggest_char; {eight-bit numbers}
+@!BMP_code=0..65535; {sixteen-bit numbers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lowercase
+letters. Nowadays, of course, we need to deal with both capital and small
+letters in a convenient way, especially in a program for typesetting;
+so the present specification of \TeX\ has been written under the assumption
+that the \PASCAL\ compiler and run-time system permit the use of text files
+with more than 64 distinguishable characters. More precisely, we assume that
+the character set contains at least the letters and symbols associated
+with ASCII codes @'40 through @'176; all of these characters are now
+available on most computer terminals.
+
+Since we are dealing with more characters than were present in the first
+\PASCAL\ compilers, we have to decide what to call the associated data
+type. Some \PASCAL s use the original name |char| for the
+characters in text files, even though there now are more than 64 such
+characters, while other \PASCAL s consider |char| to be a 64-element
+subrange of a larger data type that has some other name.
+
+In order to accommodate this difference, we shall use the name |text_char|
+to stand for the data type of the characters that are converted to and
+from |ASCII_code| when they are input and output. We shall also assume
+that |text_char| consists of the elements |chr(first_text_char)| through
+|chr(last_text_char)|, inclusive. The following definitions should be
+adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+
+@<Local variables for init...@>=
+@!i:integer;
+
+@ The \TeX\ processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Glob...@>=
+@!xchr: array [ASCII_code] of text_char;
+  {specifies conversion of output characters}
+
+@ Since we are assuming that our \PASCAL\ system is able to read and
+write the visible characters of standard ASCII (although not
+necessarily using the ASCII codes to represent them), the following
+assignment statements initialize the standard part of the |xchr| array
+properly, without needing any system-dependent changes. On the other
+hand, it is possible to implement \TeX\ with less complete character
+sets, and in such cases it will be necessary to change something here.
+@^system dependencies@>
+
+@<Set init...@>=
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';@/
+
+@ Some of the ASCII codes without visible characters have been given symbolic
+names in this program because they are used with a special meaning.
+
+@d null_code=@'0 {ASCII code that might disappear}
+@d carriage_return=@'15 {ASCII code used at end of line}
+@d invalid_code=@'177 {ASCII code that many systems prohibit in text files}
+
+@ The ASCII code is ``standard'' only to a certain extent, since many
+computer installations have found it advantageous to have ready access
+to more than 94 printing characters. Appendix~C of {\sl The \TeX book\/}
+gives a complete specification of the intended correspondence between
+characters and \TeX's internal representation.
+@:TeXbook}{\sl The \TeX book@>
+
+If \TeX\ is being used
+on a garden-variety \PASCAL\ for which only standard ASCII
+codes will appear in the input and output files, it doesn't really matter
+what codes are specified in |xchr[0..@'37]|, but the safest policy is to
+blank everything out by using the code shown below.
+
+However, other settings of |xchr| will make \TeX\ more friendly on
+computers that have an extended character set, so that users can type things
+like `\.^^Z' instead of `\.{\\ne}'. People with extended character sets can
+assign codes arbitrarily, giving an |xchr| equivalent to whatever
+characters the users of \TeX\ are allowed to have in their input files.
+It is best to make the codes correspond to the intended interpretations as
+shown in Appendix~C whenever possible; but this is not necessary. For
+example, in countries with an alphabet of more than 26 letters, it is
+usually best to map the additional letters into codes less than~@'40.
+To get the most ``permissive'' character set, change |' '| on the
+right of these assignment statements to |chr(i)|.
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=0 to biggest_char do xchr[i]:=i;
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
+where |i<j<@'177|, the value of |xord[xchr[i]]| will turn out to be
+|j| or more; hence, standard ASCII code numbers will be used instead of
+codes below @'40 in case there is a coincidence.
+
+@<Set init...@>=
+
+@* \[3] Input and output.
+The bane of portability is the fact that different operating systems treat
+input and output quite differently, perhaps because computer scientists
+have not given sufficient attention to this problem. People have felt somehow
+that input and output are not part of ``real'' programming. Well, it is true
+that some kinds of programming are more fun than others. With existing
+input/output conventions being so diverse and so messy, the only sources of
+joy in such parts of the code are the rare occasions when one can find a
+way to make the program a little less bad than it might have been. We have
+two choices, either to attack I/O now and get it over with, or to postpone
+I/O until near the end. Neither prospect is very attractive, so let's
+get it over with.
+
+The basic operations we need to do are (1)~inputting and outputting of
+text, to or from a file or the user's terminal; (2)~inputting and
+outputting of eight-bit bytes, to or from a file; (3)~instructing the
+operating system to initiate (``open'') or to terminate (``close'') input or
+output from a specified file; (4)~testing whether the end of an input
+file has been reached.
+
+\TeX\ needs to deal with two kinds of files.
+We shall use the term |alpha_file| for a file that contains textual data,
+and the term |byte_file| for a file that contains eight-bit binary information.
+These two types turn out to be the same on many computers, but
+sometimes there is a significant distinction, so we shall be careful to
+distinguish between them. Standard protocols for transferring
+such files from computer to computer, via high-speed networks, are
+now becoming available to more and more communities of users.
+
+The program actually makes use also of a third kind of file, called a
+|word_file|, when dumping and reloading base information for its own
+initialization.  We shall define a word file later; but it will be possible
+for us to specify simple operations on word files before they are defined.
+
+@<Types...@>=
+@!eight_bits=0..65535; {unsigned one-byte quantity}
+@!real_eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of real_eight_bits; {files that contain binary data}
+
+@ Most of what we need to do with respect to input and output can be handled
+by the I/O facilities that are standard in \PASCAL, i.e., the routines
+called |get|, |put|, |eof|, and so on. But
+standard \PASCAL\ does not allow file variables to be associated with file
+names that are determined at run time, so it cannot be used to implement
+\TeX; some sort of extension to \PASCAL's ordinary |reset| and |rewrite|
+is crucial for our purposes. We shall assume that |nameoffile| is a variable
+of an appropriate type such that the \PASCAL\ run-time system being used to
+implement \TeX\ can open a file whose external name is specified by
+|nameoffile|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!nameoffile:packed array[1..file_name_size] of char;@;@/
+  {on some systems this may be a \&{record} variable}
+@!namelength:0..file_name_size;@/{this many characters are actually
+  relevant in |nameoffile| (the rest are blank)}
+@!name_file_pointer:alpha_file;
+
+@ The \ph\ compiler with which the present version of \TeX\ was prepared has
+extended the rules of \PASCAL\ in a very convenient way. To open file~|f|,
+we can write
+$$\vbox{\halign{#\hfil\qquad&#\hfil\cr
+|reset(f,@t\\{name}@>,'/O')|&for input;\cr
+|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$
+The `\\{name}' parameter, which is of type `{\bf packed array
+$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of
+the external file that is being opened for input or output.
+Blank spaces that might appear in \\{name} are ignored.
+
+The `\.{/O}' parameter tells the operating system not to issue its own
+error messages if something goes wrong. If a file of the specified name
+cannot be found, or if such a file cannot be opened for some other reason
+(e.g., someone may already be trying to write the same file), we will have
+|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|.  This allows
+\TeX\ to undertake appropriate corrective action.
+@:PASCAL H}{\ph@>
+@^system dependencies@>
+
+\TeX's file-opening procedures return |false| if no file identified by
+|nameoffile| could be opened.
+
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+  {open a text file for input}
+begin reset(f,nameoffile,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+  {open a text file for output}
+begin rewrite(f,nameoffile,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+  {open a binary file for input}
+begin reset(f,nameoffile,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+  {open a binary file for output}
+begin rewrite(f,nameoffile,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+  {open a word file for input}
+begin reset(f,nameoffile,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+  {open a word file for output}
+begin rewrite(f,nameoffile,'/O'); w_open_out:=rewrite_OK(f);
+end;
+
+@ When input files are opened via a callback, they will also be read using
+callbacks. for that purpose, the |open_read_file_callback| returns an
+integer to uniquely identify a callback table. This id replaces the file
+point |f| in this case, because the input does not have to be a file
+in the traditional sense.
+
+Signalling this fact is achieved by having two arrays of integers.
+
+@<Glob...@>=
+@!input_file_callback_id : ^integer;
+@!read_file_callback_id : array[0..16] of integer;
+
+@ 
+@p function lua_a_open_in(var f:alpha_file; n:quarterword):boolean;
+var k:integer; { a temporary value }
+  fnam:str_number; { string returned by find callback }
+  callback_id:integer;
+  file_ok:boolean; { the status so far }
+begin 
+  file_ok:=true;
+  if n=0 then begin
+    texinputtype := 1; {Tell |open_input| we are \.{\\input}.}
+    input_file_callback_id[index] := 0;
+    end
+  else begin
+    texinputtype:=0; 
+    read_file_callback_id[n] := 0;
+    end;
+  callback_id:=callback_defined(find_read_file_callback);
+  if callback_id>0 then begin
+    fnam:=0;
+    file_ok:=run_callback(callback_id,'dS->s',n,stringcast(nameoffile+1),addressof(fnam));
+    if (file_ok)and(fnam<>0)and(length(fnam)>0) then begin
+      @<Fixup |nameoffile| after callback@>;
+      end 
+    else 
+      file_ok:=false; {file not found}
+    end;
+  if file_ok then begin
+    callback_id:=callback_defined(open_read_file_callback);
+    if callback_id>0 then begin
+      k := run_and_save_callback(callback_id,'S->',stringcast(nameoffile+1));
+      if k>0 then begin
+        lua_a_open_in := true;
+        if n=0 then
+          input_file_callback_id[index] := k
+        else 
+          read_file_callback_id[n] := k;
+        end
+      else 
+        file_ok:=false; {read failed}
+      end
+    else begin {no read callback}
+      if openinnameok(stringcast(nameoffile+1)) then begin
+        lua_a_open_in := a_open_in(f,kpsetexformat);
+        name_file_pointer := f;
+        end
+      else 
+        file_ok:=false; {open failed}
+      end;
+    end;
+  if not file_ok then begin
+    lua_a_open_in := false;
+    name_file_pointer := 0;
+    end;
+end;
+@#
+function lua_a_open_out(var f:alpha_file; n:quarterword):boolean;
+var test:boolean;
+  k:integer;
+  fnam:str_number;
+  callback_id:integer;
+begin
+  name_file_pointer := 0;
+  callback_id:=callback_defined(find_write_file_callback);
+  if callback_id>0 then begin
+    fnam:=0;
+    test:=run_callback(callback_id,'dS->s',n,stringcast(nameoffile+1),addressof(fnam));
+    if (test)and(fnam<>0)and(length(fnam)>0) then begin
+      @<Fixup |nameoffile| after callback@>;
+      lua_a_open_out := do_a_open_out(f);
+	  name_file_pointer := f;
+      end
+    else 
+      lua_a_open_out := false;
+    end 
+  else begin
+	if openoutnameok(stringcast(nameoffile+1)) then begin
+      lua_a_open_out := a_open_out(f);
+      name_file_pointer := f;
+      end
+    else
+      lua_a_open_out := false;
+   end;
+end;
+function lua_b_open_out(var f:alpha_file):boolean;
+var test:boolean;
+  k:integer;
+  fnam:str_number;
+  callback_id:integer;
+begin
+  name_file_pointer := 0;
+  callback_id:=callback_defined(find_output_file_callback);
+  if callback_id>0 then begin
+    fnam:=0;
+    test:=run_callback(callback_id,'S->s',stringcast(nameoffile+1),addressof(fnam));
+    if (test)and(fnam<>0)and(length(fnam)>0) then begin
+      @<Fixup |nameoffile| after callback@>;
+      lua_b_open_out := do_b_open_out(f);
+	  name_file_pointer := f;
+      end
+    else 
+      lua_b_open_out := false;
+    end 
+  else begin
+	if openoutnameok(stringcast(nameoffile+1)) then begin
+      lua_b_open_out := b_open_out(f);
+      name_file_pointer := f;
+      end
+    else
+      lua_b_open_out := false;
+   end;
+end;
+
+@ 
+@<Fixup |nameoffile| after callback@>=
+libcfree (nameoffile);
+nameoffile := xmallocarray (packed_ASCII_code, length(fnam)+2);
+for k:=str_start_macro(fnam) to str_start_macro(fnam+1)-1 do
+  nameoffile[k-str_start_macro(fnam)+1] := str_pool[k];
+nameoffile[length(fnam)+1]:=0;
+namelength := length(fnam);
+flush_string
+
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@^system dependencies@>
+should be used when all input or output with respect to |f| has been completed.
+This makes |f| available to be opened again, if desired; and if |f| was used for
+output, the |close| operation makes the corresponding external file appear
+on the user's area, ready to be read.
+
+These procedures should not generate error messages if a file is
+being closed before it has been successfully opened.
+
+@p procedure a_close(var f:alpha_file); {close a text file}
+begin close(f);
+end;
+@#
+procedure b_close(var f:byte_file); {close a binary file}
+begin close(f);
+end;
+@#
+procedure w_close(var f:word_file); {close a word file}
+begin close(f);
+end;
+
+
+@
+ 
+@p procedure lua_a_close_in(var f:alpha_file; n:quarterword); {close a text file}
+var ret:boolean;
+    callback_id:integer;
+begin
+if n=0 then
+  callback_id:=input_file_callback_id[index]
+else
+  callback_id:=read_file_callback_id[n];
+if callback_id>0 then begin
+  ret:=run_saved_callback(callback_id,'close','->');
+  destroy_saved_callback(callback_id);
+  if n=0 then
+    input_file_callback_id[index] := 0
+  else
+    read_file_callback_id[n] := 0;
+  end
+else
+  a_close(f);
+end;
+@#
+procedure lua_a_close_out(var f:alpha_file); {close a text file}
+begin
+  a_close(f);
+end;
+
+
+@ Binary input and output are done with \PASCAL's ordinary |get| and |put|
+procedures, so we don't have to make any other special arrangements for
+binary~I/O. Text output is also easy to do with standard \PASCAL\ routines.
+The treatment of text input is more difficult, however, because
+of the necessary translation to |ASCII_code| values.
+\TeX's conventions should be efficient, and they should
+blend nicely with the user's operating environment.
+
+@ Input from text files is read one line at a time, using a routine called
+|lua_input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of packed_ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+
+@ The |lua_input_ln| function brings the next line of input from the specified
+file into available positions of the buffer array and returns the value
+|true|, unless the file has already been entirely read, in which case it
+returns |false| and sets |last:=first|.  In general, the |ASCII_code|
+numbers that represent the next line of the file are input into
+|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
+global variable |last| is set equal to |first| plus the length of the
+line. Trailing blanks are removed from the line; thus, either |last=first|
+(in which case the line was entirely blank) or |buffer[last-1]<>" "|.
+
+An overflow error is given, however, if the normal actions of |lua_input_ln|
+would make |last>=buf_size|; this is done so that other parts of \TeX\
+can safely look at the contents of |buffer[last+1]| without overstepping
+the bounds of the |buffer| array. Upon entry to |lua_input_ln|, the condition
+|first<buf_size| will always hold, so that there is always room for an
+``empty'' line.
+
+The variable |max_buf_stack|, which is used to keep track of how large
+the |buf_size| parameter must be to accommodate the present job, is
+also kept up to date by |lua_input_ln|.
+
+If the |bypass_eoln| parameter is |true|, |lua_input_ln| will do a |get|
+before looking at the first character of the line; this skips over
+an |eoln| that was in |f^|. The procedure does not do a |get| when it
+reaches the end of the line; therefore it can be used to acquire input
+from the user's terminal as well as from ordinary text files.
+
+Standard \PASCAL\ says that a file should have |eoln| immediately
+before |eof|, but \TeX\ needs only a weaker restriction: If |eof|
+occurs in the middle of a line, the system function |eoln| should return
+a |true| result (even though |f^| will be undefined).
+
+Since the inner loop of |lua_input_ln| is part of \TeX's ``inner loop''---each
+character of input comes in at this place---it is wise to reduce system
+overhead by making use of special routines that read in an entire array
+of characters at once, if such routines are available. The following
+code uses standard \PASCAL\ to illustrate what needs to be done, but
+finer tuning is often possible at well-developed \PASCAL\ sites.
+@^inner loop@>
+
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+  {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+  {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else  begin last_nonblank:=first;
+  while not eoln(f) do
+    begin if last>=max_buf_stack then
+      begin max_buf_stack:=last+1;
+      if max_buf_stack=buf_size then
+        @<Report overflow of the input buffer, and abort@>;
+      end;
+    buffer[last]:=f^; get(f); incr(last);
+    if buffer[last-1]<>" " then last_nonblank:=last;
+    end;
+  last:=last_nonblank; input_ln:=true;
+  end;
+end;
+
+function lua_input_ln(var f:alpha_file;n:quarterword;@!bypass_eoln:boolean):boolean;
+var lua_result:boolean;
+	last_ptr:integer;
+    callback_id:integer;
+	bypass_p:boolean;
+begin
+if n=0 then
+  callback_id:=input_file_callback_id[index]
+else 
+  callback_id:=read_file_callback_id[n];
+if callback_id>0 then begin
+    last:=first;
+	last_ptr := first;
+    lua_result := run_saved_callback(callback_id,'reader','->l', addressof(last_ptr));
+	if (lua_result=true)and(last_ptr<>0) then begin
+	  last := last_ptr;
+	  if last>max_buf_stack then max_buf_stack:=last; 
+	  lua_input_ln := true;
+      @<Fix up the input buffer using callbacks@>; 
+      end
+    else 
+      lua_input_ln := false;
+    end
+  else begin
+    bypass_p := bypass_eoln; {this is for -Wextra}
+    lua_result := input_ln(f,bypass_p);
+	if lua_result=true then begin
+      lua_input_ln := true;
+      @<Fix up the input buffer using callbacks@>; 
+      end
+    else
+      lua_input_ln := false;
+    end
+end;
+
+@ 
+@<Fix up the input buffer using callbacks@>=
+if last>=first then begin
+  callback_id := callback_defined(process_input_buffer_callback);
+  if callback_id>0 then begin
+    last_ptr := first;
+    lua_result := run_callback(callback_id, 'l->l', (last-first), addressof(last_ptr)); 
+    if (lua_result=true)and(last_ptr<>0) then begin
+	  last := last_ptr;
+	  if last>max_buf_stack then max_buf_stack:=last; 
+      end;
+    end;
+  end
+
+
+
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input}
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+
+@ Sometimes it is necessary to synchronize the input/output mixture that
+happens on the user's terminal, and three system-dependent
+procedures are used for this
+purpose. The first of these, |update_terminal|, is called when we want
+to make sure that everything we have output to the terminal so far has
+actually left the computer's internal buffers and been sent.
+The second, |clear_terminal|, is called when we wish to cancel any
+input that the user may have typed ahead (since we are about to
+issue an unexpected error message). The third, |wake_up_terminal|,
+is supposed to revive the terminal if the user has disabled it by
+some instruction to the operating system.  The following macros show how
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+
+@ We need a special routine to read the first line of \TeX\ input from
+the user's terminal. This line is different because it is read before we
+have opened the transcript file; there is sort of a ``chicken and
+egg'' problem here. If the user types `\.{\\input paper}' on the first
+line, or if some macro invoked by that line does such an \.{\\input},
+the transcript file will be named `\.{paper.log}'; but if no \.{\\input}
+commands are performed during the first line of terminal input, the transcript
+file will acquire its default name `\.{texput.log}'. (The transcript file
+will not contain error messages generated by the first line before the
+first \.{\\input} command.)
+@.texput@>
+
+The first line is even more special if we are lucky enough to have an operating
+system that treats \TeX\ differently from a run-of-the-mill \PASCAL\ object
+program. It's nice to let the user start running a \TeX\ job by typing
+a command line like `\.{tex paper}'; in such a case, \TeX\ will operate
+as if the first line of input were `\.{paper}', i.e., the first line will
+consist of the remainder of the command line, after the part that invoked
+\TeX.
+
+The first line is special also because it may be read before \TeX\ has
+input a format file. In such cases, normal error messages cannot yet
+be given. The following code uses concepts that will be explained later.
+(If the \PASCAL\ compiler does not support non-local |@!goto|\unskip, the
+@^system dependencies@>
+statement `|goto final_end|' should be replaced by something that
+quietly terminates the program.)
+
+@<Report overflow of the input buffer, and abort@>=
+if format_ident=0 then
+  begin writeln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+  end
+else 
+  check_buffer_overflow(buf_size+10) { need  a little bit more}
+
+@ Different systems have different ways to get started. But regardless of
+what conventions are adopted, the routine that initializes the terminal
+should satisfy the following specifications:
+
+\yskip\textindent{1)}It should open file |term_in| for input from the
+  terminal. (The file |term_out| will already be open for output to the
+  terminal.)
+
+\textindent{2)}If the user has given a command line, this line should be
+  considered the first line of terminal input. Otherwise the
+  user should be prompted with `\.{**}', and the first line of input
+  should be whatever is typed in response.
+
+\textindent{3)}The first line of input, which might or might not be a
+  command line, should appear in locations |first| to |last-1| of the
+  |buffer| array.
+
+\textindent{4)}The global variable |loc| should be set so that the
+  character to be read next by \TeX\ is in |buffer[loc]|. This
+  character should not be blank, and we should have |loc<last|.
+
+\yskip\noindent(It may be necessary to prompt the user several times
+before a non-blank line comes in. The prompt is `\.{**}' instead of the
+later `\.*' because the meaning is slightly different: `\.{\\input}' need
+not be typed immediately after~`\.{**}'.)
+
+@d loc==cur_input.loc_field {location of first unread character in |buffer|}
+
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+  if not input_ln(term_in,true)
+then {this shouldn't happen}
+    begin writeln(term_out);
+    write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+    init_terminal:=false; return;
+    end;
+  loc:=first;
+  while (loc<last)and(buffer[loc]=" ") do incr(loc);
+  if loc<last then
+    begin init_terminal:=true;
+    return; {return unless the line was all blank}
+    end;
+  writeln(term_out,'Please type the name of your input file.');
+  end;
+exit:end;
+
+@* \[4] String handling.
+Control sequence names and diagnostic messages are variable-length strings
+of eight-bit characters. Since \PASCAL\ does not have a well-developed string
+mechanism, \TeX\ does all of its string processing by homegrown methods.
+
+Elaborate facilities for dynamic strings are not needed, so all of the
+necessary operations can be handled with a simple data structure.
+The array |str_pool| contains all of the (eight-bit) ASCII codes in all
+of the strings, and the array |str_start| contains indices of the starting
+points of each string. Strings are referred to by integer numbers, so that
+string number |s| comprises the characters |str_pool[j]| for
+|str_start_macro(s)<=j<str_start_macro(s+1)|. Additional integer variables
+|pool_ptr| and |str_ptr| indicate the number of entries used so far
+in |str_pool| and |str_start|, respectively; locations
+|str_pool[pool_ptr]| and |str_start_macro(str_ptr)| are
+ready for the next string to be allocated.
+
+String numbers 0 to |biggest_char| are reserved for strings that correspond to single
+UNICODE characters. This is in accordance with the conventions of \.{WEB},
+@.WEB@>
+which converts single-character strings into the ASCII code number of the
+single character involved, while it converts other strings into integers
+and builds a string pool file. Thus, when the string constant \.{"."} appears
+in the program below, \.{WEB} converts it into the integer 46, which is the
+ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"}
+into some integer greater than~|biggest_char|. 
+
+Some \PASCAL\ compilers won't pack integers into a single byte unless the
+integers lie in the range |-128..127|. To accommodate such systems
+we access the string pool only via macros that can easily be redefined.
+
+@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|}
+@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|}
+@d str_start_macro(#) == str_start[(#) - string_offset]
+
+@<Types...@>=
+@!pool_pointer = integer; {for variables that point into |str_pool|}
+@!str_number = integer; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..255; {elements of |str_pool| array}
+
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of packed_ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@!pool_ptr : pool_pointer; {first unused position in |str_pool|}
+@!str_ptr : str_number; {number of the current string being created}
+@!init_pool_ptr : pool_pointer; {the starting value of |pool_ptr|}
+@!init_str_ptr : str_number; {the starting value of |str_ptr|}
+
+@ Several of the elementary string operations are performed using \.{WEB}
+macros instead of \PASCAL\ procedures, because many of the
+operations are done quite frequently and we want to avoid the
+overhead of procedure calls. For example, here is
+a simple macro that computes the length of a string.
+@.WEB@>
+
+@d length(#)==(str_start_macro(#+1)-str_start_macro(#)) {the number of characters
+  in string number \#}
+
+@ The length of the current string is called |cur_length|:
+
+@d cur_length == (pool_ptr - str_start_macro(str_ptr))
+
+@ Strings are created by appending character codes to |str_pool|.
+The |append_char| macro, defined here, does not check to see if the
+value of |pool_ptr| has gotten too high; this test is supposed to be
+made before |append_char| is used. There is also a |flush_char|
+macro, which erases the last character appended.
+
+To test if there is room to append |l| more characters to |str_pool|,
+we shall write |str_room(l)|, which aborts \TeX\ and gives an
+apologetic error message if there isn't enough room.
+
+@d append_char(#) == {put |ASCII_code| \# at the end of |str_pool|}
+begin str_pool[pool_ptr]:=si(#); incr(pool_ptr);
+end
+@d flush_char == decr(pool_ptr) {forget the last character in the pool}
+@d str_room(#) == check_pool_overflow((pool_ptr+#)) {test or grow the pool}
+
+@p procedure string_room(t:integer);
+begin
+	str_room(t);
+end;
+@#
+procedure append_pool_char(c:ASCII_code);
+begin
+	append_char(c);
+end;
+
+
+@ Once a sequence of characters has been appended to |str_pool|, it
+officially becomes a string when the function |make_string| is called.
+This function returns the identification number of the new string as its
+value.
+
+@p function make_string : str_number; {current string enters the pool}
+begin if str_ptr=(max_strings+string_offset) then
+  overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+incr(str_ptr); str_start_macro(str_ptr):=pool_ptr;
+make_string:=str_ptr-1;
+end;
+
+@ To destroy the most recently made string, we say |flush_string|.
+
+The helper routines reads one utf sequence from the pool resp. the
+buffer, and returns its character value. 
+
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr);
+  end
+@d test_sequence_byte(#)==if (#<@"80) or (#>=@"C0) then begin
+  print_err("Text line contains an invalid utf-8 sequence");
+@.Text line contains...@>
+  help2("A funny symbol that I can't read has just been input.")@/
+    ("Just continue, I'll change it to 0xFFFD.");@/
+  deletions_allowed:=false; error; deletions_allowed:=true;
+{the assigment before return is needed because web2c generates incorrect code}
+  a:=@"FFFD; buffer_to_unichar:=a; return; end
+
+
+@p function buffer_to_unichar(@!k:integer):integer;
+label exit;
+var a:@!integer; {a utf char}
+b:@!integer; { a utf nibble}
+begin
+    b := buffer[k];
+    if b<@"80 then
+      a := b
+    else if b>=@"F0 then begin
+	  a := (b-@"F0) * 64;
+	  b := buffer[k+1];
+	  test_sequence_byte(b);
+	  a := (a + (b-128)) * 64;
+	  b := buffer[k+2];
+	  test_sequence_byte(b);
+	  a := (a + (b-128)) * 64;
+	  b := buffer[k+3];
+	  test_sequence_byte(b);
+	  a := a + (b-128);
+      end 
+    else if b>=@"E0 then begin
+	  a := (b-@"E0) * 64;
+	  b := buffer[k+1];
+	  test_sequence_byte(b);
+	  a := (a + (b-128)) * 64;
+	  b := buffer[k+2];
+	  test_sequence_byte(b);
+	  a := a + (b-128);
+      end 
+    else if b>=@"C0 then begin
+	  a := (b-@"C0) * 64;
+	  b := buffer[k+1];
+	  test_sequence_byte(b);
+	  a := a + (b-128);
+      end
+    else begin { NI: this is an encoding error }
+	  print_err("Buffer contains an invalid utf-8 sequence");
+@.Text line contains...@>
+	  help2("A funny symbol somehow ended up in the input buffer.")@/
+    	   ("Just continue, I'll change it to 0xFFFD.");@/
+      deletions_allowed:=false; error; deletions_allowed:=true;
+      a:=@"FFFD;
+      end;
+exit: 
+  buffer_to_unichar := a;
+end ;
+
+
+
+@ The following subroutine compares string |s| with another string of the
+same length that appears in |buffer| starting at position |k|;
+the result is |true| if and only if the strings are equal.
+Empirical tests indicate that |str_eq_buf| is used in such a way that
+it tends to return |true| about 80 percent of the time.
+
+@p function str_eq_buf(@!s:str_number;@!k:integer):boolean;
+  {test equality of strings}
+label not_found; {loop exit}
+var j: pool_pointer; {running index}
+a: ASCII_code; {a unicode character }
+@!result: boolean; {result of comparison}
+begin result:=false; 
+if s<string_offset then begin
+  a := buffer_to_unichar(k); 
+  if a<>s then goto not_found;
+  end
+else begin
+j:=str_start_macro(s);
+while j<str_start_macro(s+1) do
+  begin if so(str_pool[j])<>buffer[k] then
+    begin goto not_found;
+    end;
+  incr(j); incr(k);
+  end;
+end;
+result:=true;
+not_found: str_eq_buf:=result;
+end;
+
+@ Here is a similar routine, but it compares two strings in the string pool,
+and it does not assume that they have the same length.
+
+@p function str_eq_str(@!s,@!t:str_number):boolean;
+  {test equality of strings}
+label found,not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+a: ASCII_code; {a utf char}
+@!result: boolean; {result of comparison}
+begin result:=false;
+a:= 0;
+if s<string_offset then begin
+  if t>=string_offset then begin
+    if s<=@"7F then
+     if length(t)=1 then
+       if str_pool[str_start_macro(t)]=s then
+          goto found;
+	a := pool_to_unichar(str_start_macro(t));
+    if a<>s then goto not_found;
+    end 
+  else
+    if t<>s then goto not_found;
+  end
+else if t<string_offset then begin
+ if t<=@"7F then
+   if length(s)=1 then
+     if str_pool[str_start_macro(s)]=t then
+       goto found;
+  a := pool_to_unichar(str_start_macro(s));
+  if a<>t then goto not_found;
+  end 
+else begin 
+  if length(s)<>length(t) then goto not_found;
+  j:=str_start_macro(s); k:=str_start_macro(t);
+  while j<str_start_macro(s+1) do
+    begin if str_pool[j]<>str_pool[k] then goto not_found;
+    incr(j); incr(k);
+    end;
+  end;
+found: result:=true;
+not_found: str_eq_str:=result;
+end;
+
+@ The initial values of |str_pool|, |str_start|, |pool_ptr|,
+and |str_ptr| are computed by the \.{INITEX} program, based in part
+on the information that \.{WEB} has output while processing \TeX.
+@.INITEX@>
+@^string pool@>
+
+The first |string_offset| strings are single-characters strings matching
+Unicode. There is no point in generating all of these. But |str_ptr| has
+initialized properly, otherwise |print_char| cannot see the difference
+between characters and strings.
+
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+  but returns |false| if something goes wrong}
+label done,exit;
+var @!g:str_number; {garbage}
+begin pool_ptr:=0; str_ptr:=string_offset; str_start[0]:=0;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+  or give an error message and return |false|@>;
+exit:end;
+tini
+
+@ @d app_lc_hex(#)==l:=#;
+  if l<10 then append_char(l+"0")@+else append_char(l-10+"a")
+
+@ The first 128 strings will contain 95 standard ASCII characters, and the
+other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
+unless a system-dependent change is made here. Installations that have
+an extended character set, where for example |xchr[@'32]=@t\.{\'^^Z\'}@>|,
+would like string @'32 to be the single character @'32 instead of the
+three characters @'136, @'136, @'132 (\.{\^\^Z}). On the other hand,
+even people with an extended character set will want to represent string
+@'15 by \.{\^\^M}, since @'15 is |carriage_return|; the idea is to
+produce visible strings instead of tabs or line-feeds or carriage-returns
+or bell-rings or characters that are treated anomalously in text files.
+
+Unprintable characters of codes 128--255 are, similarly, rendered
+\.{\^\^80}--\.{\^\^ff}.
+
+Unprintable characters of codes 256--|65535| are, similarly, rendered
+\.{\^\^\^\^0100}--\.{\^\^\^\^ffff}.
+
+The boolean expression defined here should be |true| unless \TeX\
+internal code number~|k| corresponds to a non-troublesome visible
+symbol in the local character set.  An appropriate formula for the
+extended character set recommended in {\sl The \TeX book\/} would, for
+example, be `|k in [0,@'10..@'12,@'14,@'15,@'33,@'177..@'377]|'.
+If character |k| cannot be printed, and |k<@'200|, then character |k+@'100| or
+|k-@'100| must be printable; moreover, ASCII codes |[@'41..@'46,
+@'60..@'71, @'141..@'146, @'160..@'171]| must be printable.
+Thus, at least 80 printable characters are needed.
+@:TeXbook}{\sl The \TeX book@>
+@^character set dependencies@>
+@^system dependencies@>
+
+@ @<Read the other strings...@>=
+  g := loadpoolstrings((pool_size-string_vacancies));
+  if g=0 then begin
+     wake_up_terminal; writeln(term_out,'! You have to increase POOLSIZE.');
+     get_strings_started:=false;
+     return;
+  end;
+  get_strings_started:=true;
+
+@* \[5] On-line and off-line printing.
+Messages that are sent to a user's terminal and to the transcript-log file
+are produced by several `|print|' procedures. These procedures will
+direct their output to a variety of places, based on the setting of
+the global variable |selector|, which has the following possible
+values:
+
+\yskip
+\hang |term_and_log|, the normal setting, prints on the terminal and on the
+  transcript file.
+
+\hang |log_only|, prints only on the transcript file.
+
+\hang |term_only|, prints only on the terminal.
+
+\hang |no_print|, doesn't print at all. This is used only in rare cases
+  before the transcript file is open.
+
+\hang |pseudo|, puts output into a cyclic buffer that is used
+  by the |show_context| routine; when we get to that routine we shall discuss
+  the reasoning behind this curious mode.
+
+\hang |new_string|, appends the output to the current string in the
+  string pool.
+
+\hang 0 to 15, prints on one of the sixteen files for \.{\\write} output.
+
+\yskip
+\noindent The symbolic names `|term_and_log|', etc., have been assigned
+numeric codes that satisfy the convenient relations |no_print+1=term_only|,
+|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|.
+
+Three additional global variables, |tally| and |term_offset| and
+|file_offset|, record the number of characters that have been printed
+since they were most recently cleared to zero. We use |tally| to record
+the length of (possibly very long) stretches of printing; |term_offset|
+and |file_offset|, on the other hand, keep track of how many characters
+have appeared so far on the current line that has been output to the
+terminal or to the transcript file, respectively.
+
+@d no_print=16 {|selector| setting that makes data disappear}
+@d term_only=17 {printing is destined for the terminal only}
+@d log_only=18 {printing is destined for the transcript file only}
+@d term_and_log=19 {normal |selector| setting}
+@d pseudo=20 {special |selector| setting for |show_context|}
+@d new_string=21 {printing is deflected to the string pool}
+@d max_selector=21 {highest selector setting}
+
+@<Glob...@>=
+@!log_file : alpha_file; {transcript of \TeX\ session}
+@!term_out_mode:halfword;
+@!term_out_translation:halfword;
+@!selector : 0..max_selector; {where to print a message}
+@!dig : array[0..22] of 0..15; {digits in a number being output}
+@!tally : integer; {the number of characters recently printed}
+@!term_offset : 0..max_print_line;
+  {the number of characters on the current terminal line}
+@!file_offset : 0..max_print_line;
+  {the number of characters on the current file line}
+@!trick_buf:array[0..error_line] of packed_ASCII_code; {circular buffer for
+  pseudoprinting}
+@!trick_count: integer; {threshold for pseudoprinting, explained later}
+@!first_count: integer; {another variable for pseudoprinting}
+@!inhibit_par_tokens:boolean; { for minor adjustments to |show_token_list| }
+
+@ @<Initialize the output routines@>=
+selector:=term_only; tally:=0; term_offset:=0; file_offset:=0;
+inhibit_par_tokens:=false;
+
+@ Macro abbreviations for output to the terminal and to the log file are
+defined here for convenience. Some systems need special conventions
+for terminal output, and it is possible to adhere to those conventions
+by changing |wterm|, |wterm_ln|, and |wterm_cr| in this section.
+@^system dependencies@>
+
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==writeln(term_out,#)
+@d wterm_cr==writeln(term_out)
+@d wlog(#)==write(log_file,#)
+@d wlog_ln(#)==writeln(log_file,#)
+@d wlog_cr==writeln(log_file)
+
+@ To end a line of text output, we call |print_ln|.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+  term_offset:=0; file_offset:=0;
+  end;
+log_only: begin wlog_cr; file_offset:=0;
+  end;
+term_only: begin wterm_cr; term_offset:=0;
+  end;
+no_print,pseudo,new_string: do_nothing;
+othercases writeln(write_file[selector])
+endcases;@/
+end; {|tally| is not affected}
+
+@ The |print_char| procedure sends one character to the desired destination,
+using the |xchr| array to map it into an external character compatible with
+|lua_input_ln|. All printing comes through |print_ln| or |print_char|.
+
+@d wterm_char(#)==begin if (#>=@"20)or(#=@"0A)or(#=@"0D)or(#=@"09) then wterm(xchr[#])
+                  else begin if term_offset+2>=max_print_line then begin
+                     wterm_cr; term_offset:=0;
+                     end;
+                     incr(term_offset); wterm('^'); incr(term_offset); wterm('^'); 
+                     wterm(xchr[#+64]);  
+                 end; end
+@d fix_term_offset(#)==
+      if ((#>=@"C0) and (#<=@"DF) and (term_offset+2>=max_print_line)) or
+         ((#>=@"E0) and (#<=@"EF) and (term_offset+3>=max_print_line)) or
+         ((#>=@"F0) and (term_offset+4>=max_print_line)) then begin
+        wterm_cr; term_offset:=0;
+       end
+@d fix_log_offset(#)==
+      if ((#>=@"C0) and (#<=@"DF) and (file_offset+2>=max_print_line)) or
+         ((#>=@"E0) and (#<=@"EF) and (file_offset+3>=max_print_line)) or
+         ((#>=@"F0) and (file_offset+4>=max_print_line)) then begin
+        wlog_cr; file_offset:=0;
+       end
+
+@<Basic print...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+  begin print_ln; return;
+  end;
+case selector of
+term_and_log: begin 
+  fix_term_offset(s); fix_log_offset(s);
+  wterm_char(s); wlog(xchr[s]);
+  incr(term_offset); incr(file_offset);
+  if term_offset=max_print_line then
+    begin wterm_cr; term_offset:=0;
+    end;
+  if file_offset=max_print_line then
+    begin wlog_cr; file_offset:=0;
+    end;
+  end;
+log_only: begin 
+  fix_log_offset(s);
+  wlog(xchr[s]); incr(file_offset);
+  if file_offset=max_print_line then print_ln;
+  end;
+term_only: begin 
+  fix_term_offset(s); 
+  wterm_char(s); incr(term_offset);
+  if term_offset=max_print_line then print_ln;
+  end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+  end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+
+@ An entire string is output by calling |print|. Note that if we are outputting
+the single standard ASCII character \.c, we could call |print("c")|, since
+|"c"=99| is the number of a single-character string, as explained above. But
+|print_char("c")| is quicker, so \TeX\ goes directly to the |print_char|
+routine when it knows that this is safe. (The present implementation
+assumes that it is always safe to print a visible ASCII character.)
+@^system dependencies@>
+
+The first 256 entries above the 17th unicode plane are used for a
+special trick: when \TeX\ has to print items in that range, it will
+instead print the character that results from substracting @"110000
+from that value. This allows byte-oriented output to things like
+\.{\\specials} and \.{\\pdfliterals}. Todo: Perhaps it would be useful 
+to do the same substraction while typesetting.
+ 
+@d print_lc_hex(#)==l:=#;
+   if l<10 then print_char(l+"0") else print_char(l-10+"a");
+
+@<Basic print...@>=
+function pool_to_unichar(@!t:pool_pointer):ASCII_code;
+var a,result:@!ASCII_code; {a utf char}
+b:@!quarterword; { a utf nibble}
+begin
+    b := str_pool[t];
+    if b<=@"7F then
+      a := b
+    else if b>=@"F0 then begin
+	  a := (b-@"F0) * 64;
+	  b := str_pool[t+1];
+	  a := (a + (b-128)) * 64;
+	  b := str_pool[t+2];
+	  a := (a + (b-128)) * 64;
+	  b := str_pool[t+3];
+	  a := a + (b-128);
+      end
+    else if b>=@"E0 then begin
+	  a := (b-@"E0) * 64;
+	  b := str_pool[t+1];
+	  a := (a + (b-128)) * 64;
+	  b := str_pool[t+2];
+	  a := a + (b-128);
+      end 
+    else if b>=@"C0 then begin
+	  a := (b-@"C0) * 64;
+	  b := str_pool[t+1];
+	  a := a + (b-128);
+      end
+    else begin  { NI: this is an encoding error }
+	  wlog_ln('! Pool contains an invalid utf-8 sequence');
+	  wterm_ln('! Pool contains an invalid utf-8 sequence');
+@.Text line contains...@>
+	  help2("A funny symbol somehow ended up in the string pool.")@/
+    	   ("Just continue, I'll change it to 0xFFFD.");@/
+      deletions_allowed:=false; error; deletions_allowed:=true;
+      a:=@"FFFD;
+      end;
+result := a;
+pool_to_unichar := result;
+end ;
+
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!v:integer; { a unicode char }
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<string_offset then
+  if s<0 then s:="???" {can't happen}
+  else begin 
+    {TH not sure about this, disabled for now!}
+    if (false)and(selector>pseudo) then
+      begin print_char(s); return; {internal strings are not expanded}
+      end;
+    if (@<Character |s| is the current new-line character@>) then
+      if selector<pseudo then
+        begin print_ln; return;
+        end;
+    if s<=@"7F then
+      print_char(s)
+    else if s<=@"7FF then begin
+      print_char(@"C0 + (s div @"40));
+      print_char(@"80 + (s mod @"40));
+      end
+    else if s<=@"FFFF then begin
+      print_char(@"E0 + (s div @"1000));
+      print_char(@"80 + ((s mod @"1000) div @"40));
+      print_char(@"80 + ((s mod @"1000) mod @"40));
+      end 
+    else begin 
+      if s>=@"110000 then 
+	    print_char(s-@"110000)
+      else begin
+        print_char(@"F0 + (s div @"40000));
+        print_char(@"80 + ((s mod @"40000) div @"1000));
+        print_char(@"80 + (((s mod @"40000) mod @"1000) div @"40));
+        print_char(@"80 + (((s mod @"40000) mod @"1000) mod @"40));
+        end;
+      end;
+    return;
+    end;
+j:=str_start_macro(s);
+while j<str_start_macro(s+1) do
+  begin { 0x110000 in utf=8: 0xF4 0x90 0x80 0x80 }
+    if (str_pool[j]=@"F4)and(j<str_start_macro(s+4))and(str_pool[j+1]=@"90) then begin
+	  v := (((7*64+63)*64)+ (str_pool[j+2]-128))*64 +(str_pool[j+3]-128);
+	  print_char(v-@"110000); j := j+4;
+      end
+    else begin
+      print_char(str_pool[j]); incr(j);
+    end;
+  end;
+exit:end;
+
+procedure print_nl(@!s:str_number); {prints string |s| at beginning of line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+  ((file_offset>0)and(selector>=log_only)) then print_ln;
+print(s);
+end;
+
+procedure print_nlp; {move to beginning of a line}
+begin if ((term_offset>0)and(odd(selector)))or@|
+  ((file_offset>0)and(selector>=log_only)) then print_ln;
+end;
+
+@ Control sequence names, file names, and strings constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_char|. Therefore we use |slow_print| for them:
+
+@<Basic print...@>=
+procedure slow_print(@!s:integer); {prints string |s|}
+var j:pool_pointer; {current character code position}
+begin if (s>=str_ptr) or (s<string_offset) then print(s)
+else begin j:=str_start_macro(s);
+  while j<str_start_macro(s+1) do
+    begin print(so(str_pool[j])); incr(j);
+    end;
+  end;
+end;
+
+@ Here is the very first thing that \TeX\ prints: a headline that identifies
+the version number and format package. The |term_offset| variable is temporarily
+incorrect, but the discrepancy is not serious since we assume that the banner
+and format identifier together will occupy at most |max_print_line|
+character positions.
+
+@<Initialize the output...@>=
+print_banner;
+
+@ The procedure |print_nl| is like |print|, but it makes sure that the
+string appears at the beginning of a new line. (moved)
+
+@<Basic print...@>=
+
+@ The procedure |print_esc| prints a string that is preceded by
+the user's escape character (which is usually a backslash).
+
+@<Basic print...@>=
+procedure print_esc(@!s:str_number); {prints escape character, then |s|}
+var c:integer; {the escape character code}
+begin  @<Set variable |c| to the current escape character@>;
+if c>=0 then if c<string_offset then print(c);
+slow_print(s);
+end;
+
+@ An array of digits in the range |0..15| is printed by |print_the_digs|.
+
+@<Basic print...@>=
+procedure print_the_digs(@!k:eight_bits);
+  {prints |dig[k-1]|$\,\ldots\,$|dig[0]|}
+begin while k>0 do
+  begin decr(k);
+  if dig[k]<10 then print_char("0"+dig[k])
+  else print_char("A"-10+dig[k]);
+  end;
+end;
+
+@ The following procedure, which prints out the decimal representation of a
+given integer |n|, has been written carefully so that it works properly
+if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
+to negative arguments, since such operations are not implemented consistently
+by all \PASCAL\ compilers.
+
+@<Basic print...@>=
+procedure print_int(@!n:integer); {prints an integer in decimal form}
+var k:0..23; {index to current digit; we assume that $|n|<10^{23}$}
+@!m:integer; {used to negate |n| in possibly dangerous cases}
+begin k:=0;
+if n<0 then
+  begin print_char("-");
+  if n>-100000000 then negate(n)
+  else  begin m:=-1-n; n:=m div 10; m:=(m mod 10)+1; k:=1;
+    if m<10 then dig[0]:=m
+    else  begin dig[0]:=0; incr(n);
+      end;
+    end;
+  end;
+repeat dig[k]:=n mod 10; n:=n div 10; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ Here is a trivial procedure to print two digits; it is usually called with
+a parameter in the range |0<=n<=99|.
+
+@p procedure print_two(@!n:integer); {prints two least significant digits}
+begin n:=abs(n) mod 100; print_char("0"+(n div 10));
+print_char("0"+(n mod 10));
+end;
+
+@ Hexadecimal printing of nonnegative integers is accomplished by |print_hex|.
+
+@p procedure print_hex(@!n:integer);
+  {prints a positive integer in hexadecimal form}
+var k:0..22; {index to current digit; we assume that $0\L n<16^{22}$}
+begin k:=0; print_char("""");
+repeat dig[k]:=n mod 16; n:=n div 16; incr(k);
+until n=0;
+print_the_digs(k);
+end;
+
+@ Old versions of \TeX\ needed a procedure called |print_ASCII| whose function
+is now subsumed by |print|. We retain the old name here as a possible aid to
+future software arch\ae ologists.
+
+@d print_ASCII == print
+@d print_font_name(#)==begin print(tex_font_name(#)); flush_string; end
+ 
+@ Roman numerals are produced by the |print_roman_int| routine.  Readers
+who like puzzles might enjoy trying to figure out how this tricky code
+works; therefore no explanation will be given. Notice that 1990 yields
+\.{mcmxc}, not \.{mxm}.
+
+@p procedure print_roman_int(@!n:integer);
+label exit;
+var j,@!k: pool_pointer; {mysterious indices into |str_pool|}
+@!u,@!v: nonnegative_integer; {mysterious numbers}
+begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000;
+loop@+  begin while n>=v do
+    begin print_char(so(str_pool[j])); n:=n-v;
+    end;
+  if n<=0 then return; {nonpositive input produces no output}
+  k:=j+2; u:=v div (so(str_pool[k-1])-"0");
+  if str_pool[k-1]=si("2") then
+    begin k:=k+2; u:=u div (so(str_pool[k-1])-"0");
+    end;
+  if n+u>=v then
+    begin print_char(so(str_pool[k])); n:=n+u;
+    end
+  else  begin j:=j+2; v:=v div (so(str_pool[j-1])-"0");
+    end;
+  end;
+exit:end;
+
+@ The |print| subroutine will not print a string that is still being
+created. The following procedure will.
+
+@p procedure print_current_string; {prints a yet-unmade string}
+var j:pool_pointer; {points to current character code}
+begin j:=str_start_macro(str_ptr);
+while j<pool_ptr do
+  begin print_char(so(str_pool[j])); incr(j);
+  end;
+end;
+
+@ Here is a procedure that asks the user to type a line of input,
+assuming that the |selector| setting is either |term_only| or |term_and_log|.
+The input is placed into locations |first| through |last-1| of the
+|buffer| array, and echoed on the transcript file if appropriate.
+
+This procedure is never called when |interaction<scroll_mode|.
+
+@<Basic print...@>=
+procedure prompt_input(s:str_number); 
+begin wake_up_terminal; print(s); term_input;
+end;
+
+@ 
+@p procedure term_input; {gets a line from the terminal}
+var k:0..buf_size; {index into |buffer|}
+begin update_terminal; {now the user sees the prompt for sure}
+if not input_ln(term_in,true)
+then fatal_error("End of file on the terminal!");
+@.End of file on the terminal@>
+term_offset:=0; {the user's line ended with \<\rm return>}
+decr(selector); {prepare to echo the input}
+if last<>first then for k:=first to last-1 do print(buffer[k]);
+print_ln; incr(selector); {restore previous status}
+end;
+
+@* \[6] Reporting errors.
+When something anomalous is detected, \TeX\ typically does something like this:
+$$\vbox{\halign{#\hfil\cr
+|print_err("Something anomalous has been detected");|\cr
+|help3("This is the first line of my offer to help.")|\cr
+|("This is the second line. I'm trying to")|\cr
+|("explain the best way for you to proceed.");|\cr
+|error;|\cr}}$$
+A two-line help message would be given using |help2|, etc.; these informal
+helps should use simple vocabulary that complements the words used in the
+official error message that was printed. (Outside the U.S.A., the help
+messages should preferably be translated into the local vernacular. Each
+line of help is at most 60 characters long, in the present implementation,
+so that |max_print_line| will not be exceeded.)
+
+The |print_err| procedure supplies a `\.!' before the official message,
+and makes sure that the terminal is awake if a stop is going to occur.
+The |error| procedure supplies a `\..' after the official message, then it
+shows the location of the error; and if |interaction=error_stop_mode|,
+it also enters into a dialog with the user, during which time the help
+message may be printed.
+@^system dependencies@>
+
+@ The global variable |interaction| has four settings, representing increasing
+amounts of user interaction:
+
+@d batch_mode=0 {omits all stops and omits terminal output}
+@d nonstop_mode=1 {omits all stops}
+@d scroll_mode=2 {omits error stops}
+@d error_stop_mode=3 {stops at every opportunity to interact}
+@d print_err(#)==begin if interaction=error_stop_mode then wake_up_terminal;
+  print_nl("! "); print(#);
+  last_error:=#; end
+@d print_warn(#)==begin if interaction=error_stop_mode then wake_up_terminal;
+  if prepend_nl then begin print_nl(""); print_ln end;
+  print_nl(#);
+  end
+
+@<Glob...@>=
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+@!last_error:str_number;
+
+@ @<Set init...@>=interaction:=error_stop_mode;
+
+@ \TeX\ is careful not to call |error| when the print |selector| setting
+might be unusual. The only possible values of |selector| at the time of
+error messages are
+
+\yskip\hang|no_print| (when |interaction=batch_mode|
+  and |log_file| not yet open);
+
+\hang|term_only| (when |interaction>batch_mode| and |log_file| not yet open);
+
+\hang|log_only| (when |interaction=batch_mode| and |log_file| is open);
+
+\hang|term_and_log| (when |interaction>batch_mode| and |log_file| is open).
+
+@<Initialize the print |selector| based on |interaction|@>=
+if interaction=batch_mode then selector:=no_print@+else selector:=term_only
+
+@ A global variable |deletions_allowed| is set |false| if the |get_next|
+routine is active when |error| is called; this ensures that |get_next|
+and related routines like |get_token| will never be called recursively.
+A similar interlock is provided by |set_box_allowed|.
+@^recursion@>
+
+The global variable |history| records the worst level of error that
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+
+Another global variable, |error_count|, is increased by one when an
+|error| occurs without an interactive dialog, and it is reset to zero at
+the end of every paragraph.  If |error_count| reaches 100, \TeX\ decides
+that there is no point in continuing further.
+
+@d spotless=0 {|history| value when nothing has been amiss yet}
+@d warning_issued=1 {|history| value when |begin_diagnostic| has been called}
+@d error_message_issued=2 {|history| value when |error| has been called}
+@d fatal_error_stop=3 {|history| value when termination was premature}
+
+@<Glob...@>=
+@!deletions_allowed:boolean; {is it safe for |error| to call |get_token|?}
+@!set_box_allowed:boolean; {is it safe to do a \.{\\setbox} assignment?}
+@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
+@!error_count:-1..100; {the number of scrolled errors since the
+  last paragraph ended}
+
+@ The value of |history| is initially |fatal_error_stop|, but it will
+be changed to |spotless| if \TeX\ survives the initialization process.
+
+@<Set init...@>=
+deletions_allowed:=true; set_box_allowed:=true;
+error_count:=0; {|history| is initialized elsewhere}
+
+@ Since errors can be detected almost anywhere in \TeX, we want to declare the
+error procedures near the beginning of the program. But the error procedures
+in turn use some other procedures, which need to be declared |forward|
+before we get to |error| itself.
+
+It is possible for |error| to be called recursively if some error arises
+when |get_token| is being used to delete a token, and/or if some fatal error
+occurs while \TeX\ is trying to fix a non-fatal one. But such recursion
+@^recursion@>
+is never more than two levels deep.
+
+@<Error handling...@>=
+procedure@?normalize_selector; forward;@t\2@>@/
+procedure@?get_token; forward;@t\2@>@/
+procedure@?term_input; forward;@t\2@>@/
+procedure@?show_context; forward;@t\2@>@/
+procedure@?begin_file_reading; forward;@t\2@>@/
+procedure@?open_log_file; forward;@t\2@>@/
+procedure@?close_files_and_terminate; forward;@t\2@>@/
+procedure@?clear_for_error_prompt; forward;@t\2@>@/
+procedure@?give_err_help; forward;@t\2@>@/
+@t\4\hskip-\fontdimen2\font@>@;@+@!debug@+procedure@?debug_help;
+  forward;@;@+gubed
+
+@ Individual lines of help are recorded in the array |help_line|, which
+contains entries in positions |0..(help_ptr-1)|. They should be printed
+in reverse order, i.e., with |help_line[0]| appearing last.
+
+@d hlp1(#)==help_line[0]:=#;@+end
+@d hlp2(#)==help_line[1]:=#; hlp1
+@d hlp3(#)==help_line[2]:=#; hlp2
+@d hlp4(#)==help_line[3]:=#; hlp3
+@d hlp5(#)==help_line[4]:=#; hlp4
+@d hlp6(#)==help_line[5]:=#; hlp5
+@d help0==help_ptr:=0 {sometimes there might be no help}
+@d help1==@+begin help_ptr:=1; hlp1 {use this with one help line}
+@d help2==@+begin help_ptr:=2; hlp2 {use this with two help lines}
+@d help3==@+begin help_ptr:=3; hlp3 {use this with three help lines}
+@d help4==@+begin help_ptr:=4; hlp4 {use this with four help lines}
+@d help5==@+begin help_ptr:=5; hlp5 {use this with five help lines}
+@d help6==@+begin help_ptr:=6; hlp6 {use this with six help lines}
+
+@p 
+procedure dohelp5 (@!a,b,c,d,e:str_number);
+begin
+  help5(a)(b)(c)(d)(e);
+end;
+@#
+procedure dohelp4 (@!a,b,c,d:str_number);
+begin
+  help4(a)(b)(c)(d);
+end;
+@#
+procedure dohelp3 (@!a,b,c:str_number);
+begin
+  help3(a)(b)(c);
+end;
+@#
+procedure dohelp2 (@!a,b:str_number);
+begin
+  help2(a)(b);
+end;
+@#
+procedure dohelp1 (@!a:str_number);
+begin
+  help1(a);
+end;
+@#
+procedure do_print_err (s:str_number);
+begin
+  print_err(s);
+end;
+
+@ @<Glob...@>=
+@!help_line:array[0..5] of str_number; {helps for the next |error|}
+@!help_ptr:0..6; {the number of help lines present}
+@!use_err_help:boolean; {should the |err_help| list be shown?}
+
+@ @<Set init...@>=
+help_ptr:=0; use_err_help:=false;
+
+@ The |jump_out| procedure just cuts across all active procedure levels and
+goes to |end_of_TEX|. This is the only nontrivial |@!goto| statement in the
+whole program. It is used when there is no recovery from a particular error.
+
+Some \PASCAL\ compilers do not implement non-local |goto| statements.
+@^system dependencies@>
+In such cases the body of |jump_out| should simply be
+`|close_files_and_terminate|;\thinspace' followed by a call on some system
+procedure that quietly terminates the program.
+
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+
+@ Here now is the general |error| routine.
+
+@<Error hand...@>=
+procedure error; {completes the job of error reporting}
+label continue,exit;
+var c:ASCII_code; {what the user types}
+callback_id:integer;
+@!s1,@!s2,@!s3,@!s4:integer;
+  {used to save global variables when deleting tokens}
+@!t:boolean;
+begin if history<error_message_issued then history:=error_message_issued;
+print_char("."); 
+callback_id := callback_defined(show_error_hook_callback) ;
+if callback_id>0 then t := run_callback(callback_id,'->');
+show_context;
+if interaction=error_stop_mode then @<Get user's advice and |return|@>;
+incr(error_count);
+if error_count=100 then
+  begin print_nl("(That makes 100 errors; please try again.)");
+@.That makes 100 errors...@>
+  history:=fatal_error_stop; jump_out;
+  end;
+@<Put help message on the transcript file@>;
+exit:end;
+
+@ @<Get user's advice...@>=
+loop@+begin continue: clear_for_error_prompt; prompt_input("? ");
+@.?\relax@>
+  if last=first then return;
+  c:=buffer[first];
+  if c>="a" then c:=c+"A"-"a"; {convert to uppercase}
+  @<Interpret code |c| and |return| if done@>;
+  end
+
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \TeX\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out the name of the
+file that should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines haven't
+been commented~out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+  @<Delete \(c)|c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
+"E": if base_ptr>0 then
+  begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+  slow_print(input_stack[base_ptr].name_field);
+  print(" at line "); print_int(line);
+  interaction:=scroll_mode; jump_out;
+  end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+  end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+
+@ @<Print the menu...@>=
+begin print("Type <return> to proceed, S to scroll future error messages,");@/
+@.Type <return> to proceed...@>
+print_nl("R to run without stopping, Q to run quietly,");@/
+print_nl("I to insert something, ");
+if base_ptr>0 then print("E to edit your file,");
+if deletions_allowed then
+  print_nl("1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
+print_nl("H for help, X to quit.");
+end
+
+@ Here the author of \TeX\ apologizes for making use of the numerical
+relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings
+|batch_mode|, |nonstop_mode|, |scroll_mode|.
+@^Knuth, Donald Ervin@>
+
+@<Change the interaction...@>=
+begin error_count:=0; interaction:=batch_mode+c-"Q";
+print("OK, entering ");
+case c of
+"Q":begin print_esc("batchmode"); decr(selector);
+  end;
+"R":print_esc("nonstopmode");
+"S":print_esc("scrollmode");
+end; {there are no other cases}
+print("..."); print_ln; update_terminal; return;
+end
+
+@ When the following code is executed, |buffer[(first+1)..(last-1)]| may
+contain the material inserted by the user; otherwise another prompt will
+be given. In order to understand this part of the program fully, you need
+to be familiar with \TeX's input stacks.
+
+@<Introduce new material...@>=
+begin begin_file_reading; {enter a new syntactic level for terminal input}
+{now |state=mid_line|, so an initial blank space will count as a blank}
+if last>first+1 then
+  begin loc:=first+1; buffer[first]:=" ";
+  end
+else  begin prompt_input("insert>"); loc:=first;
+@.insert>@>
+  end;
+first:=last;
+cur_input.limit_field:=last-1; {no |end_line_char| ends this line}
+return;
+end
+
+@ We allow deletion of up to 99 tokens at a time.
+
+@<Delete \(c)|c-"0"| tokens...@>=
+begin s1:=cur_tok; s2:=cur_cmd; s3:=cur_chr; s4:=align_state;
+align_state:=1000000; OK_to_interrupt:=false;
+if (last>first+1) and (buffer[first+1]>="0")and(buffer[first+1]<="9") then
+  c:=c*10+buffer[first+1]-"0"*11
+else c:=c-"0";
+while c>0 do
+  begin get_token; {one-level recursive call of |error| is possible}
+  decr(c);
+  end;
+cur_tok:=s1; cur_cmd:=s2; cur_chr:=s3; align_state:=s4; OK_to_interrupt:=true;
+help2("I have just deleted some text, as you asked.")@/
+("You can now delete more, or insert, or whatever.");
+show_context; goto continue;
+end
+
+@ @<Print the help info...@>=
+begin if use_err_help then
+  begin give_err_help; use_err_help:=false;
+  end
+else  begin if help_ptr=0 then
+    help2("Sorry, I don't know how to help in this situation.")@/
+    @t\kern1em@>("Maybe you should try asking a human?");
+  repeat decr(help_ptr); print(help_line[help_ptr]); print_ln;
+  until help_ptr=0;
+  end;
+help4("Sorry, I already gave what help I could...")@/
+  ("Maybe you should try asking a human?")@/
+  ("An error might have occurred before I noticed any problems.")@/
+  ("``If all else fails, read the instructions.''");@/
+goto continue;
+end
+
+@ @<Put help message on the transcript file@>=
+if interaction>batch_mode then decr(selector); {avoid terminal output}
+if use_err_help then
+  begin print_ln; give_err_help;
+  end
+else while help_ptr>0 do
+  begin decr(help_ptr); print_nl(help_line[help_ptr]);
+  end;
+print_ln;
+if interaction>batch_mode then incr(selector); {re-enable terminal output}
+print_ln
+
+@ A dozen or so error messages end with a parenthesized integer, so we
+save a teeny bit of program space by declaring the following procedure:
+
+@p procedure int_error(@!n:integer);
+begin print(" ("); print_int(n); print_char(")"); error;
+end;
+
+@ In anomalous cases, the print selector might be in an unknown state;
+the following subroutine is called to fix things just enough to keep
+running a bit longer.
+
+@p procedure normalize_selector;
+begin if log_opened then selector:=term_and_log
+else selector:=term_only;
+if job_name=0 then open_log_file;
+if interaction=batch_mode then decr(selector);
+end;
+
+@ The following procedure prints \TeX's last words before dying.
+
+@d succumb==begin if interaction=error_stop_mode then
+    interaction:=scroll_mode; {no more interaction}
+  if log_opened then error;
+  @!debug if interaction>batch_mode then debug_help;@+gubed@;@/
+  history:=fatal_error_stop; jump_out; {irrecoverable error}
+  end
+
+@<Error hand...@>=
+procedure fatal_error(@!s:str_number); {prints |s|, and that's it}
+begin normalize_selector;@/
+print_err("Emergency stop"); help1(s); succumb;
+@.Emergency stop@>
+end;
+
+@ Here is the most dreaded error message.
+
+@<Error hand...@>=
+procedure lua_norm_error(@!s:str_number); {lua found a problem}
+begin
+print_err("LuaTeX error "); print(s);
+help2("The lua interpreter ran into a problem, so the")@/
+  ("remainder of this lua chunk will be ignored.");
+error;
+end;
+
+procedure lua_fatal_error(@!s:str_number); {lua found a problem}
+begin normalize_selector;
+print_err("LuaTeX fatal error "); print(s);
+succumb;
+end;
+
+procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness}
+begin normalize_selector;
+print_err("TeX capacity exceeded, sorry [");
+@.TeX capacity exceeded ...@>
+print(s); print_char("="); print_int(n); print_char("]");
+help2("If you really absolutely need more capacity,")@/
+  ("you can ask a wizard to enlarge me.");
+succumb;
+end;
+
+procedure overflow_ocp_buf_size;
+begin
+overflow("ocp_buf_size",ocp_buf_size);
+end;
+
+procedure overflow_ocp_stack_size;
+begin
+overflow("ocp_stack_size",ocp_stack_size);
+end;
+
+
+@ The program might sometime run completely amok, at which point there is
+no choice but to stop. If no previous error has been detected, that's bad
+news; a message is printed that is really intended for the \TeX\
+maintenance person instead of the user (unless the user has been
+particularly diabolical).  The index entries for `this can't happen' may
+help to pinpoint the problem.
+@^dry rot@>
+
+@<Error hand...@>=
+procedure confusion(@!s:str_number);
+  {consistency check violated; |s| tells where}
+begin normalize_selector;
+if history<error_message_issued then
+  begin print_err("This can't happen ("); print(s); print_char(")");
+@.This can't happen@>
+  help1("I'm broken. Please show this to someone who can fix can fix");
+  end
+else  begin print_err("I can't go on meeting you like this");
+@.I can't go on...@>
+  help2("One of your faux pas seems to have wounded me deeply...")@/
+    ("in fact, I'm barely conscious. Please fix it and try again.");
+  end;
+succumb;
+end;
+
+@ Users occasionally want to interrupt \TeX\ while it's running.
+If the \PASCAL\ runtime system allows this, one can implement
+a routine that sets the global variable |interrupt| to some nonzero value
+when such an interrupt is signalled. Otherwise there is probably at least
+a way to make |interrupt| nonzero using the \PASCAL\ debugger.
+@^system dependencies@>
+@^debugging@>
+
+@<Global...@>=
+@!interrupt:integer; {should \TeX\ pause for instructions?}
+@!OK_to_interrupt:boolean; {should interrupts be observed?}
+@!detokenized_line:boolean; {indicates this is a 'detokenized' input line }
+@!line_catcode_table:integer; {the used catcode table for input lines}
+@!local_catcode_table:boolean; {the used catcode table for input lines}
+@!static_int_base:integer; {C version of |int_base|}
+
+@ @p procedure check_interrupt;
+begin 
+if interrupt<>0 then pause_for_instructions;
+end;
+
+
+@ @<Set init...@>=
+interrupt:=0; OK_to_interrupt:=true; detokenized_line:=false;
+line_catcode_table:=0; local_catcode_table:=false;
+
+@ When an interrupt has been detected, the program goes into its
+highest interaction level and lets the user have nearly the full flexibility of
+the |error| routine.  \TeX\ checks for interrupts only at times when it is
+safe to do this.
+
+@p procedure pause_for_instructions;
+begin if OK_to_interrupt then
+  begin interaction:=error_stop_mode;
+  if (selector=log_only)or(selector=no_print) then
+    incr(selector);
+  print_err("Interruption");
+@.Interruption@>
+  help3("You rang?")@/
+  ("Try to insert some instructions for me (e.g.,`I\showlists'),")@/
+  ("unless you just want to quit by typing `X'.");
+  deletions_allowed:=false; error; deletions_allowed:=true;
+  interrupt:=0;
+  end;
+end;
+
+@* \[7] Arithmetic with scaled dimensions.
+The principal computations performed by \TeX\ are done entirely in terms of
+integers less than $2^{31}$ in magnitude; and divisions are done only when both
+dividend and divisor are nonnegative. Thus, the arithmetic specified in this
+program can be carried out in exactly the same way on a wide variety of
+computers, including some small ones. Why? Because the arithmetic
+calculations need to be spelled out precisely in order to guarantee that
+\TeX\ will produce identical output on different machines. If some
+quantities were rounded differently in different implementations, we would
+find that line breaks and even page breaks might occur in different places.
+Hence the arithmetic of \TeX\ has been designed with care, and systems that
+claim to be implementations of \TeX82 should follow precisely the
+@:TeX82}{\TeX82@>
+calculations as they appear in the present program.
+
+(Actually there are three places where \TeX\ uses |div| with a possibly negative
+numerator. These are harmless; see |div| in the index. Also if the user
+sets the \.{\\time} or the \.{\\year} to a negative value, some diagnostic
+information will involve negative-numerator division. The same remarks
+apply for |mod| as well as for |div|.)
+
+@ Here is a routine that calculates half of an integer, using an
+unambiguous convention with respect to signed odd numbers.
+
+@p function half(@!x:integer):integer;
+begin if odd(x) then half:=(x+1) div 2
+else half:=x @!div 2;
+end;
+
+@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples
+of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit
+positions from the right end of a binary computer word.
+
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+@d two == @'400000 {$2^{17}$, represents 2.00000}
+
+@<Types...@>=
+@!scaled = integer; {this type is used for scaled integers}
+@!nonnegative_integer=0..@'17777777777; {$0\L x<2^{31}$}
+@!small_number=0..63; {this type is self-explanatory}
+
+@ The following function is used to create a scaled integer from a given decimal
+fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is
+given in |dig[i]|, and the calculation produces a correctly rounded result.
+
+@p function round_decimals(@!k:small_number) : scaled;
+  {converts a decimal fraction}
+var a:integer; {the accumulator}
+begin a:=0;
+while k>0 do
+  begin decr(k); a:=(a+dig[k]*two) div 10;
+  end;
+round_decimals:=(a+1) div 2;
+end;
+
+@ Conversely, here is a procedure analogous to |print_int|. If the output
+of this procedure is subsequently read by \TeX\ and converted by the
+|round_decimals| routine above, it turns out that the original value will
+be reproduced exactly; the ``simplest'' such decimal number is output,
+but there is always at least one digit following the decimal point.
+
+The invariant relation in the \&{repeat} loop is that a sequence of
+decimal digits yet to be printed will yield the original number if and only if
+they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
+We can stop if and only if $f=0$ satisfies this condition; the loop will
+terminate before $s$ can possibly become zero.
+
+@p procedure print_scaled(@!s:scaled); {prints scaled real, rounded to five
+  digits}
+var delta:scaled; {amount of allowable inaccuracy}
+begin if s<0 then
+  begin print_char("-"); negate(s); {print the sign, if negative}
+  end;
+print_int(s div unity); {print the integer part}
+print_char(".");
+s:=10*(s mod unity)+5; delta:=10;
+repeat if delta>unity then s:=s+@'100000-50000; {round the last digit}
+print_char("0"+(s div unity)); s:=10*(s mod unity); delta:=delta*10;
+until s<=delta;
+end;
+
+@ Physical sizes that a \TeX\ user specifies for portions of documents are
+represented internally as scaled points. Thus, if we define an `sp' (scaled
+@^sp@>
+point) as a unit equal to $2^{-16}$ printer's points, every dimension
+inside of \TeX\ is an integer number of sp. There are exactly
+4,736,286.72 sp per inch.  Users are not allowed to specify dimensions
+larger than $2^{30}-1$ sp, which is a distance of about 18.892 feet (5.7583
+meters); two such quantities can be added without overflow on a 32-bit
+computer.
+
+The present implementation of \TeX\ does not check for overflow when
+@^Overflow in arithmetic@>
+dimensions are added or subtracted. This could be done by inserting a
+few dozen tests of the form `\ignorespaces|if x>=@'10000000000 then
+@t\\{report\_overflow}@>|', but the chance of overflow is so remote that
+such tests do not seem worthwhile.
+
+\TeX\ needs to do only a few arithmetic operations on scaled quantities,
+other than addition and subtraction, and the following subroutines do most of
+the work. A single computation might use several subroutine calls, and it is
+desirable to avoid producing multiple error messages in case of arithmetic
+overflow; so the routines set the global variable |arith_error| to |true|
+instead of reporting errors directly to the user. Another global variable,
+|remainder|, holds the remainder after a division.
+
+@<Glob...@>=
+@!arith_error:boolean; {has arithmetic overflow occurred recently?}
+@!remainder:scaled; {amount subtracted to get an exact division}
+
+@ The first arithmetical subroutine we need computes $nx+y$, where |x|
+and~|y| are |scaled| and |n| is an integer. We will also use it to
+multiply integers.
+
+@d nx_plus_y(#)==mult_and_add(#,@'7777777777)
+@d mult_integers(#)==mult_and_add(#,0,@'17777777777)
+
+@p function mult_and_add(@!n:integer;@!x,@!y,@!max_answer:scaled):scaled;
+begin if n<0 then
+  begin negate(x); negate(n);
+  end;
+if n=0 then mult_and_add:=y
+else if ((x<=(max_answer-y) div n)and(-x<=(max_answer+y) div n)) then
+  mult_and_add:=n*x+y
+else  begin arith_error:=true; mult_and_add:=0;
+  end;
+end;
+
+@ We also need to divide scaled dimensions by integers.
+
+@p function x_over_n(@!x:scaled;@!n:integer):scaled;
+var negative:boolean; {should |remainder| be negated?}
+begin negative:=false;
+if n=0 then
+  begin arith_error:=true; x_over_n:=0; remainder:=x;
+  end
+else  begin if n<0 then
+    begin negate(x); negate(n); negative:=true;
+    end;
+  if x>=0 then
+    begin x_over_n:=x div n; remainder:=x mod n;
+    end
+  else  begin x_over_n:=-((-x) div n); remainder:=-((-x) mod n);
+    end;
+  end;
+if negative then negate(remainder);
+end;
+
+@ Then comes the multiplication of a scaled number by a fraction |n/d|,
+where |n| and |d| are nonnegative integers |<=@t$2^{16}$@>| and |d| is
+positive. It would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur; and it
+would be too inaccurate to divide by |d| and then multiply by |n|. Hence
+this subroutine simulates 1.5-precision arithmetic.
+
+@p function xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
+var positive:boolean; {was |x>=0|?}
+@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
+begin if x>=0 then positive:=true
+else  begin negate(x); positive:=false;
+  end;
+t:=(x mod @'100000)*n;
+u:=(x div @'100000)*n+(t div @'100000);
+v:=(u mod d)*@'100000 + (t mod @'100000);
+if u div d>=@'100000 then arith_error:=true
+else u:=@'100000*(u div d) + (v div d);
+if positive then
+  begin xn_over_d:=u; remainder:=v mod d;
+  end
+else  begin xn_over_d:=-u; remainder:=-(v mod d);
+  end;
+end;
+
+@ The next subroutine is used to compute the ``badness'' of glue, when a
+total~|t| is supposed to be made from amounts that sum to~|s|.  According
+to {\sl The \TeX book}, the badness of this situation is $100(t/s)^3$;
+however, badness is simply a heuristic, so we need not squeeze out the
+last drop of accuracy when computing it. All we really want is an
+approximation that has similar properties.
+@:TeXbook}{\sl The \TeX book@>
+
+The actual method used to compute the badness is easier to read from the
+program than to describe in words. It produces an integer value that is a
+reasonably close approximation to $100(t/s)^3$, and all implementations
+of \TeX\ should use precisely this method. Any badness of $2^{13}$ or more is
+treated as infinitely bad, and represented by 10000.
+
+It is not difficult to prove that $$\hbox{|badness(t+1,s)>=badness(t,s)
+>=badness(t,s+1)|}.$$ The badness function defined here is capable of
+computing at most 1095 distinct values, but that is plenty.
+
+@d inf_bad = 10000 {infinitely bad value}
+
+@p function badness(@!t,@!s:scaled):halfword; {compute badness, given |t>=0|}
+var r:integer; {approximation to $\alpha t/s$, where $\alpha^3\approx
+  100\cdot2^{18}$}
+begin if t=0 then badness:=0
+else if s<=0 then badness:=inf_bad
+else  begin if t<=7230584 then  r:=(t*297) div s {$297^3=99.94\times2^{18}$}
+  else if s>=1663497 then r:=t div (s div 297)
+  else r:=t;
+  if r>1290 then badness:=inf_bad {$1290^3<2^{31}<1291^3$}
+  else badness:=(r*r*r+@'400000) div @'1000000;
+  end; {that was $r^3/2^{18}$, rounded to the nearest integer}
+end;
+
+@ When \TeX\ ``packages'' a list into a box, it needs to calculate the
+proportionality ratio by which the glue inside the box should stretch
+or shrink. This calculation does not affect \TeX's decision making,
+so the precise details of rounding, etc., in the glue calculation are not
+of critical importance for the consistency of results on different computers.
+
+We shall use the type |glue_ratio| for such proportionality ratios.
+A glue ratio should take the same amount of memory as an
+|integer| (usually 32 bits) if it is to blend smoothly with \TeX's
+other data structures. Thus |glue_ratio| should be equivalent to
+|short_real| in some implementations of \PASCAL. Alternatively,
+it is possible to deal with glue ratios using nothing but fixed-point
+arithmetic; see {\sl TUGboat \bf3},1 (March 1982), 10--27. (But the
+routines cited there must be modified to allow negative glue ratios.)
+@^system dependencies@>
+
+@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
+@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
+@d float(#) == # {convert from |glue_ratio| to type |real|}
+@d unfloat(#) == # {convert from |real| to type |glue_ratio|}
+@d float_constant(#) == #.0 {convert |integer| constant to |real|}
+
+@<Types...@>=
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+
+@* \[7b] Random numbers.
+
+\font\tenlogo=logo10 % font used for the METAFONT logo
+\def\MP{{\tenlogo META}\-{\tenlogo POST}}
+
+This section is (almost) straight from MetaPost. I had to change
+the types (use |integer| instead of |fraction|), but that should
+not have any influence on the actual calculations (the original
+comments refer to quantities like |fraction_four| ($2^{30}$), and
+that is the same as the numeric representation of |maxdimen|).
+
+I've copied the low-level variables and routines that are needed, but
+only those (e.g. |m_log|), not the accompanying ones like |m_exp|. Most
+of the following low-level numeric routines are only needed within the
+calculation of |norm_rand|. I've been forced to rename |make_fraction|
+to |make_frac| because TeX already has a routine by that name with
+a wholly different function (it creates a |fraction_noad| for math
+typesetting) -- Taco
+
+And now let's complete our collection of numeric utility routines
+by considering random number generation.
+\MP\ generates pseudo-random numbers with the additive scheme recommended
+in Section 3.6 of {\sl The Art of Computer Programming}; however, the
+results are random fractions between 0 and |fraction_one-1|, inclusive.
+
+There's an auxiliary array |randoms| that contains 55 pseudo-random
+fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
+we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
+The global variable |j_random| tells which element has most recently
+been consumed.
+
+@<Glob...@>=
+@!randoms:array[0..54] of integer; {the last 55 random values generated}
+@!j_random:0..54; {the number of unused |randoms|}
+@!random_seed:scaled; {the default random seed}
+
+@ A small bit of metafont is needed.
+
+@d fraction_half==@'1000000000 {$2^{27}$, represents 0.50000000}
+@d fraction_one==@'2000000000 {$2^{28}$, represents 1.00000000}
+@d fraction_four==@'10000000000 {$2^{30}$, represents 4.00000000}
+@d el_gordo == @'17777777777 {$2^{31}-1$, the largest value that \MP\ likes}
+@d halfp(#)==(#) div 2
+@d double(#) == #:=#+# {multiply a variable by two}
+
+@ The |make_frac| routine produces the |fraction| equivalent of
+|p/q|, given integers |p| and~|q|; it computes the integer
+$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are
+positive. If |p| and |q| are both of the same scaled type |t|,
+the ``type relation'' |make_frac(t,t)=fraction| is valid;
+and it's also possible to use the subroutine ``backwards,'' using
+the relation |make_frac(t,fraction)=t| between scaled types.
+
+If the result would have magnitude $2^{31}$ or more, |make_frac|
+sets |arith_error:=true|. Most of \MP's internal computations have
+been designed to avoid this sort of error.
+
+If this subroutine were programmed in assembly language on a typical
+machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a
+double-precision product can often be input to a fixed-point division
+instruction. But when we are restricted to \PASCAL\ arithmetic it
+is necessary either to resort to multiple-precision maneuvering
+or to use a simple but slow iteration. The multiple-precision technique
+would be about three times faster than the code adopted here, but it
+would be comparatively long and tricky, involving about sixteen
+additional multiplications and divisions.
+
+This operation is part of \MP's ``inner loop''; indeed, it will
+consume nearly 10\pct! of the running time (exclusive of input and output)
+if the code below is left unchanged. A machine-dependent recoding
+will therefore make \MP\ run faster. The present implementation
+is highly portable, but slow; it avoids multiplication and division
+except in the initial stage. System wizards should be careful to
+replace it with a routine that is guaranteed to produce identical
+results in all cases.
+@^system dependencies@>
+
+As noted below, a few more routines should also be replaced by machine-dependent
+code, for efficiency. But when a procedure is not part of the ``inner loop,''
+such changes aren't advisable; simplicity and robustness are
+preferable to trickery, unless the cost is too high.
+@^inner loop@>
+
+@p function make_frac(@!p,@!q:integer):integer;
+var @!f:integer; {the fraction bits, with a leading 1 bit}
+@!n:integer; {the integer part of $\vert p/q\vert$}
+@!negative:boolean; {should the result be negated?}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin if p>=0 then negative:=false
+else  begin negate(p); negative:=true;
+  end;
+if q<=0 then
+  begin debug if q=0 then confusion("/");@;@+gubed@;@/
+@:this can't happen /}{\quad \./@>
+  negate(q); negative:=not negative;
+  end;
+n:=p div q; p:=p mod q;
+if n>=8 then
+  begin arith_error:=true;
+  if negative then make_frac:=-el_gordo@+else make_frac:=el_gordo;
+  end
+else  begin n:=(n-1)*fraction_one;
+  @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>;
+  if negative then make_frac:=-(f+n)@+else make_frac:=f+n;
+  end;
+end;
+
+@ The |repeat| loop here preserves the following invariant relations
+between |f|, |p|, and~|q|:
+(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and
+$p_0$ is the original value of~$p$.
+
+Notice that the computation specifies
+|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow.
+Let us hope that optimizing compilers do not miss this point; a
+special variable |be_careful| is used to emphasize the necessary
+order of computation. Optimizing compilers should keep |be_careful|
+in a register, not store it in memory.
+@^inner loop@>
+
+@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>=
+f:=1;
+repeat be_careful:=p-q; p:=be_careful+p;
+if p>=0 then f:=f+f+1
+else  begin double(f); p:=p+q;
+  end;
+until f>=fraction_one;
+be_careful:=p-q;
+if be_careful+p>=0 then incr(f)
+
+@
+
+@p function take_frac(@!q:integer;@!f:integer):integer;
+var @!p:integer; {the fraction so far}
+@!negative:boolean; {should the result be negated?}
+@!n:integer; {additional multiple of $q$}
+@!be_careful:integer; {disables certain compiler optimizations}
+begin @<Reduce to the case that |f>=0| and |q>0|@>;
+if f<fraction_one then n:=0
+else  begin n:=f div fraction_one; f:=f mod fraction_one;
+  if q<=el_gordo div n then n:=n*q
+  else  begin arith_error:=true; n:=el_gordo;
+    end;
+  end;
+f:=f+fraction_one;
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>;
+be_careful:=n-el_gordo;
+if be_careful+p>0 then
+  begin arith_error:=true; n:=el_gordo-p;
+  end;
+if negative then take_frac:=-(n+p)
+else take_frac:=n+p;
+end;
+
+@ @<Reduce to the case that |f>=0| and |q>0|@>=
+if f>=0 then negative:=false
+else  begin negate(f); negative:=true;
+  end;
+if q<0 then
+  begin negate(q); negative:=not negative;
+  end;
+
+@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor
+=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and
+$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$.
+@^inner loop@>
+
+@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>=
+p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$}
+if q<fraction_four then
+  repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p);
+  f:=halfp(f);
+  until f=1
+else  repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p);
+  f:=halfp(f);
+  until f=1
+
+@ The subroutines for logarithm and exponential involve two tables.
+The first is simple: |two_to_the[k]| equals $2^k$. The second involves
+a bit more calculation, which the author claims to have done correctly:
+|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)=
+2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the
+nearest integer.
+
+@<Glob...@>=
+@!two_to_the:array[0..30] of integer; {powers of two}
+@!spec_log:array[1..28] of integer; {special logarithms}
+
+
+@ @<Set init...@>=
+two_to_the[0]:=1;
+for k:=1 to 30 do two_to_the[k]:=2*two_to_the[k-1];
+spec_log[1]:=93032640;
+spec_log[2]:=38612034;
+spec_log[3]:=17922280;
+spec_log[4]:=8662214;
+spec_log[5]:=4261238;
+spec_log[6]:=2113709;
+spec_log[7]:=1052693;
+spec_log[8]:=525315;
+spec_log[9]:=262400;
+spec_log[10]:=131136;
+spec_log[11]:=65552;
+spec_log[12]:=32772;
+spec_log[13]:=16385;
+for k:=14 to 27 do spec_log[k]:=two_to_the[27-k];
+spec_log[28]:=1;
+
+@
+
+@p function m_log(@!x:integer):integer;
+var @!y,@!z:integer; {auxiliary registers}
+@!k:integer; {iteration counter}
+begin if x<=0 then @<Handle non-positive logarithm@>
+else  begin y:=1302456956+4-100; {$14\times2^{27}\ln2\approx1302456956.421063$}
+  z:=27595+6553600; {and $2^{16}\times .421063\approx 27595$}
+  while x<fraction_four do
+    begin double(x); y:=y-93032639; z:=z-48782;
+    end; {$2^{27}\ln2\approx 93032639.74436163$
+      and $2^{16}\times.74436163\approx 48782$}
+  y:=y+(z div unity); k:=2;
+  while x>fraction_four+4 do
+    @<Increase |k| until |x| can be multiplied by a
+      factor of $2^{-k}$, and adjust $y$ accordingly@>;
+  m_log:=y div 8;
+  end;
+end;
+
+@ @<Increase |k| until |x| can...@>=
+begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$}
+while x<fraction_four+z do
+  begin z:=halfp(z+1); k:=k+1;
+  end;
+y:=y+spec_log[k]; x:=x-z;
+end
+
+@ @<Handle non-positive logarithm@>=
+begin print_err("Logarithm of ");
+@.Logarithm...replaced by 0@>
+print_scaled(x); print(" has been replaced by 0");
+help2("Since I don't take logs of non-positive numbers,")@/
+  ("I'm zeroing this one. Proceed, with fingers crossed.");
+error; m_log:=0;
+end
+
+@ The following somewhat different subroutine tests rigorously if $ab$ is
+greater than, equal to, or less than~$cd$,
+given integers $(a,b,c,d)$. In most cases a quick decision is reached.
+The result is $+1$, 0, or~$-1$ in the three respective cases.
+
+@d return_sign(#)==begin ab_vs_cd:=#; return;
+  end
+
+@p function ab_vs_cd(@!a,b,c,d:integer):integer;
+label exit;
+var @!q,@!r:integer; {temporary registers}
+begin @<Reduce to the case that |a,c>=0|, |b,d>0|@>;
+loop@+  begin q := a div d; r := c div b;
+  if q<>r then
+    if q>r then return_sign(1)@+else return_sign(-1);
+  q := a mod d; r := c mod b;
+  if r=0 then
+    if q=0 then return_sign(0)@+else return_sign(1);
+  if q=0 then return_sign(-1);
+  a:=b; b:=q; c:=d; d:=r;
+  end; {now |a>d>0| and |c>b>0|}
+exit:end;
+
+@ @<Reduce to the case that |a...@>=
+if a<0 then
+  begin negate(a); negate(b);
+  end;
+if c<0 then
+  begin negate(c); negate(d);
+  end;
+if d<=0 then
+  begin if b>=0 then
+    if ((a=0)or(b=0))and((c=0)or(d=0)) then return_sign(0)
+    else return_sign(1);
+  if d=0 then
+    if a=0 then return_sign(0)@+else return_sign(-1);
+  q:=a; a:=c; c:=q; q:=-b; b:=-d; d:=q;
+  end
+else if b<=0 then
+  begin if b<0 then if a>0 then return_sign(-1);
+  if c=0 then return_sign(0) else return_sign(-1);
+  end
+
+@ To consume a random integer, the program below will say `|next_random|'
+and then it will fetch |randoms[j_random]|.
+
+@d next_random==if j_random=0 then new_randoms
+  else decr(j_random)
+
+@p procedure new_randoms;
+var @!k:0..54; {index into |randoms|}
+@!x:integer; {accumulator}
+begin for k:=0 to 23 do
+  begin x:=randoms[k]-randoms[k+31];
+  if x<0 then x:=x+fraction_one;
+  randoms[k]:=x;
+  end;
+for k:=24 to 54 do
+  begin x:=randoms[k]-randoms[k-24];
+  if x<0 then x:=x+fraction_one;
+  randoms[k]:=x;
+  end;
+j_random:=54;
+end;
+
+@ To initialize the |randoms| table, we call the following routine.
+
+@p procedure init_randoms(@!seed:integer);
+var @!j,@!jj,@!k:integer; {more or less random integers}
+@!i:0..54; {index into |randoms|}
+begin j:=abs(seed);
+while j>=fraction_one do j:=halfp(j);
+k:=1;
+for i:=0 to 54 do
+  begin jj:=k; k:=j-k; j:=jj;
+  if k<0 then k:=k+fraction_one;
+  randoms[(i*21)mod 55]:=j;
+  end;
+new_randoms; new_randoms; new_randoms; {``warm up'' the array}
+end;
+
+@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
+or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
+
+Note that the call of |take_frac| will produce the values 0 and~|x|
+with about half the probability that it will produce any other particular
+values between 0 and~|x|, because it rounds its answers.
+
+@p function unif_rand(@!x:integer):integer;
+var @!y:integer; {trial value}
+begin next_random; y:=take_frac(abs(x),randoms[j_random]);
+if y=abs(x) then unif_rand:=0
+else if x>0 then unif_rand:=y
+else unif_rand:=-y;
+end;
+
+@ Finally, a normal deviate with mean zero and unit standard deviation
+can readily be obtained with the ratio method (Algorithm 3.4.1R in
+{\sl The Art of Computer Programming\/}).
+
+@p function norm_rand:integer;
+var @!x,@!u,@!l:integer; {what the book would call $2^{16}X$, $2^{28}U$,
+  and $-2^{24}\ln U$}
+begin repeat
+  repeat next_random;
+  x:=take_frac(112429,randoms[j_random]-fraction_half);
+    {$2^{16}\sqrt{8/e}\approx 112428.82793$}
+  next_random; u:=randoms[j_random];
+  until abs(x)<u;
+x:=make_frac(x,u);
+l:=139548960-m_log(u); {$2^{24}\cdot12\ln2\approx139548959.6165$}
+until ab_vs_cd(1024,l,x,x)>=0;
+norm_rand:=x;
+end;
+
+@* \[8] Packed data.
+In order to make efficient use of storage space, \TeX\ bases its major data
+structures on a |memory_word|, which contains either a (signed) integer,
+possibly scaled, or a (signed) |glue_ratio|, or a small number of
+fields that are one half or one quarter of the size used for storing
+integers.
+
+If |x| is a variable of type |memory_word|, it contains up to four
+fields that can be referred to as follows:
+$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr
+|x|&.|int|&(an |integer|)\cr
+|x|&.|sc|\qquad&(a |scaled| integer)\cr
+|x|&.|gr|&(a |glue_ratio|)\cr
+|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr
+|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword
+  field)\cr
+|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt
+  &\qquad\qquad\qquad(four quarterword fields)\cr}}$$
+This is somewhat cumbersome to write, and not very readable either, but
+macros will be used to make the notation shorter and more transparent.
+The \PASCAL\ code below gives a formal definition of |memory_word| and
+its subsidiary types, using packed variant records. \TeX\ makes no
+assumptions about the relative positions of the fields within a word.
+
+We are assuming 32-bit integers, a halfword must contain at least
+32 bits, and a quarterword must contain at least 16 bits.
+@^system dependencies@>
+
+N.B.: Valuable memory space will be dreadfully wasted unless \TeX\ is compiled
+by a \PASCAL\ that packs all of the |memory_word| variants into
+the space of a single integer. This means, for example, that |glue_ratio|
+words should be |short_real| instead of |real| on some computers. Some
+\PASCAL\ compilers will pack an integer whose subrange is `|0..255|' into
+an eight-bit field, but others insist on allocating space for an additional
+sign bit; on such systems you can get 256 values into a quarterword only
+if the subrange is `|-128..127|'.
+
+The present implementation tries to accommodate as many variations as possible,
+so it makes few assumptions. If integers having the subrange
+`|min_quarterword..max_quarterword|' can be packed into a quarterword,
+and if integers having the subrange `|min_halfword..max_halfword|'
+can be packed into a halfword, everything should work satisfactorily.
+
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+We cannot use the full range of 32 bits in a halfword, because we have
+to allow negative values for potential backend tricks like web2c's
+dynamic allocation, and parshapes pointers have to be able to store at
+least twice the value |max_halfword| (see below). Therefore,
+|max_halfword| is $2^{30}-1$
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=65535 {largest allowable value in a |quarterword|}
+@d min_halfword==-@"3FFFFFFF {smallest allowable value in a |halfword|}
+@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
+
+@ Here are the inequalities that the quarterword and halfword values
+must satisfy (or rather, the inequalities that they mustn't satisfy):
+
+@<Check the ``constant''...@>=
+if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11;
+if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12;
+if (min_quarterword<min_halfword)or@|
+  (max_quarterword>max_halfword) then bad:=13;
+if font_base<min_quarterword then bad:=15;
+if (save_size>max_halfword)or(max_strings>max_halfword) then bad:=17;
+if buf_size>max_halfword then bad:=18;
+if max_quarterword-min_quarterword<@"FFFF then bad:=19;
+
+@ The operation of adding or subtracting |min_quarterword| occurs quite
+frequently in \TeX, so it is convenient to abbreviate this operation
+by using the macros |qi| and |qo| for input and output to and from
+quarterword format.
+
+The inner loop of \TeX\ will run faster with respect to compilers
+that don't optimize expressions like `|x+0|' and `|x-0|', if these
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+  {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+  {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+  {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+  {to take a sixteen-bit item from a halfword}
+
+@ The reader should study the following definitions closely:
+@^system dependencies@>
+
+@d sc==int {|scaled| data is equivalent to |integer|}
+
+@<Types...@>=
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!four_choices = 1..4; {used when there are four variants in a record}
+@!two_halves = packed record@;@/
+  @!rh:halfword;
+  case two_choices of
+  1: (@!lh:halfword);
+  2: (@!b0:quarterword; @!b1:quarterword);
+  end;
+@!four_quarters = packed record@;@/
+  @!b0:quarterword;
+  @!b1:quarterword;
+  @!b2:quarterword;
+  @!b3:quarterword;
+  end;
+@!memory_word = record@;@/
+  case four_choices of
+  1: (@!int:integer);
+  2: (@!gr:glue_ratio);
+  3: (@!hh:two_halves);
+  4: (@!qqqq:four_quarters);
+  end;
+@!word_file = file of memory_word;
+
+@ When debugging, we may want to print a |memory_word| without knowing
+what type it is; so we print it in all modes.
+@^dirty \PASCAL@>@^debugging@>
+
+@p @!debug procedure print_word(@!w:memory_word);
+  {prints |w| in all ways}
+begin print_int(w.int); print_char(" ");@/
+print_scaled(w.sc); print_char(" ");@/
+print_scaled(round(unity*float(w.gr))); print_ln;@/
+@^real multiplication@>
+print_int(w.hh.lh); print_char("="); print_int(w.hh.b0); print_char(":");
+print_int(w.hh.b1); print_char(";"); print_int(w.hh.rh); print_char(" ");@/
+print_int(w.qqqq.b0); print_char(":"); print_int(w.qqqq.b1); print_char(":");
+print_int(w.qqqq.b2); print_char(":"); print_int(w.qqqq.b3);
+end;
+gubed
+
+@* \[9] Dynamic memory allocation.
+The \TeX\ system does nearly all of its own memory allocation, so that it
+can readily be transported into environments that do not have automatic
+facilities for strings, garbage collection, etc., and so that it can be in
+control of what error messages the user receives. The dynamic storage
+requirements of \TeX\ are handled by providing two large arrays called
+|fixmem| and |varmem| in which consecutive blocks of words are used as 
+nodes by the \TeX\ routines.
+
+Pointer variables are indices into this array, or into another array
+called |eqtb| that will be explained later. A pointer variable might
+also be a special flag that lies outside the bounds of |mem|, so we
+allow pointers to assume any |halfword| value. The minimum halfword
+value represents a null pointer. \TeX\ does not assume that |mem[null]| exists.
+
+@d pointer==halfword {a flag or a location in |mem| or |eqtb|}
+@d null==0 {the null pointer}
+
+@<Glob...@>=
+@!temp_ptr:pointer; {a pointer variable for occasional emergency use}
+
+@ @<Types...@>=
+@!smemory_word = packed record@;@/
+  @!hhrh:halfword;
+  @!hhlh:halfword;
+  end;
+
+
+@ The |mem| array is divided into two items that are allocated separately; 
+they grow until finding their ``natural'' size in a particular job.
+Locations in |varmem| are used for storing variable-length records
+consisting of two or more words each. This region
+is maintained using an algorithm similar to the one described in exercise
+2.5--19 of {\sl The Art of Computer Programming}. However, no size field
+appears in the allocated nodes; the program is responsible for knowing the
+relevant size when a node is freed. Locations in |fixmem| are used for storing 
+one-word records; a conventional \.{AVAIL} stack is used for allocation 
+in this array.
+
+Empirical tests show that the present implementation of \TeX\ tends to
+spend about 9\pct! of its running time allocating nodes, and about 6\pct!
+deallocating them after their use.
+
+@d fix_mem_init==10000
+
+@<Glob...@>=
+@!fixmem : ^smemory_word; {the big dynamic storage area}
+@!fix_mem_min : pointer; {the smallest location of one-word memory in use}
+@!fix_mem_max : pointer; {the largest location of one-word memory in use}
+
+@ In order to study the memory requirements of particular applications, it
+is possible to prepare a version of \TeX\ that keeps track of current and
+maximum memory usage. When code between the delimiters |@!stat| $\ldots$
+|tats| is not ``commented out,'' \TeX\ will run a bit slower but it will
+report these statistics when |tracing_stats| is sufficiently large.
+
+@<Glob...@>=
+@!var_used, @!dyn_used : integer; {how much memory is in use}
+
+@ Let's consider the one-word memory region first, since it's the
+simplest. The pointer variable |fix_mem_end| holds the highest-numbered location
+of |mem| that has ever been used. The free locations of |mem| that
+occur between |hi_mem_min| and |fix_mem_end|, inclusive, are of type
+|two_halves|, and we write |info(p)| and |link(p)| for the |lh|
+and |rh| fields of |mem[p]| when it is of this type. The single-word
+free locations form a linked list
+$$|avail|,\;\hbox{|link(avail)|},\;\hbox{|link(link(avail))|},\;\ldots$$
+terminated by |null|.
+
+@d mem(#) == fixmem[#]
+@d link(#) == mem(#).hhrh {the |link| field of a memory word}
+@d info(#) == mem(#).hhlh {the |info| field of a memory word}
+
+@<Glob...@>=
+@!avail : pointer; {head of the list of available one-word nodes}
+@!fix_mem_end : pointer; {the last one-word node used in |mem|}
+
+@ If memory is exhausted, it might mean that the user has forgotten
+a right brace. We will define some procedures later that try to help
+pinpoint the trouble.
+
+@p @<Declare the procedure called |show_token_list|@>@/
+@<Declare the procedure called |runaway|@>
+
+@ The function |get_avail| returns a pointer to a new one-word node whose
+|link| field is null. However, \TeX\ will halt if there is no more room left.
+@^inner loop@>
+
+If the available-space list is empty, i.e., if |avail=null|,
+we try first to increase |fix_mem_end|. If that cannot be done, i.e., if
+|fix_mem_end=fix_mem_max|, we try to reallocate array |fixmem|. 
+If, that doesn't work, we have to quit.
+
+@p function get_avail : pointer; {single-word node allocation}
+var p:pointer; {the new node being got}
+t:integer;
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if fix_mem_end<fix_mem_max then {or go into virgin territory}
+  begin incr(fix_mem_end); p:=fix_mem_end;
+  end
+else  begin
+  t:=(fix_mem_max/5);
+  fixmem := fixmemcast(realloc(fixmem,sizeof(smemory_word)*(fix_mem_max+t+1)));
+  if fixmem=NULL then
+    begin runaway; {if memory is exhausted, display possible runaway text}
+    overflow("token memory size",fix_mem_max);
+      {quit; all one-word nodes are busy}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+    end;
+  memset (voidcast(fixmem+fix_mem_max+1),0,t*sizeof(smemory_word));
+  fix_mem_max:=fix_mem_max+t; incr(fix_mem_end); p:=fix_mem_end;
+  end;
+link(p):=null; {provide an oft-desired initialization of the new node}
+@!stat incr(dyn_used);@+tats@;{maintain statistics}
+get_avail:=p;
+end;
+
+@ Conversely, a one-word node is recycled by calling |free_avail|.
+This routine is part of \TeX's ``inner loop,'' so we want it to be fast.
+@^inner loop@>
+
+@d free_avail(#)== {single-word node liberation}
+  begin link(#):=avail; avail:=#;
+  @!stat decr(dyn_used);@+tats@/
+  end
+
+@ There's also a |fast_get_avail| routine, which saves the procedure-call
+overhead at the expense of extra programming. This routine is used in
+the places that would otherwise account for the most calls of |get_avail|.
+@^inner loop@>
+
+@d fast_get_avail(#)==@t@>@;@/
+  begin #:=avail; {avoid |get_avail| if possible, to save time}
+  if #=null then #:=get_avail
+  else  begin avail:=link(#); link(#):=null;
+    @!stat incr(dyn_used);@+tats@/
+    end;
+  end
+
+@ The procedure |flush_list(p)| frees an entire linked list of
+one-word nodes that starts at position |p|.
+@^inner loop@>
+
+@p procedure flush_list(@!p:pointer); {makes list of single-word nodes available}
+var @!q,@!r:pointer; {list traversers}
+begin if p<>null then
+  begin r:=p;
+  repeat q:=r; r:=link(r); @!stat decr(dyn_used);@+tats@/
+  until r=null; {now |q| is the last node on the list}
+  link(q):=avail; avail:=p;
+  end;
+end;
+
+@ The available-space list that keeps track of the variable-size portion
+of |mem| is a nonempty, doubly-linked circular list of empty nodes,
+pointed to by the roving pointer |rover|.
+
+@d temp_node==46
+@d temp_node_size==2
+@d vmem(#) == varmem[#]
+@d vlink(#) == vmem(#).hh.rh {the |link| field of a memory word}
+@d vinfo(#) == vmem(#).hh.lh {the |info| field of a memory word}
+@d alink(#) == vlink(#+1) {backlink in doubly-linked list of empty nodes}
+
+@* \[10] Data structures for boxes and their friends.
+From the computer's standpoint, \TeX's chief mission is to create
+horizontal and vertical lists. We shall now investigate how the elements
+of these lists are represented internally as nodes in the dynamic memory.
+
+A horizontal or vertical list is linked together by |link| fields in
+the first word of each node. Individual nodes represent boxes, glue,
+penalties, or special things like discretionary hyphens; because of this
+variety, some nodes are longer than others, and we must distinguish different
+kinds of nodes. We do this by putting a `|type|' field in the first word,
+together with the link and an optional `|subtype|'.
+
+@d type(#)    == vmem(#).hh.b0  {identifies what kind of node this is}
+@d subtype(#) == vmem(#).hh.b1 {secondary identification in some cases}
+
+@ TH: This module section is superceded.
+
+A |@!char_node|, which represents a single character, is the most important
+kind of node because it accounts for the vast majority of all boxes.
+Special precautions are therefore taken to ensure that a |char_node| does
+not take up much memory space. Every such node is one word long, and in fact
+it is identifiable by this property, since other kinds of nodes have at least
+two words, and they appear in |mem| locations less than |hi_mem_min|.
+This makes it possible to omit the |type| field in a |char_node|, leaving
+us room for two bytes that identify a |font| and a |character| within
+that font.
+
+Note that the format of a |char_node| allows for up to 256 different
+fonts and up to 256 characters per font; but most implementations will
+probably limit the total number of fonts to fewer than 75 per job,
+and most fonts will stick to characters whose codes are
+less than 128 (since higher codes
+are more difficult to access on most keyboards).
+
+Extensions of \TeX\ intended for oriental languages will need even more
+than $256\times256$ possible characters, when we consider different sizes
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+and styles of type.  It is suggested that Chinese and Japanese fonts be
+handled by representing such characters in two consecutive |char_node|
+entries: The first of these has |font=font_base|, and its |link| points
+to the second;
+the second identifies the font and the character dimensions.
+The saving feature about oriental characters is that most of them have
+the same box dimensions. The |character| field of the first |char_node|
+is a ``\\{charext}'' that distinguishes between graphic symbols whose
+dimensions are identical for typesetting purposes. (See the \MF\ manual.)
+Such an extension of \TeX\ would not be difficult; further details are
+left to the reader.
+
+In order to make sure that the |character| code fits in a quarterword,
+\TeX\ adds the quantity |min_quarterword| to the actual code.
+
+Character nodes appear only in horizontal lists, never in vertical lists.
+
+@ Attribute lists need two extra globals to increase processing efficiency.
+|max_used_attr| limits the test loop that checks for set attributes, and
+|attr_list_cache| contains a pointer to an already created attribute list.  It is
+set to the special value |cache_disabled| when the current value can no longer be
+trusted: after an assignment to an attribute register, and after a group has
+ended.
+
+@d cache_disabled==max_halfword
+ 
+@<Glob...@>=
+max_used_attr:integer; { maximum assigned attribute id }
+attr_list_cache:pointer;
+
+@ @<Set init...@>=
+max_used_attr:=-1; attr_list_cache:=cache_disabled;
+
+@ Attribute lists are maintained in C, but they need access to the current
+attributes in eqtb. 
+
+@p function get_attribute(i:halfword):halfword;
+begin
+  get_attribute := attribute(i);
+end;
+
+
+@ An |hlist_node| stands for a box that was made from a horizontal list.
+Each |hlist_node| is seven words long, and contains the following fields
+(in addition to the mandatory |type| and |link|, which we shall not
+mention explicitly when discussing the other node types): The |height| and
+|width| and |depth| are scaled integers denoting the dimensions of the
+box.  There is also a |shift_amount| field, a scaled integer indicating
+how much this box should be lowered (if it appears in a horizontal list),
+or how much it should be moved to the right (if it appears in a vertical
+list). There is a |list_ptr| field, which points to the beginning of the
+list from which this box was fabricated; if |list_ptr| is |null|, the box
+is empty. Finally, there are three fields that represent the setting of
+the glue:  |glue_set(p)| is a word of type |glue_ratio| that represents
+the proportionality constant for glue setting; |glue_sign(p)| is
+|stretching| or |shrinking| or |normal| depending on whether or not the
+glue should stretch or shrink or remain rigid; and |glue_order(p)|
+specifies the order of infinity to which glue setting applies (|normal|,
+|sfi|, |fil|, |fill|, or |filll|). The |subtype| field is not used.
+
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=8 {number of words to allocate for a box node}
+@d width_offset=2 {position of |width| field in a box node}
+@d depth_offset=3 {position of |depth| field in a box node}
+@d height_offset=4 {position of |height| field in a box node}
+@d width(#) == vmem(#+width_offset).sc {width of the box, in sp}
+@d depth(#) == vmem(#+depth_offset).sc {depth of the box, in sp}
+@d height(#) == vmem(#+height_offset).sc {height of the box, in sp}
+@d shift_amount(#) == vlink(#+5) {repositioning distance, in sp}
+@d box_dir(#) == vinfo(#+5) {position of |box_dir| in a box node}
+@d list_offset=6 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == vlink(#+list_offset) {beginning of the list inside the box}
+@d glue_order(#) == subtype(#+list_offset) {applicable order of infinity}
+@d glue_sign(#) == type(#+list_offset) {stretching or shrinking}
+@d normal=0 {the most common case when several cases are named}
+@d stretching = 1 {glue setting applies to the stretch components}
+@d shrinking = 2 {glue setting applies to the shrink components}
+@d glue_offset = 7 {position of |glue_set| in a box node}
+@d glue_set(#) == vmem(#+glue_offset).gr
+  {a word of type |glue_ratio| for glue setting}
+
+@ The |new_null_box| function returns a pointer to an |hlist_node| in
+which all subfields have the values corresponding to `\.{\\hbox\{\}}'.
+The |subtype| field is set to |min_quarterword|, since that's the desired
+|span_count| value if this |hlist_node| is changed to an |unset_node|.
+
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=new_node(hlist_node,min_quarterword);
+box_dir(p):=text_direction; 
+new_null_box:=p;
+end;
+
+@ A |vlist_node| is like an |hlist_node| in all respects except that it
+contains a vertical list.
+
+@d vlist_node=1 {|type| of vlist nodes}
+
+@ A |rule_node| stands for a solid black rectangle; it has |width|,
+|depth|, and |height| fields just as in an |hlist_node|. However, if
+any of these dimensions is $-2^{30}$, the actual value will be determined
+by running the rule up to the boundary of the innermost enclosing box.
+This is called a ``running dimension.'' The |width| is never running in
+an hlist; the |height| and |depth| are never running in a~vlist.
+
+@d rule_node=2 {|type| of rule nodes}
+@d rule_node_size=6 {number of words to allocate for a rule node}
+@d null_flag==-@'10000000000 {$-2^{30}$, signifies a missing item}
+@d is_running(#) == (#=null_flag) {tests for a running dimension}
+@d rule_dir(#)==vlink(#+5)
+
+@ A new rule node is delivered by the |new_rule| function. It
+makes all the dimensions ``running,'' so you have to change the
+ones that are not allowed to run.
+
+@p 
+function new_rule:pointer;
+var p:pointer; {the new node}
+begin p:=new_node(rule_node,0); {the |subtype| is not used}
+new_rule:=p;
+end;
+
+
+@ Insertions are represented by |ins_node| records, where the |subtype|
+indicates the corresponding box number. For example, `\.{\\insert 250}'
+leads to an |ins_node| whose |subtype| is |250+min_quarterword|.
+The |height| field of an |ins_node| is slightly misnamed; it actually holds
+the natural height plus depth of the vertical list being inserted.
+The |depth| field holds the |split_max_depth| to be used in case this
+insertion is split, and the |split_top_ptr| points to the corresponding
+|split_top_skip|. The |float_cost| field holds the |floating_penalty| that
+will be used if this insertion floats to a subsequent page after a
+split insertion of the same class.  There is one more field, the
+|ins_ptr|, which points to the beginning of the vlist for the insertion.
+
+@d ins_node=3 {|type| of insertion nodes}
+@d ins_node_size=6 {number of words to allocate for an insertion}
+@d float_cost(#)==vmem(#+2).int {the |floating_penalty| to be used}
+@d ins_ptr(#)==vinfo(#+5) {the vertical list to be inserted}
+@d split_top_ptr(#)==vlink(#+5) {the |split_top_skip| to be used}
+
+@ A |mark_node| has a |mark_ptr| field that points to the reference count
+of a token list that contains the user's \.{\\mark} text.
+In addition there is a |mark_class| field that contains the mark class.
+
+@d mark_node=4 {|type| of a mark node}
+@d mark_node_size=3 {number of words to allocate for a mark node}
+@d mark_ptr(#)==vlink(#+2) {head of the token list for a mark}
+@d mark_class(#)==vinfo(#+2) {the mark class}
+
+@ An |adjust_node|, which occurs only in horizontal lists,
+specifies material that will be moved out into the surrounding
+vertical list; i.e., it is used to implement \TeX's `\.{\\vadjust}'
+operation.  The |adjust_ptr| field points to the vlist containing this
+material.
+
+@d adjust_node=5 {|type| of an adjust node}
+@d adjust_node_size=3
+@d adjust_pre == subtype  {pre-adjustment?}
+@d adjust_ptr(#)==vlink(#+2) {vertical list to be moved out of horizontal list}
+@#{|append_list| is used to append a list to |tail|}
+@d append_list(#) == begin vlink(tail) := vlink(#); append_list_end
+@d append_list_end(#) == tail := #; end
+
+@ A |glyph_node|, which occurs only in horizontal lists, specifies a
+glyph in a particular font, along with its attribute list. Older
+versions of \TeX\ could use token memory for characters, because the
+font,char combination would fit in a single word (both values were
+required to be strictly less than $2^{16}$). In \LuaTeX, room is
+needed for characters that are larger than that, as well as a pointer
+to a potential attribute list, and the two displacement values.  
+
+In turn, that made the node so large that it made sense to merge
+ligature glyphs as well, as that requires only one extra pointer.  A
+few extra classes of glyph nodes will be introduced later.  The
+unification of all those types makes it easier to manipulate lists of
+glyphs. The subtype differentiates various glyph kinds.
+
+First, here is a function that returns a pointer to a glyph node for a given
+glyph in a given font. If that glyph doesn't exist, |null| is returned
+instead.  Nodes of this subtype are directly created only for accents
+and their base (through |make_accent|), and math nucleus items (in the
+conversion from |mlist| to |hlist|).
+
+
+@d glyph_node_size=5
+@d glyph_node=33 {|type| of a glyph node}
+@d is_char_node(#) == ((#<>null)and(type(#)=glyph_node))
+@d font(#)==vlink(#+2) {the font code in a |glyph_node|}
+@d character(#)==vinfo(#+2) {the character code in a |glyph_node|}
+@d lig_ptr(#)==vlink(#+3) {the list of characters for ligature replacements }
+@d lang_data(#)==vinfo(#+3) {language information }
+@d x_displace(#)==vinfo(#+4) { horizontal displacement }
+@d y_displace(#)==vlink(#+4) { vertical displacement  }
+
+@p function new_glyph(@!f,@!c:integer):pointer;
+var p:pointer; {the new node}
+begin p:=null;
+if (f=0) or (char_exists(f,c)) then begin
+  p:=new_glyph_node;
+  set_to_glyph(p); font(p):=f;  character(p):=c; 
+  end;
+new_glyph:=p;
+end;
+
+
+@ A subset of the glyphs nodes represent ligatures: characters
+fabricated from the interaction of two or more actual characters.  The
+characters that generated the ligature have not been forgotten, since
+they are needed for diagnostic messages; the |lig_ptr| field points to
+a linked list of character nodes for all original characters that have
+been deleted. (This list might be empty if the characters that
+generated the ligature were retained in other nodes.)
+
+The |subtype| field of these |glyph_node|s is 1, plus 2 and/or 1 if
+the original source of the ligature included implicit left and/or
+right boundaries. These nodes are created by the C function |new_ligkern|.
+
+@ A third general type of glyphs could be called a character, as it
+only appears in lists that are not yet processed by the ligaturing and
+kerning steps of the program.
+
+|main_control| inserts these, and they are later converted to
+|subtype_normal| by |new_ligkern|.
+
+@p function norm_min(@!h:integer):quarterword;
+begin if h<=0 then norm_min:=1@+else if h>=255 then norm_min:=255@+
+else norm_min:=h;
+end;
+@#
+function new_char(@!f,@!c:integer):pointer;
+var p:pointer; {the new node}
+begin p:=new_glyph_node;
+set_to_character(p); font(p):=f;  character(p):=c;
+lang_data(p):=make_lang_data(uc_hyph,cur_lang,left_hyphen_min,right_hyphen_min);
+new_char:=p;
+end;
+
+@ Left and right ghost glyph nodes are the result of \.{\\leftghost}
+and \.{\\rightghost}, respectively. They are going to be removed by
+|new_ligkern|, at the end of which they are no longer needed.
+
+@ Here are a few handy helpers used by the list output routines.
+
+@p
+function glyph_width(@!p:halfword):pointer;
+var w:integer;
+begin
+  w := char_width(font(p),character(p)); { |+ x_displace(p);| }
+  glyph_width := w;
+end;
+@#
+function glyph_height(@!p:halfword):pointer;
+var w:integer;
+begin
+  w := char_height(font(p),character(p)) + y_displace(p);
+  if w<0 then w:=0;
+  glyph_height := w;
+end;
+@#
+function glyph_depth(@!p:halfword):pointer;
+var w:integer;
+begin
+  w := char_depth(font(p),character(p));
+  if y_displace(p)>0 then w := w - y_displace(p);
+  if w<0 then w:=0;
+  glyph_depth := w;
+end;
+
+
+@ A |disc_node|, which occurs only in horizontal lists, specifies a
+``dis\-cretion\-ary'' line break. If such a break occurs at node |p|, the text
+that starts at |pre_break(p)| will precede the break, the text that starts at
+|post_break(p)| will follow the break, and text that appears in 
+|no_break(p)| nodes will be ignored. For example, an ordinary
+discretionary hyphen, indicated by `\.{\\-}', yields a |disc_node| with
+|pre_break| pointing to a |char_node| containing a hyphen, |post_break=null|,
+and |no_break=null|. 
+
+{TODO: Knuth said: All three of the discretionary texts must be lists
+that consist entirely of character, kern, box and rule nodes.}
+
+If |subtype(p)=automatic_disc|, the |ex_hyphen_penalty| will be charged for this
+break.  Otherwise the |hyphen_penalty| will be charged.  The texts will
+actually be substituted into the list by the line-breaking algorithm if it
+decides to make the break, and the discretionary node will disappear at
+that time; thus, the output routine sees only discretionaries that were
+not chosen.
+
+@d disc_node=7 {|type| of a discretionary node}
+@d disc_node_size=10
+@d automatic_disc=2
+@d syllable_disc=3
+@d disc_type==subtype {the kind of discretionary}
+@d pre_break(#)==vinfo(#+2) {text that precedes a discretionary break}
+@d post_break(#)==vlink(#+2) {text that follows a discretionary break}
+@d no_break(#)==vlink(#+3) {text this discretionary break replaces}
+@d pre_break_head(#)==(#+4)
+@d post_break_head(#)==(#+6)
+@d no_break_head(#)==(#+8)
+@d tlink(#)==vinfo(#+1)
+
+@p function new_disc:pointer; {creates an empty |disc_node|}
+var p:pointer; {the new node}
+begin p:=new_node(disc_node,0);
+new_disc:=p;
+end;
+
+@ A |whatsit_node| is a wild card reserved for extensions to \TeX. The
+|subtype| field in its first word says what `\\{whatsit}' it is, and
+implicitly determines the node size (which must be 2 or more) and the
+format of the remaining words. When a |whatsit_node| is encountered
+in a list, special actions are invoked; knowledgeable people who are
+careful not to mess up the rest of \TeX\ are able to make \TeX\ do new
+things by adding code at the end of the program. For example, there
+might be a `\TeX nicolor' extension to specify different colors of ink,
+@^extensions to \TeX@>
+and the whatsit node might contain the desired parameters.
+
+The present implementation of \TeX\ treats the features associated with
+`\.{\\write}' and `\.{\\special}' as if they were extensions, in order to
+illustrate how such routines might be coded. We shall defer further
+discussion of extensions until the end of this program.
+
+@d whatsit_node=8 {|type| of special extension nodes}
+
+@ A |math_node|, which occurs only in horizontal lists, appears before and
+after mathematical formulas. The |subtype| field is |before| before the
+formula and |after| after it. There is a |surround| field, which represents
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+@d math_node=9 {|type| of a math node}
+@d math_node_size=3
+@d surround(#)==vlink(#+2)
+@d before=0 {|subtype| for math node that introduces a formula}
+@d after=1 {|subtype| for math node that winds up a formula}
+
+@p function new_math(@!w:scaled;@!s:small_number):pointer;
+var p:pointer; {the new node}
+begin p:=new_node(math_node,s);
+surround(p):=w; new_math:=p;
+end;
+
+@ \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
+|rule_node|, |ins_node|, |mark_node|, |adjust_node|, 
+|disc_node|, |whatsit_node|, and |math_node| are at the low end of the
+type codes, by permitting a break at glue in a list if and only if the
+|type| of the previous node is less than |math_node|. Furthermore, a
+node is discarded after a break if its type is |math_node| or~more.
+
+@d precedes_break(#)==(type(#)<math_node)
+@d non_discardable(#)==(type(#)<math_node)
+
+@ A |glue_node| represents glue in a list. However, it is really only
+a pointer to a separate glue specification, since \TeX\ makes use of the
+fact that many essentially identical nodes of glue are usually present.
+If |p| points to a |glue_node|, |glue_ptr(p)| points to
+another packet of words that specify the stretch and shrink components, etc.
+
+Glue nodes also serve to represent leaders; the |subtype| is used to
+distinguish between ordinary glue (which is called |normal|) and the three
+kinds of leaders (which are called |a_leaders|, |c_leaders|, and |x_leaders|).
+The |leader_ptr| field points to a rule node or to a box node containing the
+leaders; it is set to |null| in ordinary glue nodes.
+
+Many kinds of glue are computed from \TeX's ``skip'' parameters, and
+it is helpful to know which parameter has led to a particular glue node.
+Therefore the |subtype| is set to indicate the source of glue, whenever
+it originated as a parameter. We will be defining symbolic names for the
+parameter numbers later (e.g., |line_skip_code=0|, |baseline_skip_code=1|,
+etc.); it suffices for now to say that the |subtype| of parametric glue
+will be the same as the parameter number, plus~one.
+
+In math formulas there are two more possibilities for the |subtype| in a
+glue node: |mu_glue| denotes an \.{\\mskip} (where the units are scaled \.{mu}
+instead of scaled \.{pt}); and |cond_math_glue| denotes the `\.{\\nonscript}'
+feature that cancels the glue node immediately following if it appears
+in a subscript.
+
+@d glue_node=10 {|type| of node that points to a glue specification}
+@d glue_node_size=3
+@d cond_math_glue=98 {special |subtype| to suppress glue in the next node}
+@d mu_glue=99 {|subtype| for math glue}
+@d a_leaders=100 {|subtype| for aligned leaders}
+@d c_leaders=101 {|subtype| for centered leaders}
+@d x_leaders=102 {|subtype| for expanded leaders}
+@d glue_ptr(#)==vinfo(#+2) {pointer to a glue specification}
+@d leader_ptr(#)==vlink(#+2) {pointer to box or rule node for leaders}
+
+@ A glue specification has a halfword reference count in its first word,
+@^reference counts@>
+representing |null| plus the number of glue nodes that point to it (less one).
+Note that the reference count appears in the same position as
+the |link| field in list nodes; this is the field that is initialized
+to |null| when a node is allocated, and it is also the field that is flagged
+by |empty_flag| in empty nodes.
+
+Glue specifications also contain three |scaled| fields, for the |width|,
+|stretch|, and |shrink| dimensions. Finally, there are two one-byte
+fields called |stretch_order| and |shrink_order|; these contain the
+orders of infinity (|normal|, |sfi|, |fil|, |fill|, or |filll|)
+corresponding to the stretch and shrink values.
+
+@d glue_spec_size=4 {number of words to allocate for a glue specification}
+@d glue_spec_node=43
+@d glue_ref_count(#) == vlink(#+3) {reference count of a glue specification}
+@d stretch(#) == vlink(#+1) {the stretchability of this glob of glue}
+@d shrink(#) == vinfo(#+1) {the shrinkability of this glob of glue}
+@d stretch_order(#) == type(#+3) {order of infinity for stretching}
+@d shrink_order(#) == subtype(#+3) {order of infinity for shrinking}
+@d sfi=1 {first-order infinity}
+@d fil=2 {second-order infinity}
+@d fill=3 {third-order infinity}
+@d filll=4 {fourth-order infinity}
+
+@<Types...@>=
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, 3, or 4 power}
+
+@ Here is a function that returns a pointer to a copy of a glue spec.
+The reference count in the copy is |null|, because there is assumed
+to be exactly one reference to the new specification.
+
+@p function new_spec(@!p:pointer):pointer; {duplicates a glue specification}
+var q:pointer; {the new spec}
+begin q:=copy_node(p); 
+glue_ref_count(q):=null;
+new_spec:=q;
+end;
+
+@ And here's a function that creates a glue node for a given parameter
+identified by its code number; for example,
+|new_param_glue(line_skip_code)| returns a pointer to a glue node for the
+current \.{\\lineskip}.
+
+@p function new_param_glue(@!n:small_number):pointer;
+var p:pointer; {the new node}
+@!q:pointer; {the glue specification}
+begin p:=new_node(glue_node,n+1);
+q:=@<Current |mem| equivalent of glue parameter number |n|@>@t@>;
+glue_ptr(p):=q; incr(glue_ref_count(q));
+new_param_glue:=p;
+end;
+
+@ Glue nodes that are more or less anonymous are created by |new_glue|,
+whose argument points to a glue specification.
+
+@p function new_glue(@!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=new_node(glue_node,normal);
+glue_ptr(p):=q; incr(glue_ref_count(q));
+new_glue:=p;
+end;
+
+@ Still another subroutine is needed: this one is sort of a combination
+of |new_param_glue| and |new_glue|. It creates a glue node for one of
+the current glue parameters, but it makes a fresh copy of the glue
+specification, since that specification will probably be subject to change,
+while the parameter will stay put. The global variable |temp_ptr| is
+set to the address of the new spec.
+
+@p function new_skip_param(@!n:small_number):pointer;
+var p:pointer; {the new node}
+begin temp_ptr:=new_spec(@<Current |mem| equivalent of glue parameter...@>);
+p:=new_glue(temp_ptr); glue_ref_count(temp_ptr):=null; subtype(p):=n+1;
+new_skip_param:=p;
+end;
+
+@ A |kern_node| has a |width| field to specify a (normally negative)
+amount of spacing. This spacing correction appears in horizontal lists
+between letters like A and V when the font designer said that it looks
+better to move them closer together or further apart. A kern node can
+also appear in a vertical list, when its `|width|' denotes additional
+spacing in the vertical direction. The |subtype| is either |normal| (for
+kerns inserted from font information or math mode calculations) or |explicit|
+(for kerns inserted from \.{\\kern} and \.{\\/} commands) or |acc_kern|
+(for kerns inserted from non-math accents) or |mu_glue| (for kerns
+inserted from \.{\\mkern} specifications in math formulas).
+
+@d kern_node=11 {|type| of a kern node}
+@d kern_node_size=3
+@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}}
+@d acc_kern=2 {|subtype| of kern nodes from accents}
+
+@# {memory structure for marginal kerns}
+@d margin_kern_node = 32
+@d margin_kern_node_size = 4
+@d margin_char(#) == vlink(#+3)
+
+@# {|subtype| of marginal kerns}
+@d left_side == 0
+@d right_side == 1
+
+@# {base for lp/rp/ef codes starts from 2:
+    0 for |hyphen_char|,
+    1 for |skew_char|}
+@d lp_code_base == 2
+@d rp_code_base == 3
+@d ef_code_base == 4
+@d tag_code == 5
+
+@d auto_kern == explicit
+@d no_lig_code == 6
+
+@ The |new_kern| function creates a kern node having a given width.
+
+@p function new_kern(@!w:scaled):pointer;
+var p:pointer; {the new node}
+begin p:=new_node(kern_node,normal);
+width(p):=w;
+new_kern:=p;
+end;
+
+@ A |penalty_node| specifies the penalty associated with line or page
+breaking, in its |penalty| field. This field is a fullword integer, but
+the full range of integer values is not used: Any penalty |>=10000| is
+treated as infinity, and no break will be allowed for such high values.
+Similarly, any penalty |<=-10000| is treated as negative infinity, and a
+break will be forced.
+
+@d penalty_node=12 {|type| of a penalty node}
+@d penalty_node_size=3 {has to be the same as |glue_node_size|}
+@d inf_penalty=inf_bad {``infinite'' penalty value}
+@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value}
+@d penalty(#) == vlink(#+2) {the added cost of breaking a list here}
+
+@ Anyone who has been reading the last few sections of the program will
+be able to guess what comes next.
+
+@p function new_penalty(@!m:integer):pointer;
+var p:pointer; {the new node}
+begin p:=new_node(penalty_node,0); {the |subtype| is not used}
+penalty(p):=m; new_penalty:=p;
+end;
+
+@ You might think that we have introduced enough node types by now. Well,
+almost, but there is one more: An |unset_node| has nearly the same format
+as an |hlist_node| or |vlist_node|; it is used for entries in \.{\\halign}
+or \.{\\valign} that are not yet in their final form, since the box
+dimensions are their ``natural'' sizes before any glue adjustment has been
+made. The |glue_set| word is not present; instead, we have a |glue_stretch|
+field, which contains the total stretch of order |glue_order| that is
+present in the hlist or vlist being boxed.
+Similarly, the |shift_amount| field is replaced by a |glue_shrink| field,
+containing the total shrink of order |glue_sign| that is present.
+The |subtype| field is called |span_count|; an unset box typically
+contains the data for |qo(span_count)+1| columns.
+Unset nodes will be changed to box nodes when alignment is completed.
+
+@d unset_node=13 {|type| for an unset node}
+@d glue_stretch(#)==vmem(#+glue_offset).sc {total stretch in an unset node}
+@d glue_shrink==shift_amount {total shrink in an unset node}
+@d span_count==subtype {indicates the number of spanned columns}
+
+@ In fact, there are still more types coming. When we get to math formula
+processing we will see that a |style_node| has |type=14|; and a number
+of larger type codes will also be defined, for use in math mode only.
+
+@ Warning: If any changes are made to these data structure layouts, such as
+changing any of the node sizes or even reordering the words of nodes,
+the |copy_node_list| procedure and the memory initialization code
+below may have to be changed. Such potentially dangerous parts of the
+program are listed in the index under `data structure assumptions'.
+@!@^data structure assumptions@>
+However, other references to the nodes are made symbolically in terms of
+the \.{WEB} macro definitions above, so that format changes will leave
+\TeX's other algorithms intact.
+@^system dependencies@>
+
+@* \[11] Memory layout.
+Some areas of |mem| are dedicated to fixed usage, since static allocation is
+more efficient than dynamic allocation when we can get away with it. For
+example, |zero_glue| used for glue that is `\.{0pt plus 0pt minus 0pt}'. The
+following macro definitions accomplish the static allocation by giving
+symbolic names to the fixed positions. 
+
+@d zero_glue==0 {specification for \.{0pt plus 0pt minus 0pt}}
+@d sfi_glue==zero_glue+glue_spec_size {\.{0pt plus 1fi minus 0pt}}
+@d fil_glue==sfi_glue+glue_spec_size {\.{0pt plus 1fil minus 0pt}}
+@d fill_glue==fil_glue+glue_spec_size {\.{0pt plus 1fill minus 0pt}}
+@d ss_glue==fill_glue+glue_spec_size {\.{0pt plus 1fil minus 1fil}}
+@d fil_neg_glue==ss_glue+glue_spec_size {\.{0pt plus -1fil minus 0pt}}
+@d page_ins_head==fil_neg_glue+glue_spec_size {list of insertion data for current page}
+@d contrib_head==page_ins_head+temp_node_size {list of items not yet on current page}
+@d page_head==contrib_head+temp_node_size {list for current page}
+@d temp_head==page_head+temp_node_size {head of a temporary list of some kind}
+@d hold_head==temp_head+temp_node_size {head of a temporary list of another kind}
+@d adjust_head==hold_head+temp_node_size {head of adjustment list returned by |hpack|}
+@d pre_adjust_head==adjust_head+temp_node_size {head of pre-adjustment list returned by |hpack|}
+@d active==pre_adjust_head+temp_node_size {head of active list in |line_break|}
+@d align_head==active+active_node_size {head of preamble list for alignments}
+@d end_span==align_head+temp_node_size {tail of spanned-width lists}
+@d begin_point==end_span+span_node_size {left-side dot for words in hyphenation}
+@d end_point==begin_point+glyph_node_size {right-side dot for words in hyphenation}
+@d var_mem_stat_max==(end_point+glyph_node_size-1) {largest statically allocated word in the variable-size |mem|}
+
+@<Glob...@>=
+garbage:pointer;         {head of a junk list, write only}
+temp_token_head:pointer; {head of a temporary list of some kind}
+hold_token_head:pointer; {head of a temporary list of another kind}
+omit_template:pointer;   {a constant token list}
+null_list:pointer;       {permanently empty list}
+backup_head:pointer;     {head of token list built by |scan_keyword|}
+
+@ The following code gets |mem| off to a good start, when \TeX\ is
+initializing itself the slow~way.
+
+@<Local variables for init...@>=
+@!k:integer; {index into |mem|, |eqtb|, etc.}
+
+@ @<Initialize table entries...@>=
+procedure init_link_heads;forward;
+init_node_mem(var_mem_stat_max,500); 
+glue_ref_count(zero_glue):=null+1; width(zero_glue):=0; 
+type(zero_glue):=glue_spec_node; vlink(zero_glue):=null;
+stretch(zero_glue):=0; stretch_order(zero_glue):=normal;@/
+shrink(zero_glue):=0; shrink_order(zero_glue):=normal;@/
+glue_ref_count(sfi_glue):=null+1; width(sfi_glue):=0; 
+type(sfi_glue):=glue_spec_node;  vlink(sfi_glue):=null;
+stretch(sfi_glue):=0; stretch_order(sfi_glue):=sfi;@/
+shrink(sfi_glue):=0; shrink_order(sfi_glue):=normal;@/
+glue_ref_count(fil_glue):=null+1; width(fil_glue):=0; 
+type(fil_glue):=glue_spec_node;  vlink(fil_glue):=null;
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+shrink(fil_glue):=0; shrink_order(fil_glue):=normal;@/
+glue_ref_count(fill_glue):=null+1; width(fill_glue):=0; 
+type(fill_glue):=glue_spec_node;  vlink(fill_glue):=null;
+stretch(fill_glue):=unity; stretch_order(fill_glue):=fill;@/
+shrink(fill_glue):=0; shrink_order(fill_glue):=normal;@/
+glue_ref_count(ss_glue):=null+1; width(ss_glue):=0; 
+type(ss_glue):=glue_spec_node;  vlink(ss_glue):=null;
+stretch(ss_glue):=unity; stretch_order(ss_glue):=fil;@/
+shrink(ss_glue):=unity; shrink_order(ss_glue):=fil;@/
+glue_ref_count(fil_neg_glue):=null+1; width(fil_neg_glue):=0; 
+type(fil_neg_glue):=glue_spec_node;  vlink(fil_neg_glue):=null;
+stretch(fil_neg_glue):=-unity; stretch_order(fil_neg_glue):=fil;@/
+shrink(fil_neg_glue):=0; shrink_order(fil_neg_glue):=normal;@/
+{initialize node list heads}
+vinfo(page_ins_head):=0; vlink(page_ins_head):=null; alink(page_ins_head):=null;
+vinfo(contrib_head):=0; vlink(contrib_head):=null; alink(contrib_head):=null;
+vinfo(page_head):=0; vlink(page_head):=null; alink(page_head):=null;
+vinfo(temp_head):=0; vlink(temp_head):=null; alink(temp_head):=null;
+vinfo(hold_head):=0; vlink(hold_head):=null; alink(hold_head):=null;
+vinfo(adjust_head):=0; vlink(adjust_head):=null; alink(adjust_head):=null;
+vinfo(pre_adjust_head):=0; vlink(pre_adjust_head):=null; alink(pre_adjust_head):=null;
+vinfo(active):=0; vlink(active):=null; alink(active):=null;
+vinfo(align_head):=0; vlink(align_head):=null; alink(align_head):=null;
+vinfo(end_span):=0; vlink(end_span):=null; alink(end_span):=null;
+type(begin_point):=glyph_node; subtype(begin_point):=0; vlink(begin_point):=null; 
+vinfo(begin_point+1):=null; alink(begin_point):=null; 
+font(begin_point):=0; character(begin_point):='.';
+vinfo(begin_point+3):=0; vlink(begin_point+3):=0; 
+vinfo(begin_point+4):=0; vlink(begin_point+4):=0; 
+type(end_point):=glyph_node; subtype(end_point):=0; vlink(end_point):=null; 
+vinfo(end_point+1):=null; alink(end_point):=null; 
+font(end_point):=0; character(end_point):='.';
+vinfo(end_point+3):=0; vlink(end_point+3):=0; 
+vinfo(end_point+4):=0; vlink(end_point+4):=0; 
+avail:=null; fix_mem_end:=0;
+init_list_heads;
+@<Initialize the special list heads and constant nodes@>;
+initialize_active;
+dyn_used:=0; {initialize statistics}
+
+@ @p procedure init_list_heads; {initialize token list heads}
+var p:halfword;
+begin
+p:=get_avail; temp_token_head:=p; info(temp_token_head):=0;
+p:=get_avail; hold_token_head:=p; info(hold_token_head):=0;
+p:=get_avail; omit_template:=p;   info(omit_template):=0; 
+p:=get_avail; null_list:=p;       info(null_list):=0; 
+p:=get_avail; backup_head:=p;     info(backup_head):=0;
+p:=get_avail; garbage:=p;         info(garbage):=0;
+end;
+
+@ @p
+@<Declare procedures that need to be declared forward for \pdfTeX@>
+
+@* \[12] Displaying boxes.
+We can reinforce our knowledge of the data structures just introduced
+by considering two procedures that display a list in symbolic form.
+The first of these, called |short_display|, is used in ``overfull box''
+messages to give the top-level description of a list. The other one,
+called |show_node_list|, prints a detailed description of exactly what
+is in the data structure.
+
+The philosophy of |short_display| is to ignore the fine points about exactly
+what is inside boxes, except that ligatures and discretionary breaks are
+expanded. As a result, |short_display| is a recursive procedure, but the
+recursion is never more than one level deep.
+@^recursion@>
+
+A global variable |font_in_short_display| keeps track of the font code that
+is assumed to be present when |short_display| begins; deviations from this
+font will be printed.
+
+@<Glob...@>=
+@!font_in_short_display:integer; {an internal font number}
+
+@ Boxes, rules, inserts, whatsits, marks, and things in general that are
+sort of ``complicated'' are indicated only by printing `\.{[]}'.
+
+@p
+procedure print_font_identifier(f: internal_font_number);
+begin
+    if pdf_font_blink(f) = null_font then
+        print_esc(font_id_text(f))
+    else
+        print_esc(font_id_text(pdf_font_blink(f)));
+    if pdf_tracing_fonts > 0 then begin
+        print(" (");
+        print_font_name(f);
+        if font_size(f) <> font_dsize(f) then begin
+            print("@@");
+            print_scaled(font_size(f));
+            print("pt");
+        end;
+        print(")");
+    end else
+        if pdf_font_expand_ratio(f) <> 0 then begin
+            print(" (");
+            if pdf_font_expand_ratio(f) > 0 then
+                print("+");
+            print_int(pdf_font_expand_ratio(f));
+            print(")");
+        end;
+end;
+
+procedure short_display(@!p:integer); {prints highlights of list |p|}
+begin while p<>null do
+  begin if is_char_node(p) then
+      begin if lig_ptr(p)<>null then 
+           short_display(lig_ptr(p))
+        else begin
+          if font(p)<>font_in_short_display then
+          begin if not is_valid_font(font(p)) then
+            print_char("*")
+@.*\relax@>
+          else print_font_identifier(font(p));
+          print_char(" "); font_in_short_display:=font(p);
+          end;
+        print(qo(character(p)));
+      end;
+    end
+  else @<Print a short indication of the contents of node |p|@>;
+  p:=vlink(p);
+  end;
+end;
+
+@ @<Print a short indication of the contents of node |p|@>=
+case type(p) of
+hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node,
+  unset_node: print("[]");
+rule_node: print_char("|");
+glue_node: if glue_ptr(p)<>zero_glue then print_char(" ");
+math_node: print_char("$");
+disc_node: begin short_display(vlink(pre_break(p)));
+  short_display(vlink(post_break(p)));@/
+  end;
+othercases do_nothing
+endcases
+
+@ The |show_node_list| routine requires some auxiliary subroutines: one to
+print a font-and-character combination, one to print a token list without
+its reference count, and one to print a rule dimension.
+
+@p procedure print_font_and_char(@!p:integer); {prints |char_node| data}
+begin if not is_valid_font(font(p)) then print_char("*")
+@.*\relax@>
+  else print_font_identifier(font(p));
+  print_char(" "); print(character(p));
+end;
+@#
+procedure print_mark(@!p:integer); {prints token list data in braces}
+begin print_char("{");
+if (p<fix_mem_min)or(p>fix_mem_end) then print_esc("CLOBBERED.")
+else show_token_list(link(p),null,max_print_line-10);
+print_char("}");
+end;
+@#
+procedure print_rule_dimen(@!d:scaled); {prints dimension in rule node}
+begin if is_running(d) then print_char("*") else print_scaled(d);
+@.*\relax@>
+end;
+@#
+procedure print_dir(d:integer);
+begin
+print(dir_names[dir_primary[d]]);
+print(dir_names[dir_secondary[d]]);
+print(dir_names[dir_tertiary[d]]);
+end;
+
+
+@ Then there is a subroutine that prints glue stretch and shrink, possibly
+followed by the name of finite units:
+
+@p procedure print_glue(@!d:scaled;@!order:integer;@!s:str_number);
+  {prints a glue component}
+begin print_scaled(d);
+if (order<normal)or(order>filll) then print("foul")
+else if order>normal then
+  begin print("fi");
+  while order>sfi do
+    begin print_char("l"); decr(order);
+    end;
+  end
+else if s<>0 then print(s);
+end;
+
+@ The next subroutine prints a whole glue specification.
+
+@p procedure print_spec(@!p:integer;@!s:str_number);
+  {prints a glue specification}
+begin if p<0 then print_char("*")
+@.*\relax@>
+else  begin print_scaled(width(p));
+  if s<>0 then print(s);
+  if stretch(p)<>0 then
+    begin print(" plus "); print_glue(stretch(p),stretch_order(p),s);
+    end;
+  if shrink(p)<>0 then
+    begin print(" minus "); print_glue(shrink(p),shrink_order(p),s);
+    end;
+  end;
+end;
+
+@ We also need to declare some procedures that appear later in this
+documentation.
+
+@p @<Declare procedures needed for displaying the elements of mlists@>@;
+@<Declare the procedure called |print_skip_param|@>
+
+@ Since boxes can be inside of boxes, |show_node_list| is inherently recursive,
+@^recursion@>
+up to a given maximum number of levels.  The history of nesting is indicated
+by the current string, which will be printed at the beginning of each line;
+the length of this string, namely |cur_length|, is the depth of nesting.
+
+Recursive calls on |show_node_list| therefore use the following pattern:
+
+@d node_list_display(#)==
+  begin append_char("."); show_node_list(#); flush_char;
+  end {|str_room| need not be checked; see |show_box| below}
+
+@ A global variable called |depth_threshold| is used to record the maximum
+depth of nesting for which |show_node_list| will show information.  If we
+have |depth_threshold=0|, for example, only the top level information will
+be given and no sublists will be traversed. Another global variable, called
+|breadth_max|, tells the maximum number of items to show at each level;
+|breadth_max| had better be positive, or you won't see anything.
+
+@<Glob...@>=
+@!depth_threshold : integer; {maximum nesting depth in box displays}
+@!breadth_max : integer; {maximum number of items shown at the same list level}
+
+@ Now we are ready for |show_node_list| itself. This procedure has been
+written to be ``extra robust'' in the sense that it should not crash or get
+into a loop even if the data structures have been messed up by bugs in
+the rest of the program. You can safely call its parent routine
+|show_box(p)| for arbitrary values of |p| when you are debugging \TeX.
+However, in the presence of bad data, the procedure may
+@^dirty \PASCAL@>@^debugging@>
+fetch a |memory_word| whose variant is different from the way it was stored;
+for example, it might try to read |mem[p].hh| when |mem[p]|
+contains a scaled integer, if |p| is a pointer that has been
+clobbered or chosen at random.
+
+@p procedure show_node_list(@!p:integer); {prints a node list symbolically}
+label exit;
+var n:integer; {the number of items already printed at this level}
+@!g:real; {a glue ratio, as a floating point number}
+begin if cur_length>depth_threshold then
+  begin if p>null then print(" []");
+    {indicate that there's been some truncation}
+  return;
+  end;
+n:=0;
+while p<>null do
+  begin print_ln; print_current_string; {display the nesting history}
+  if tracing_online<-2 then print_int(p); 
+    incr(n); if n>breadth_max then {time to stop}
+    begin print("etc."); return;
+@.etc@>
+    end;
+  @<Display node |p|@>;
+  p:=vlink(p);
+  end;
+exit:
+end;
+
+@ @<Display node |p|@>=
+if is_char_node(p) then begin 
+ print_font_and_char(p);
+ if is_ligature(p) then @<Display ligature |p|@>;
+ end
+else case type(p) of
+  hlist_node,vlist_node,unset_node: @<Display box |p|@>;
+  rule_node: @<Display rule |p|@>;
+  ins_node: @<Display insertion |p|@>;
+  whatsit_node: @<Display the whatsit node |p|@>;
+  glue_node: @<Display glue |p|@>;
+  margin_kern_node: begin
+    print_esc("kern");
+    print_scaled(width(p));
+    if subtype(p) = left_side then
+        print(" (left margin)")
+    else
+        print(" (right margin)");
+    end;
+  kern_node: @<Display kern |p|@>;
+  math_node: @<Display math node |p|@>;
+  penalty_node: @<Display penalty |p|@>;
+  disc_node: @<Display discretionary |p|@>;
+  mark_node: @<Display mark |p|@>;
+  adjust_node: @<Display adjustment |p|@>;
+  @t\4@>@<Cases of |show_node_list| that arise in mlists only@>@;
+  othercases print("Unknown node type!")
+  endcases
+
+@ @<Display box |p|@>=
+begin if type(p)=hlist_node then print_esc("h")
+else if type(p)=vlist_node then print_esc("v")
+else print_esc("unset");
+print("box("); print_scaled(height(p)); print_char("+");
+print_scaled(depth(p)); print(")x"); print_scaled(width(p));
+if type(p)=unset_node then
+  @<Display special fields of the unset node |p|@>
+else  begin @<Display the value of |glue_set(p)|@>;
+  if shift_amount(p)<>0 then
+    begin print(", shifted "); print_scaled(shift_amount(p));
+    end;
+  print(", direction "); print_dir(box_dir(p));
+  end;
+{|pdfassert(list_ptr(p)<>0);|}
+node_list_display(list_ptr(p)); {recursive call}
+end
+
+@ @<Display special fields of the unset node |p|@>=
+begin if span_count(p)<>min_quarterword then
+  begin print(" ("); print_int(qo(span_count(p))+1);
+  print(" columns)");
+  end;
+if glue_stretch(p)<>0 then
+  begin print(", stretch "); print_glue(glue_stretch(p),glue_order(p),0);
+  end;
+if glue_shrink(p)<>0 then
+  begin print(", shrink "); print_glue(glue_shrink(p),glue_sign(p),0);
+  end;
+end
+
+@ The code will have to change in this place if |glue_ratio| is
+a structured type instead of an ordinary |real|. Note that this routine
+should avoid arithmetic errors even if the |glue_set| field holds an
+arbitrary random value. The following code assumes that a properly
+formed nonzero |real| number has absolute value $2^{20}$ or more when
+it is regarded as an integer; this precaution was adequate to prevent
+floating point underflow on the author's computer.
+@^system dependencies@>
+@^dirty \PASCAL@>
+
+@<Display the value of |glue_set(p)|@>=
+g:=float(glue_set(p));
+if (g<>float_constant(0))and(glue_sign(p)<>normal) then
+  begin print(", glue set ");
+  if glue_sign(p)=shrinking then print("- ");
+  if abs(vmem(p+glue_offset).int)<@'4000000 then print("?.?")
+  else if abs(g)>float_constant(20000) then
+    begin if g>float_constant(0) then print_char(">")
+    else print("< -");
+    print_glue(20000*unity,glue_order(p),0);
+    end
+  else print_glue(round(unity*g),glue_order(p),0);
+@^real multiplication@>
+  end
+
+@ @<Display rule |p|@>=
+begin print_esc("rule("); print_rule_dimen(height(p)); print_char("+");
+print_rule_dimen(depth(p)); print(")x"); print_rule_dimen(width(p));
+end
+
+@ @<Display insertion |p|@>=
+begin print_esc("insert"); print_int(qo(subtype(p)));
+print(", natural size "); print_scaled(height(p));
+print("; split("); print_spec(split_top_ptr(p),0);
+print_char(","); print_scaled(depth(p));
+print("); float cost "); print_int(float_cost(p));
+node_list_display(ins_ptr(p)); {recursive call}
+end
+
+@ @<Display glue |p|@>=
+if subtype(p)>=a_leaders then @<Display leaders |p|@>
+else  begin print_esc("glue");
+  if subtype(p)<>normal then
+    begin print_char("(");
+    if subtype(p)<cond_math_glue then
+      print_skip_param(subtype(p)-1)
+    else if subtype(p)=cond_math_glue then print_esc("nonscript")
+    else print_esc("mskip");
+    print_char(")");
+    end;
+  if subtype(p)<>cond_math_glue then
+    begin print_char(" ");
+    if subtype(p)<cond_math_glue then print_spec(glue_ptr(p),0)
+    else print_spec(glue_ptr(p),"mu");
+    end;
+  end
+
+@ @<Display leaders |p|@>=
+begin print_esc("");
+if subtype(p)=c_leaders then print_char("c")
+else if subtype(p)=x_leaders then print_char("x");
+print("leaders "); print_spec(glue_ptr(p),0);
+node_list_display(leader_ptr(p)); {recursive call}
+end
+
+@ An ``explicit'' kern value is indicated implicitly by an explicit space.
+
+@<Display kern |p|@>=
+if subtype(p)<>mu_glue then
+  begin print_esc("kern");
+  if subtype(p)<>normal then print_char(" ");
+  print_scaled(width(p));
+  if subtype(p)=acc_kern then print(" (for accent)");
+@.for accent@>
+  end
+else  begin print_esc("mkern"); print_scaled(width(p)); print("mu");
+  end
+
+@ @<Display math node |p|@>=
+begin print_esc("math");
+if subtype(p)=before then print("on")
+else print("off");
+if width(p)<>0 then
+  begin print(", surrounded "); print_scaled(width(p));
+  end;
+end
+
+@ @<Display ligature |p|@>=
+begin print(" (ligature ");
+if is_leftboundary(p) then print_char("|");
+font_in_short_display:=font(p); short_display(lig_ptr(p));
+if is_rightboundary(p) then print_char("|");
+print_char(")");
+end
+
+@ @<Display penalty |p|@>=
+begin print_esc("penalty "); print_int(penalty(p));
+end
+
+@ The |post_break| list of a discretionary node is indicated by a prefixed
+`\.{\char'174}' instead of the `\..' before the |pre_break| list.
+
+@<Display discretionary |p|@>=
+begin print_esc("discretionary");
+if vlink(no_break(p))<>null then
+  begin print(" replacing "); node_list_display(vlink(no_break(p)));
+  end;
+node_list_display(vlink(pre_break(p))); {recursive call}
+append_char("|"); show_node_list(vlink(post_break(p))); flush_char; {recursive call}
+end
+
+@ @<Display mark |p|@>=
+begin print_esc("mark");
+if mark_class(p)<>0 then
+  begin print_char("s"); print_int(mark_class(p));
+  end;
+print_mark(mark_ptr(p));
+end
+
+@ @<Display adjustment |p|@>=
+begin print_esc("vadjust"); if adjust_pre(p) <> 0 then print(" pre ");
+node_list_display(adjust_ptr(p)); {recursive call}
+end
+
+@ The recursive machinery is started by calling |show_box|.
+@^recursion@>
+
+@p procedure show_box(@!p:pointer);
+begin @<Assign the values |depth_threshold:=show_box_depth| and
+  |breadth_max:=show_box_breadth|@>;
+if breadth_max<=0 then breadth_max:=5;
+if pool_ptr+depth_threshold>=pool_size then
+  depth_threshold:=pool_size-pool_ptr-1;
+  {now there's enough room for prefix string}
+show_node_list(p); {the show starts at |p|}
+print_ln;
+end;
+
+@* \[13] Destroying boxes.
+When we are done with a node list, we are obliged to return it to free
+storage, including all of its sublists. The recursive procedure
+|flush_node_list| does this for us.
+
+@ First, however, we shall consider two non-recursive procedures that do
+simpler tasks. The first of these, |delete_token_ref|, is called when
+a pointer to a token list's reference count is being removed. This means
+that the token list should disappear if the reference count was |null|,
+otherwise the count should be decreased by one.
+@^reference counts@>
+
+@d token_ref_count(#) == info(#) {reference count preceding a token list}
+
+@p procedure delete_token_ref(@!p:pointer); {|p| points to the reference count
+  of a token list that is losing one reference}
+begin pdfassert(token_ref_count(p)>=0);
+if token_ref_count(p)=0 then flush_list(p)
+else decr(token_ref_count(p));
+end;
+
+@ Similarly, |delete_glue_ref| is called when a pointer to a glue
+specification is being withdrawn.
+@^reference counts@>
+@d fast_delete_glue_ref(#)==@t@>@;@/
+  begin if glue_ref_count(#)=null then begin 
+    flush_node(#);
+    end
+  else decr(glue_ref_count(#));
+  end
+
+@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification}
+begin
+  pdfassert(type(p)=glue_spec_node);
+  fast_delete_glue_ref(p);
+end;
+
+@ Now we are ready to delete any node list, recursively.
+In practice, the nodes deleted are usually charnodes (about 2/3 of the time),
+and they are glue nodes in about half of the remaining cases.
+@^recursion@>
+
+
+@* \[14] Copying boxes.
+Another recursive operation that acts on boxes is sometimes needed: The
+procedure |copy_node_list| returns a pointer to another node list that has
+the same structure and meaning as the original. Note that since glue
+specifications and token lists have reference counts, we need not make
+copies of them. Reference counts can never get too large to fit in a
+halfword, since each pointer to a node is in a different memory address,
+and the total number of memory addresses fits in a halfword.
+@^recursion@>
+@^reference counts@>
+
+(Well, there actually are also references from outside |mem|; if the
+|save_stack| is made arbitrarily large, it would theoretically be possible
+to break \TeX\ by overflowing a reference count. But who would want to do that?)
+
+@d add_token_ref(#)==incr(token_ref_count(#)) {new reference to a token list}
+@d add_glue_ref(#)==incr(glue_ref_count(#)) {new reference to a glue spec}
+
+@p function tail_of_list (@!p:pointer):pointer;
+var q:pointer;
+begin
+  q:=p;
+  while vlink(q)<>null do q:=vlink(q);
+  tail_of_list:=q;
+end;
+
+@* \[15] The command codes.
+Before we can go any further, we need to define symbolic names for the internal
+code numbers that represent the various commands obeyed by \TeX. These codes
+are somewhat arbitrary, but not completely so. For example, the command
+codes for character types are fixed by the language, since a user says,
+e.g., `\.{\\catcode \`\\\${} = 3}' to make \.{\char'44} a math delimiter,
+and the command code |math_shift| is equal to~3. Some other codes have
+been made adjacent so that |case| statements in the program need not consider
+cases that are widely spaced, or so that |case| statements can be replaced
+by |if| statements.
+
+At any rate, here is the list, for future reference. First come the
+``catcode'' commands, several of which share their numeric codes with
+ordinary commands when the catcode cannot emerge from \TeX's scanning routine.
+
+@d escape=0 {escape delimiter (called \.\\ in {\sl The \TeX book\/})}
+@:TeXbook}{\sl The \TeX book@>
+@d relax=0 {do nothing ( \.{\\relax} )}
+@d left_brace=1 {beginning of a group ( \.\{ )}
+@d right_brace=2 {ending of a group ( \.\} )}
+@d math_shift=3 {mathematics shift character ( \.\$ )}
+@d tab_mark=4 {alignment delimiter ( \.\&, \.{\\span} )}
+@d car_ret=5 {end of line ( |carriage_return|, \.{\\cr}, \.{\\crcr} )}
+@d out_param=5 {output a macro parameter}
+@d mac_param=6 {macro parameter symbol ( \.\# )}
+@d sup_mark=7 {superscript ( \.{\char'136} )}
+@d sub_mark=8 {subscript ( \.{\char'137} )}
+@d ignore=9 {characters to ignore ( \.{\^\^@@} )}
+@d endv=9 {end of \<v_j> list in alignment template}
+@d spacer=10 {characters equivalent to blank space ( \.{\ } )}
+@d letter=11 {characters regarded as letters ( \.{A..Z}, \.{a..z} )}
+@d other_char=12 {none of the special character types}
+@d active_char=13 {characters that invoke macros ( \.{\char`\~} )}
+@d par_end=13 {end of paragraph ( \.{\\par} )}
+@d match=13 {match a macro parameter}
+@d comment=14 {characters that introduce comments ( \.\% )}
+@d end_match=14 {end of parameters to macro}
+@d stop=14 {end of job ( \.{\\end}, \.{\\dump} )}
+@d invalid_char=15 {characters that shouldn't appear ( \.{\^\^?} )}
+@d delim_num=15 {specify delimiter numerically ( \.{\\delimiter} )}
+@d max_char_code=15 {largest catcode for individual characters}
+
+@ Next are the ordinary run-of-the-mill command codes.  Codes that are
+|min_internal| or more represent internal quantities that might be
+expanded by `\.{\\the}'.
+
+@d char_num=16 {character specified numerically ( \.{\\char} )}
+@d math_char_num=17 {explicit math code ( \.{\\mathchar} )}
+@d mark=18 {mark definition ( \.{\\mark} )}
+@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)}
+@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)}
+@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )}
+@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )}
+@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )}
+@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )}
+  {( or \.{\\pagediscards}, \.{\\splitdiscards} )}
+@d remove_item=25 {nullify last item ( \.{\\unpenalty},
+  \.{\\unkern}, \.{\\unskip} )}
+@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)}
+@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)}
+@d mskip=28 {math glue ( \.{\\mskip} )}
+@d kern=29 {fixed space ( \.{\\kern})}
+@d mkern=30 {math kern ( \.{\\mkern} )}
+@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)}
+@d halign=32 {horizontal table alignment ( \.{\\halign} )}
+@d valign=33 {vertical table alignment ( \.{\\valign} )}
+@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )}
+@d vrule=35 {vertical rule ( \.{\\vrule} )}
+@d hrule=36 {horizontal rule ( \.{\\hrule} )}
+@d insert=37 {vlist inserted in box ( \.{\\insert} )}
+@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )}
+@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )}
+@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )}
+@d after_group=41 {save till group is done ( \.{\\aftergroup} )}
+@d break_penalty=42 {additional badness ( \.{\\penalty} )}
+@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )}
+@d ital_corr=44 {italic correction ( \.{\\/} )}
+@d accent=45 {attach accent in text ( \.{\\accent} )}
+@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )}
+@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )}
+@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )}
+@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )}
+  {( or \.{\\middle} )}
+@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)}
+@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)}
+@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)}
+@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)}
+@d math_choice=54 {choice specification ( \.{\\mathchoice} )}
+@d non_script=55 {conditional math glue ( \.{\\nonscript} )}
+@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )}
+@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)}
+@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )}
+@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)}
+@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )}
+@d begin_group=61 {begin local grouping ( \.{\\begingroup} )}
+@d end_group=62 {end local grouping ( \.{\\endgroup} )}
+@d omit=63 {omit alignment template ( \.{\\omit} )}
+@d ex_space=64 {explicit space ( \.{\\\ } )}
+@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )}
+@d radical=66 {square root and similar signs ( \.{\\radical} )}
+@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )}
+@d char_ghost=end_cs_name+1
+   {\.{\\ghostleft}, \.{\\ghostright} character for kerning}
+@d assign_local_box=char_ghost+1
+   {box for guillemets \.{\\localleftbox} or \.{\\localrightbox}}
+@d min_internal=assign_local_box+1 {the smallest code that can follow \.{\\the}}
+@d char_given=min_internal {character code defined by \.{\\chardef}}
+@d math_given=char_given+1 {math code defined by \.{\\mathchardef}}
+@d omath_given=math_given+1 {math code defined by \.{\\omathchardef}}
+@d last_item=omath_given+1 {most recent item ( \.{\\lastpenalty},
+  \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=last_item
+   {largest command code that can't be \.{\\global}}
+
+@ The next codes are special; they all relate to mode-independent
+assignment of values to \TeX's internal registers or tables.
+Codes that are |max_internal| or less represent internal quantities
+that might be expanded by `\.{\\the}'.
+
+There is no matching primitive to go with |assign_attr|, but even if
+there was no \.{\\attributedef}, a reserved number would still be
+needed because there is an implied correspondence between the
+|assign_xxx| commands and |xxx_val| expression values. That would 
+break down otherwise.
+
+@d toks_register=max_non_prefixed_command+1
+   {token list register ( \.{\\toks} )}
+@d assign_toks=toks_register+1
+   {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=assign_toks+1
+   {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_attr=assign_int+1 { user-defined attributes }
+@d assign_dimen=assign_attr+1
+   {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=assign_dimen+1
+   {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=assign_glue+1
+   {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=assign_mu_glue+1
+   {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=assign_font_dimen+1
+   {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )}
+@d set_aux=assign_font_int+1
+   {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=set_aux+1
+   {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=set_prev_graf+1
+   {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=set_page_dimen+1
+   {specify state info ( \.{\\deadcycles},
+  \.{\\insertpenalties} )}
+@d set_box_dimen=set_page_int+1
+   {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=set_box_dimen+1
+   {specify fancy paragraph shape ( \.{\\parshape} )}
+@d def_code=set_shape+1
+   {define a character code ( \.{\\catcode}, etc.~)}
+@d extdef_code=def_code+1
+   {define an extended character code ( \.{\\omathcode}, etc.~)}
+@d def_family=extdef_code+1
+   {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=def_family+1
+   {set current font ( font identifiers )}
+@d def_font=set_font+1
+   {define a font file ( \.{\\font} )}
+@d register=def_font+1
+   {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d assign_box_dir=register+1 {(\.{\\boxdir})}
+@d assign_dir=register+2 {(\.{\\pagedir}, \.{\\textdir})}
+@d max_internal=assign_dir
+   {the largest code that can follow \.{\\the}}
+@d advance=max_internal+1
+   {advance a register or parameter ( \.{\\advance} )}
+@d multiply=advance+1
+   {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=multiply+1
+   {divide a register or parameter ( \.{\\divide} )}
+@d prefix=divide+1
+   {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+@d let=prefix+1
+   {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=let+1
+   {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=shorthand_def+1
+   {read into a control sequence ( \.{\\read} )}
+@d def=read_to_cs+1
+   {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=def+1
+   {set a box ( \.{\\setbox} )}
+@d hyph_data=set_box+1
+   {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=hyph_data+1
+   {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d letterspace_font=set_interaction+1
+   {letterspace a font ( \.{\\letterspacefont} )}
+@d set_ocp=letterspace_font+1
+   {Place a translation process in the stream}
+@d def_ocp=set_ocp+1
+   {Define and load a translation process}
+@d set_ocp_list=def_ocp+1
+   {Place a list of OCPs in the stream}
+@d def_ocp_list=set_ocp_list+1
+   {Define a list of OCPs}
+@d clear_ocp_lists=def_ocp_list+1
+   {Remove all active OCP lists}
+@d push_ocp_list=clear_ocp_lists+1
+   {Add to the sequence of active OCP lists}
+@d pop_ocp_list=push_ocp_list+1
+   {Remove from the sequence of active OCP lists}
+@d ocp_list_op=pop_ocp_list+1
+   {Operations for building a list of OCPs}
+@d ocp_trace_level=ocp_list_op+1
+   {Tracing of active OCPs, either 0 or 1}
+@d max_command=ocp_trace_level 
+  {the largest command code seen at |big_switch|}
+
+@ The remaining command codes are extra special, since they cannot get through
+\TeX's scanner to the main control routine. They have been given values higher
+than |max_command| so that their special nature is easily discernible.
+The ``expandable'' commands come first.
+
+@d undefined_cs=max_command+1 {initial state of most |eq_type| fields}
+@d expand_after=max_command+2 {special expansion ( \.{\\expandafter} )}
+@d no_expand=max_command+3 {special nonexpansion ( \.{\\noexpand} )}
+@d input=max_command+4 {input a source file ( \.{\\input}, \.{\\endinput} )}
+  {( or \.{\\scantokens} or \.{\\scantextokens} )}
+@d if_test=max_command+5 {conditional text ( \.{\\if}, \.{\\ifcase}, etc.~)}
+@d fi_or_else=max_command+6 {delimiters for conditionals ( \.{\\else}, etc.~)}
+@d cs_name=max_command+7 {make a control sequence from tokens ( \.{\\csname} )}
+@d convert=max_command+8 {convert to text ( \.{\\number}, \.{\\string}, etc.~)}
+@d the=max_command+9 {expand an internal quantity ( \.{\\the} )}
+  {( or \.{\\unexpanded}, \.{\\detokenize} )}
+@d top_bot_mark=max_command+10 {inserted mark ( \.{\\topmark}, etc.~)}
+@d call=max_command+11 {non-long, non-outer control sequence}
+@d long_call=max_command+12 {long, non-outer control sequence}
+@d outer_call=max_command+13 {non-long, outer control sequence}
+@d long_outer_call=max_command+14 {long, outer control sequence}
+@d end_template=max_command+15 {end of an alignment template}
+@d dont_expand=max_command+16 {the following token was marked by \.{\\noexpand}}
+@d glue_ref=max_command+17 {the equivalent points to a glue specification}
+@d shape_ref=max_command+18 {the equivalent points to a parshape specification}
+@d box_ref=max_command+19 {the equivalent points to a box node, or is |null|}
+@d data=max_command+20 {the equivalent is simply a halfword number}
+
+@* \[16] The semantic nest.
+\TeX\ is typically in the midst of building many lists at once. For example,
+when a math formula is being processed, \TeX\ is in math mode and
+working on an mlist; this formula has temporarily interrupted \TeX\ from
+being in horizontal mode and building the hlist of a paragraph; and this
+paragraph has temporarily interrupted \TeX\ from being in vertical mode
+and building the vlist for the next page of a document. Similarly, when a
+\.{\\vbox} occurs inside of an \.{\\hbox}, \TeX\ is temporarily
+interrupted from working in restricted horizontal mode, and it enters
+internal vertical mode.  The ``semantic nest'' is a stack that
+keeps track of what lists and modes are currently suspended.
+
+At each level of processing we are in one of six modes:
+
+\yskip\hang|vmode| stands for vertical mode (the page builder);
+
+\hang|hmode| stands for horizontal mode (the paragraph builder);
+
+\hang|mmode| stands for displayed formula mode;
+
+\hang|-vmode| stands for internal vertical mode (e.g., in a \.{\\vbox});
+
+\hang|-hmode| stands for restricted horizontal mode (e.g., in an \.{\\hbox});
+
+\hang|-mmode| stands for math formula mode (not displayed).
+
+\yskip\noindent The mode is temporarily set to zero while processing \.{\\write}
+texts in the |ship_out| routine.
+
+Numeric values are assigned to |vmode|, |hmode|, and |mmode| so that
+\TeX's ``big semantic switch'' can select the appropriate thing to
+do by computing the value |abs(mode)+cur_cmd|, where |mode| is the current
+mode and |cur_cmd| is the current command code.
+
+@d vmode=1 {vertical mode}
+@d hmode=vmode+max_command+1 {horizontal mode}
+@d mmode=hmode+max_command+1 {math mode}
+
+@p procedure print_mode(@!m:integer); {prints the mode represented by |m|}
+begin if m>0 then
+  case m div (max_command+1) of
+  0:print("vertical");
+  1:print("horizontal");
+  2:print("display math");
+  end
+else if m=0 then print("no")
+else  case (-m) div (max_command+1) of
+  0:print("internal vertical");
+  1:print("restricted horizontal");
+  2:print("math");
+  end;
+print(" mode");
+end;
+function get_mode_id:integer; {returns the mode represented by |m|}
+var m:integer ;
+begin 
+  m := mode;
+  if m>0 then
+  case m div (max_command+1) of
+  0:get_mode_id := "v";
+  1:get_mode_id := "h";
+  2:get_mode_id := "m"; 
+  othercases get_mode_id := "";
+  end
+else if m=0 then get_mode_id := "n"
+else  case (-m) div (max_command+1) of
+  0:get_mode_id := "V";
+  1:get_mode_id := "H";
+  2:get_mode_id := "M";
+  othercases get_mode_id := "";
+  end;
+end;
+
+@ The state of affairs at any semantic level can be represented by
+five values:
+
+\yskip\hang|mode| is the number representing the semantic mode, as
+just explained.
+
+\yskip\hang|head| is a |pointer| to a list head for the list being built;
+|link(head)| therefore points to the first element of the list, or
+to |null| if the list is empty.
+
+\yskip\hang|tail| is a |pointer| to the final node of the list being
+built; thus, |tail=head| if and only if the list is empty.
+
+\yskip\hang|prev_graf| is the number of lines of the current paragraph that
+have already been put into the present vertical list.
+
+\yskip\hang|aux| is an auxiliary |memory_word| that gives further information
+that is needed to characterize the situation.
+
+\yskip\noindent
+In vertical mode, |aux| is also known as |prev_depth|; it is the scaled
+value representing the depth of the previous box, for use in baseline
+calculations, or it is |<=-1000|pt if the next box on the vertical list is to
+be exempt from baseline calculations.  In horizontal mode, |aux| is also
+known as |space_factor|; it holds the current space factor used in
+spacing calculations. In math mode, |aux| is also known as |incompleat_noad|; 
+if not |null|, it points to a record that represents the numerator of a
+generalized fraction for which the denominator is currently being formed
+in the current list.
+
+There is also a sixth quantity, |mode_line|, which correlates
+the semantic nest with the user's input; |mode_line| contains the source
+line number at which the current level of nesting was entered. The negative
+of this line number is the |mode_line| at the level of the
+user's output routine.
+
+A seventh quantity, |eTeX_aux|, is used by the extended features \eTeX.
+In math mode it is known as |delim_ptr| and points to the most
+recent |left_noad| or |middle_noad| of a |math_left_group|.
+
+In horizontal mode, the |prev_graf| field is used for initial language data.
+
+The semantic nest is an array called |nest| that holds the |mode|, |head|,
+|tail|, |prev_graf|, |aux|, and |mode_line| values for all semantic levels
+below the currently active one. Information about the currently active
+level is kept in the global quantities |mode|, |head|, |tail|, |prev_graf|,
+|aux|, and |mode_line|, which live in a \PASCAL\ record that is ready to
+be pushed onto |nest| if necessary.
+
+@d ignore_depth==-65536000 {|prev_depth| value that is ignored}
+
+@<Types...@>=
+@!list_state_record=record@!mode_field:-mmode..mmode;@+
+  @!head_field,@!tail_field: pointer;
+  @!eTeX_aux_field: pointer;
+  @!pg_field,@!ml_field: integer;@+
+  @!aux_field: memory_word;
+  @!dirs_field: halfword;
+  @!math_field: integer;
+  @!local_par_field: pointer;
+  @!local_par_bool_field: boolean;
+  end;
+
+@ @d mode==cur_list.mode_field {current mode}
+@d head==cur_list.head_field {header node of current list}
+@d tail==cur_list.tail_field {final node on current list}
+@d eTeX_aux==cur_list.eTeX_aux_field {auxiliary data for \eTeX}
+@d delim_ptr==eTeX_aux {most recent left or right noad of a math left group}
+@d prev_graf==cur_list.pg_field {number of paragraph lines accumulated}
+@d aux==cur_list.aux_field {auxiliary data about the current list}
+@d prev_depth==aux.sc {the name of |aux| in vertical mode}
+@d space_factor==aux.hh.lh {part of |aux| in horizontal mode}
+@d incompleat_noad==aux.int {the name of |aux| in math mode}
+@d mode_line==cur_list.ml_field {source file line number at beginning of list}
+@d dir_save==cur_list.dirs_field {dir stack when a paragraph is interrupted}
+@d dir_math_save==cur_list.math_field
+   {should begin/end dir nodes be placed around mathematics?}
+@d local_par==cur_list.local_par_field
+   {pointer to whatsit for local stuff}
+@d local_par_bool==cur_list.local_par_bool_field
+   {has local stuff been changed in this group?}
+
+@<Glob...@>=
+@!nest:array[0..nest_size] of list_state_record;
+@!nest_ptr:0..nest_size; {first unused location of |nest|}
+@!max_nest_stack:0..nest_size; {maximum of |nest_ptr| when pushing}
+@!cur_list:list_state_record; {the ``top'' semantic state}
+@!shown_mode:-mmode..mmode; {most recent mode shown by \.{\\tracingcommands}}
+@!save_tail: pointer; {save |tail| so we can examine whether we have an auto
+                       kern before a glue}
+
+@ Here is a common way to make the current list grow:
+
+@p 
+procedure tail_append(p:pointer);
+begin 
+vlink(tail):=p; tail:=vlink(tail);
+end;
+@#
+procedure new_tail_append(p:pointer);
+begin 
+couple_nodes(tail,p); tail:=vlink(tail);
+end;
+@#
+function pop_tail:pointer;
+label exit;
+var n,r:pointer;
+begin 
+  if tail<>head then begin
+    r:=tail;
+    if vlink(alink(tail))=tail then 
+      n:=alink(tail)
+    else begin
+      n:=head;
+      while vlink(n)<>tail do n:=vlink(n);
+      end;
+    flush_node(tail);
+    tail:=n;
+    vlink(n):=null;
+    pop_tail:=r;
+    end
+  else 
+    pop_tail:=null;
+exit:end;
+
+
+@ We will see later that the vertical list at the bottom semantic level is split
+into two parts; the ``current page'' runs from |page_head| to |page_tail|,
+and the ``contribution list'' runs from |contrib_head| to |tail| of
+semantic level zero. The idea is that contributions are first formed in
+vertical mode, then ``contributed'' to the current page (during which time
+the page-breaking decisions are made). For now, we don't need to know
+any more details about the page-building process.
+
+@<Set init...@>=
+nest_ptr:=0; max_nest_stack:=0;
+mode:=vmode; head:=contrib_head; tail:=contrib_head;
+eTeX_aux:=null;
+prev_depth:=ignore_depth; mode_line:=0;
+prev_graf:=0; shown_mode:=0;
+dir_save:=null; dir_math_save:=false;
+local_par:=null; local_par_bool:=false;
+@<Start a new current page@>;
+
+@ @p @<LOCAL: Declare |make_local_par_node|@>;
+
+@ @p @<DIR: Declare |new_dir|@>;
+
+@ When \TeX's work on one level is interrupted, the state is saved by
+calling |push_nest|. This routine changes |head| and |tail| so that
+a new (empty) list is begun; it does not change |mode| or |aux|.
+
+@p procedure push_nest; {enter a new semantic level, save the old}
+begin if nest_ptr>max_nest_stack then
+  begin max_nest_stack:=nest_ptr;
+  if nest_ptr=nest_size then overflow("semantic nest size",nest_size);
+@:TeX capacity exceeded semantic nest size}{\quad semantic nest size@>
+  end;
+nest[nest_ptr]:=cur_list; {stack the record}
+incr(nest_ptr); head:=new_node(temp_node,0); tail:=head; prev_graf:=0; mode_line:=line;
+dir_save:=null; dir_math_save:=false;
+local_par:=make_local_par_node; local_par_bool:=false;
+eTeX_aux:=null;
+end;
+
+@ Conversely, when \TeX\ is finished on the current level, the former
+state is restored by calling |pop_nest|. This routine will never be
+called at the lowest semantic level, nor will it be called unless |head|
+is a node that should be returned to free memory.
+
+@p procedure pop_nest; {leave a semantic level, re-enter the old}
+begin
+if local_par<>null then begin
+  if local_par_bool then begin end {|tail_append(local_par)|}
+  else flush_node(local_par);
+  end;
+flush_node(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
+end;
+
+@ Here is a procedure that displays what \TeX\ is working on, at all levels.
+
+@p procedure@?print_totals; forward;@t\2@>
+procedure show_activities;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!a:memory_word; {auxiliary}
+@!q,@!r:pointer; {for showing the current page}
+@!t:integer; {ditto}
+begin nest[nest_ptr]:=cur_list; {put the top level into the array}
+print_nl(""); print_ln;
+for p:=nest_ptr downto 0 do
+  begin m:=nest[p].mode_field; a:=nest[p].aux_field;
+  print_nl("### "); print_mode(m);
+  print(" entered at line "); print_int(abs(nest[p].ml_field));
+  if m=hmode then if nest[p].pg_field <> @'40600000 then
+    begin print(" (language"); print_int(nest[p].pg_field mod @'200000);
+    print(":hyphenmin"); print_int(nest[p].pg_field div @'20000000);
+    print_char(","); print_int((nest[p].pg_field div @'200000) mod @'100);
+    print_char(")");
+    end;
+  if nest[p].ml_field<0 then print(" (\output routine)");
+  if p=0 then
+    begin @<Show the status of the current page@>;
+    if vlink(contrib_head)<>null then
+      print_nl("### recent contributions:");
+    end;
+  show_box(vlink(nest[p].head_field));
+  @<Show the auxiliary field, |a|@>;
+  end;
+end;
+
+@ @<Show the auxiliary...@>=
+case abs(m) div (max_command+1) of
+0: begin print_nl("prevdepth ");
+  if a.sc<=ignore_depth then print("ignored")
+  else print_scaled(a.sc);
+  if nest[p].pg_field<>0 then
+    begin print(", prevgraf ");
+    print_int(nest[p].pg_field); print(" line");
+    if nest[p].pg_field<>1 then print_char("s");
+    end;
+  end;
+1: begin print_nl("spacefactor "); print_int(a.hh.lh);
+  if m>0 then@+ if a.hh.rh>0 then
+    begin print(", current language "); print_int(a.hh.rh);@+
+    end;
+  end;
+2: if a.int<>null then
+  begin print("this will be denominator of:"); show_box(a.int);@+
+  end;
+end {there are no other cases}
+
+@* \[17] The table of equivalents.
+Now that we have studied the data structures for \TeX's semantic routines,
+we ought to consider the data structures used by its syntactic routines. In
+other words, our next concern will be
+the tables that \TeX\ looks at when it is scanning
+what the user has written.
+
+The biggest and most important such table is called |eqtb|. It holds the
+current ``equivalents'' of things; i.e., it explains what things mean
+or what their current values are, for all quantities that are subject to
+the nesting structure provided by \TeX's grouping mechanism. There are six
+parts to |eqtb|:
+
+\yskip\hangg 1) |eqtb[active_base..(hash_base-1)]| holds the current
+equivalents of single-character control sequences.
+
+\yskip\hangg 2) |eqtb[hash_base..(glue_base-1)]| holds the current
+equivalents of multiletter control sequences.
+
+\yskip\hangg 3) |eqtb[glue_base..(local_base-1)]| holds the current
+equivalents of glue parameters like the current baselineskip.
+
+\yskip\hangg 4) |eqtb[local_base..(int_base-1)]| holds the current
+equivalents of local halfword quantities like the current box registers,
+the current ``catcodes,'' the current font, and a pointer to the current
+paragraph shape.
+
+\yskip\hangg 5) |eqtb[int_base..(dimen_base-1)]| holds the current
+equivalents of fullword integer parameters like the current hyphenation
+penalty.
+
+\yskip\hangg 6) |eqtb[dimen_base..eqtb_size]| holds the current equivalents
+of fullword dimension parameters like the current hsize or amount of
+hanging indentation.
+
+\yskip\noindent Note that, for example, the current amount of
+baselineskip glue is determined by the setting of a particular location
+in region~3 of |eqtb|, while the current meaning of the control sequence
+`\.{\\baselineskip}' (which might have been changed by \.{\\def} or
+\.{\\let}) appears in region~2.
+
+@ Each entry in |eqtb| is a |memory_word|. Most of these words are of type
+|two_halves|, and subdivided into three fields:
+
+\yskip\hangg 1) The |eq_level| (a quarterword) is the level of grouping at
+which this equivalent was defined. If the level is |level_zero|, the
+equivalent has never been defined; |level_one| refers to the outer level
+(outside of all groups), and this level is also used for global
+definitions that never go away. Higher levels are for equivalents that
+will disappear at the end of their group.  @^global definitions@>
+
+\yskip\hangg 2) The |eq_type| (another quarterword) specifies what kind of
+entry this is. There are many types, since each \TeX\ primitive like
+\.{\\hbox}, \.{\\def}, etc., has its own special code. The list of
+command codes above includes all possible settings of the |eq_type| field.
+
+\yskip\hangg 3) The |equiv| (a halfword) is the current equivalent value.
+This may be a font number, a pointer into |mem|, or a variety of other
+things.
+
+@d eq_level_field(#)==#.hh.b1
+@d eq_type_field(#)==#.hh.b0
+@d equiv_field(#)==#.hh.rh
+@d eq_level(#)==eq_level_field(eqtb[#]) {level of definition}
+@d eq_type(#)==eq_type_field(eqtb[#]) {command code for equivalent}
+@d equiv(#)==equiv_field(eqtb[#]) {equivalent value}
+@d level_zero=min_quarterword {level for undefined quantities}
+@d level_one=level_zero+1 {outermost level for defined quantities}
+
+@ Many locations in |eqtb| have symbolic names. The purpose of the next
+paragraphs is to define these names, and to set up the initial values of the
+equivalents.
+
+In the first region we have |number_active_chars| equivalents for ``active
+characters'' that act as control sequences.
+
+Then comes region~2, which corresponds to the hash table that we will
+define later.  The maximum address in this region is used for a dummy
+control sequence that is perpetually undefined. There also are several
+locations for control sequences that are perpetually defined
+(since they are used in error recovery).
+
+@d active_base=1 {beginning of region 1, for active character equivalents}
+@d null_cs=active_base+number_active_chars {equivalent of \.{\\csname\\endcsname}}
+@d hash_base=null_cs+1 {beginning of region 2, for the hash table}
+@d frozen_control_sequence=hash_base+hash_size {for error recovery}
+@d frozen_protection=frozen_control_sequence {inaccessible but definable}
+@d frozen_cr=frozen_control_sequence+1 {permanent `\.{\\cr}'}
+@d frozen_end_group=frozen_control_sequence+2 {permanent `\.{\\endgroup}'}
+@d frozen_right=frozen_control_sequence+3 {permanent `\.{\\right}'}
+@d frozen_fi=frozen_control_sequence+4 {permanent `\.{\\fi}'}
+@d frozen_end_template=frozen_control_sequence+5 {permanent `\.{\\endtemplate}'}
+@d frozen_endv=frozen_control_sequence+6 {second permanent `\.{\\endtemplate}'}
+@d frozen_relax=frozen_control_sequence+7 {permanent `\.{\\relax}'}
+@d end_write=frozen_control_sequence+8 {permanent `\.{\\endwrite}'}
+@d frozen_dont_expand=frozen_control_sequence+9
+  {permanent `\.{\\notexpanded:}'}
+@d frozen_primitive=frozen_control_sequence+11
+  {permanent `\.{\\pdfprimitive}'}
+@d frozen_null_font=frozen_control_sequence+12
+  {permanent `\.{\\nullfont}'}
+@d font_id_base=frozen_null_font-font_base
+  {begins table of |number_fonts| permanent font identifiers}
+@d frozen_null_ocp=frozen_null_font+number_fonts
+  {permanent `\.{\\nullocp}'}
+@d ocp_id_base=frozen_null_ocp-ocp_base
+  {begins table of |number_ocps| permanent ocp identifiers}
+@d frozen_null_ocp_list=frozen_null_ocp+number_ocps
+  {permanent `\.{\\nullocplist}'}
+@d ocp_list_id_base=frozen_null_ocp_list-ocp_list_base
+  {begins table of |number_ocp_lists| permanent ocp list identifiers}
+@d undefined_control_sequence=frozen_null_ocp_list+number_ocp_lists 
+@d glue_base=undefined_control_sequence+1 {beginning of region 3}
+
+@<Initialize table entries...@>=
+eq_type(undefined_control_sequence):=undefined_cs;
+equiv(undefined_control_sequence):=null;
+eq_level(undefined_control_sequence):=level_zero;
+for k:=active_base to undefined_control_sequence-1 do
+  eqtb[k]:=eqtb[undefined_control_sequence];
+
+@ Here is a routine that displays the current meaning of an |eqtb| entry
+in region 1 or~2. (Similar routines for the other regions will appear
+below.)
+
+@<Show equivalent |n|, in region 1 or 2@>=
+begin sprint_cs(n); print_char("="); print_cmd_chr(eq_type(n),equiv(n));
+if eq_type(n)>=call then
+  begin print_char(":"); show_token_list(link(equiv(n)),null,32);
+  end;
+end
+
+@ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, as well as the
+glue parameters defined here. It is important that the ``muskip''
+parameters have larger numbers than the others.
+
+@d line_skip_code=0 {interline glue if |baseline_skip| is infeasible}
+@d baseline_skip_code=1 {desired glue between baselines}
+@d par_skip_code=2 {extra glue just above a paragraph}
+@d above_display_skip_code=3 {extra glue just above displayed math}
+@d below_display_skip_code=4 {extra glue just below displayed math}
+@d above_display_short_skip_code=5
+  {glue above displayed math following short lines}
+@d below_display_short_skip_code=6
+  {glue below displayed math following short lines}
+@d left_skip_code=7 {glue at left of justified lines}
+@d right_skip_code=8 {glue at right of justified lines}
+@d top_skip_code=9 {glue at top of main pages}
+@d split_top_skip_code=10 {glue at top of split pages}
+@d tab_skip_code=11 {glue between aligned entries}
+@d space_skip_code=12 {glue between words (if not |zero_glue|)}
+@d xspace_skip_code=13 {glue after sentences (if not |zero_glue|)}
+@d par_fill_skip_code=14 {glue on last line of paragraph}
+@d thin_mu_skip_code=15 {thin space in math formula}
+@d med_mu_skip_code=16 {medium space in math formula}
+@d thick_mu_skip_code=17 {thick space in math formula}
+@d glue_pars=18 {total number of glue parameters}
+@d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers}
+@d mu_skip_base=skip_base+number_regs {table of |number_regs| ``muskip'' registers}
+@d local_base=mu_skip_base+number_regs {beginning of region 4}
+@#
+@d skip(#)==equiv(skip_base+#) {|mem| location of glue specification}
+@d mu_skip(#)==equiv(mu_skip_base+#) {|mem| location of math glue spec}
+@d glue_par(#)==equiv(glue_base+#) {|mem| location of glue specification}
+@d line_skip==glue_par(line_skip_code)
+@d baseline_skip==glue_par(baseline_skip_code)
+@d par_skip==glue_par(par_skip_code)
+@d above_display_skip==glue_par(above_display_skip_code)
+@d below_display_skip==glue_par(below_display_skip_code)
+@d above_display_short_skip==glue_par(above_display_short_skip_code)
+@d below_display_short_skip==glue_par(below_display_short_skip_code)
+@d left_skip==glue_par(left_skip_code)
+@d right_skip==glue_par(right_skip_code)
+@d top_skip==glue_par(top_skip_code)
+@d split_top_skip==glue_par(split_top_skip_code)
+@d tab_skip==glue_par(tab_skip_code)
+@d space_skip==glue_par(space_skip_code)
+@d xspace_skip==glue_par(xspace_skip_code)
+@d par_fill_skip==glue_par(par_fill_skip_code)
+@d thin_mu_skip==glue_par(thin_mu_skip_code)
+@d med_mu_skip==glue_par(med_mu_skip_code)
+@d thick_mu_skip==glue_par(thick_mu_skip_code)
+
+@<Current |mem| equivalent of glue parameter number |n|@>=glue_par(n)
+
+@ Sometimes we need to convert \TeX's internal code numbers into symbolic
+form. The |print_skip_param| routine gives the symbolic name of a glue
+parameter.
+
+@<Declare the procedure called |print_skip_param|@>=
+procedure print_skip_param(@!n:integer);
+begin case n of
+line_skip_code: print_esc("lineskip");
+baseline_skip_code: print_esc("baselineskip");
+par_skip_code: print_esc("parskip");
+above_display_skip_code: print_esc("abovedisplayskip");
+below_display_skip_code: print_esc("belowdisplayskip");
+above_display_short_skip_code: print_esc("abovedisplayshortskip");
+below_display_short_skip_code: print_esc("belowdisplayshortskip");
+left_skip_code: print_esc("leftskip");
+right_skip_code: print_esc("rightskip");
+top_skip_code: print_esc("topskip");
+split_top_skip_code: print_esc("splittopskip");
+tab_skip_code: print_esc("tabskip");
+space_skip_code: print_esc("spaceskip");
+xspace_skip_code: print_esc("xspaceskip");
+par_fill_skip_code: print_esc("parfillskip");
+thin_mu_skip_code: print_esc("thinmuskip");
+med_mu_skip_code: print_esc("medmuskip");
+thick_mu_skip_code: print_esc("thickmuskip");
+othercases print("[unknown glue parameter!]")
+endcases;
+end;
+
+@ The symbolic names for glue parameters are put into \TeX's hash table
+by using the routine called |primitive|, defined below. Let us enter them
+now, so that we don't have to list all those parameter names anywhere else.
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("lineskip",assign_glue,glue_base+line_skip_code);@/
+@!@:line_skip_}{\.{\\lineskip} primitive@>
+primitive("baselineskip",assign_glue,glue_base+baseline_skip_code);@/
+@!@:baseline_skip_}{\.{\\baselineskip} primitive@>
+primitive("parskip",assign_glue,glue_base+par_skip_code);@/
+@!@:par_skip_}{\.{\\parskip} primitive@>
+primitive("abovedisplayskip",assign_glue,glue_base+above_display_skip_code);@/
+@!@:above_display_skip_}{\.{\\abovedisplayskip} primitive@>
+primitive("belowdisplayskip",assign_glue,glue_base+below_display_skip_code);@/
+@!@:below_display_skip_}{\.{\\belowdisplayskip} primitive@>
+primitive("abovedisplayshortskip",
+  assign_glue,glue_base+above_display_short_skip_code);@/
+@!@:above_display_short_skip_}{\.{\\abovedisplayshortskip} primitive@>
+primitive("belowdisplayshortskip",
+  assign_glue,glue_base+below_display_short_skip_code);@/
+@!@:below_display_short_skip_}{\.{\\belowdisplayshortskip} primitive@>
+primitive("leftskip",assign_glue,glue_base+left_skip_code);@/
+@!@:left_skip_}{\.{\\leftskip} primitive@>
+primitive("rightskip",assign_glue,glue_base+right_skip_code);@/
+@!@:right_skip_}{\.{\\rightskip} primitive@>
+primitive("topskip",assign_glue,glue_base+top_skip_code);@/
+@!@:top_skip_}{\.{\\topskip} primitive@>
+primitive("splittopskip",assign_glue,glue_base+split_top_skip_code);@/
+@!@:split_top_skip_}{\.{\\splittopskip} primitive@>
+primitive("tabskip",assign_glue,glue_base+tab_skip_code);@/
+@!@:tab_skip_}{\.{\\tabskip} primitive@>
+primitive("spaceskip",assign_glue,glue_base+space_skip_code);@/
+@!@:space_skip_}{\.{\\spaceskip} primitive@>
+primitive("xspaceskip",assign_glue,glue_base+xspace_skip_code);@/
+@!@:xspace_skip_}{\.{\\xspaceskip} primitive@>
+primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/
+@!@:par_fill_skip_}{\.{\\parfillskip} primitive@>
+primitive("thinmuskip",assign_mu_glue,glue_base+thin_mu_skip_code);@/
+@!@:thin_mu_skip_}{\.{\\thinmuskip} primitive@>
+primitive("medmuskip",assign_mu_glue,glue_base+med_mu_skip_code);@/
+@!@:med_mu_skip_}{\.{\\medmuskip} primitive@>
+primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/
+@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@>
+
+@ @<Cases of |print_cmd_chr| for symbolic printing of primitives@>=
+assign_glue,assign_mu_glue: if chr_code<skip_base then
+    print_skip_param(chr_code-glue_base)
+  else if chr_code<mu_skip_base then
+    begin print_esc("skip"); print_int(chr_code-skip_base);
+    end
+  else  begin print_esc("muskip"); print_int(chr_code-mu_skip_base);
+    end;
+
+@ All glue parameters and registers are initially `\.{0pt plus0pt minus0pt}'.
+
+@<Initialize table entries...@>=
+equiv(glue_base):=zero_glue; eq_level(glue_base):=level_one;
+eq_type(glue_base):=glue_ref;
+for k:=glue_base+1 to local_base-1 do eqtb[k]:=eqtb[glue_base];
+glue_ref_count(zero_glue):=glue_ref_count(zero_glue)+local_base-glue_base;
+
+@ @<Show equivalent |n|, in region 3@>=
+if n<skip_base then
+  begin print_skip_param(n-glue_base); print_char("=");
+  if n<glue_base+thin_mu_skip_code then print_spec(equiv(n),"pt")
+  else print_spec(equiv(n),"mu");
+  end
+else if n<mu_skip_base then
+  begin print_esc("skip"); print_int(n-skip_base); print_char("=");
+  print_spec(equiv(n),"pt");
+  end
+else  begin print_esc("muskip"); print_int(n-mu_skip_base); print_char("=");
+  print_spec(equiv(n),"mu");
+  end
+
+@ Region 4 of |eqtb| contains the local quantities defined here. The
+bulk of this region is taken up by five tables that are indexed by eight-bit
+characters; these tables are important to both the syntactic and semantic
+portions of \TeX. There are also a bunch of special things like font and
+token parameters, as well as the tables of \.{\\toks} and \.{\\box}
+registers.
+
+@d par_shape_loc=local_base {specifies paragraph shape}
+@d output_routine_loc=local_base+1 {points to token list for \.{\\output}}
+@d every_par_loc=local_base+2 {points to token list for \.{\\everypar}}
+@d every_math_loc=local_base+3 {points to token list for \.{\\everymath}}
+@d every_display_loc=local_base+4 {points to token list for \.{\\everydisplay}}
+@d every_hbox_loc=local_base+5 {points to token list for \.{\\everyhbox}}
+@d every_vbox_loc=local_base+6 {points to token list for \.{\\everyvbox}}
+@d every_job_loc=local_base+7 {points to token list for \.{\\everyjob}}
+@d every_cr_loc=local_base+8 {points to token list for \.{\\everycr}}
+@d err_help_loc=local_base+9 {points to token list for \.{\\errhelp}}
+@d tex_toks=local_base+10 {end of \TeX's token list parameters}
+@#
+@d pdftex_first_loc       = tex_toks {base for \pdfTeX's token list parameters}
+@d pdf_pages_attr_loc     = pdftex_first_loc + 0 {points to token list for \.{\\pdfpagesattr}}
+@d pdf_page_attr_loc      = pdftex_first_loc + 1 {points to token list for \.{\\pdfpageattr}}
+@d pdf_page_resources_loc = pdftex_first_loc + 2 {points to token list for \.{\\pdfpageresources}}
+@d pdf_pk_mode_loc        = pdftex_first_loc + 3 {points to token list for \.{\\pdfpkmode}}
+@d pdf_toks=pdftex_first_loc+4 {end of \pdfTeX's token list parameters}
+@#
+@d etex_toks_base=pdf_toks {base for \eTeX's token list parameters}
+@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}}
+@d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters}
+@#
+@d ocp_trace_level_base=etex_toks
+@d ocp_active_number_base=ocp_trace_level_base+1
+@d ocp_active_min_ptr_base = ocp_active_number_base+1
+@d ocp_active_max_ptr_base = ocp_active_min_ptr_base+1
+@d ocp_active_base = ocp_active_max_ptr_base+1
+@d toks_base       = ocp_active_base+max_active_ocp_lists
+   {table of |number_regs| token list registers}
+@#
+@d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties}
+@d inter_line_penalties_loc=etex_pen_base {additional penalties between lines}
+@d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines}
+@d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines}
+@d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display}
+@d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties}
+@#
+@d local_left_box_base=etex_pens
+@d local_right_box_base=local_left_box_base+1
+@d box_base=local_right_box_base+1 {table of |number_regs| box registers}
+@d cur_font_loc=box_base+number_regs {internal font number outside math mode}
+@d math_font_base=cur_font_loc+1 
+   {table of |number_math_fonts| math font numbers}
+@d cat_code_base=math_font_base+number_math_fonts 
+   {table of |number_chars| command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+1 {table of |number_chars| lowercase mappings}
+@d uc_code_base=lc_code_base+1 {table of |number_chars| uppercase mappings}
+@d sf_code_base=uc_code_base+1 {table of |number_chars| spacefactor mappings}
+@d math_code_base=sf_code_base+1 {table of |number_chars| math mode mappings}
+@d int_base=math_code_base+1 {beginning of region 5}
+@#
+@d par_shape_ptr==equiv(par_shape_loc)
+@d output_routine==equiv(output_routine_loc)
+@d every_par==equiv(every_par_loc)
+@d every_math==equiv(every_math_loc)
+@d every_display==equiv(every_display_loc)
+@d every_hbox==equiv(every_hbox_loc)
+@d every_vbox==equiv(every_vbox_loc)
+@d every_job==equiv(every_job_loc)
+@d every_cr==equiv(every_cr_loc)
+@d err_help==equiv(err_help_loc)
+@d pdf_pages_attr==equiv(pdf_pages_attr_loc)
+@d pdf_page_attr==equiv(pdf_page_attr_loc)
+@d pdf_page_resources==equiv(pdf_page_resources_loc)
+@d pdf_pk_mode==equiv(pdf_pk_mode_loc)
+@d toks(#)==equiv(toks_base+#)
+@d local_left_box==equiv(local_left_box_base)
+@d local_right_box==equiv(local_right_box_base)
+@d box(#)==equiv(box_base+#)
+@d cur_font==equiv(cur_font_loc)
+@d fam_fnt(#)==equiv(math_font_base+#)
+
+@<Put each...@>=
+primitive("output",assign_toks,output_routine_loc);
+@!@:output_}{\.{\\output} primitive@>
+primitive("everypar",assign_toks,every_par_loc);
+@!@:every_par_}{\.{\\everypar} primitive@>
+primitive("everymath",assign_toks,every_math_loc);
+@!@:every_math_}{\.{\\everymath} primitive@>
+primitive("everydisplay",assign_toks,every_display_loc);
+@!@:every_display_}{\.{\\everydisplay} primitive@>
+primitive("everyhbox",assign_toks,every_hbox_loc);
+@!@:every_hbox_}{\.{\\everyhbox} primitive@>
+primitive("everyvbox",assign_toks,every_vbox_loc);
+@!@:every_vbox_}{\.{\\everyvbox} primitive@>
+primitive("everyjob",assign_toks,every_job_loc);
+@!@:every_job_}{\.{\\everyjob} primitive@>
+primitive("everycr",assign_toks,every_cr_loc);
+@!@:every_cr_}{\.{\\everycr} primitive@>
+primitive("errhelp",assign_toks,err_help_loc);
+@!@:err_help_}{\.{\\errhelp} primitive@>
+primitive("pdfpagesattr",assign_toks,pdf_pages_attr_loc);
+@!@:pdf_pages_attr_}{\.{\\pdfpagesattr} primitive@>
+primitive("pdfpageattr",assign_toks,pdf_page_attr_loc);
+@!@:pdf_page_attr_}{\.{\\pdfpageattr} primitive@>
+primitive("pdfpageresources",assign_toks,pdf_page_resources_loc);
+@!@:pdf_page_resources_}{\.{\\pdfpageresources} primitive@>
+primitive("pdfpkmode",assign_toks,pdf_pk_mode_loc);
+@!@:pdf_pk_mode_}{\.{\\pdfpkmode} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_toks: if chr_code>=toks_base then
+  begin print_esc("toks"); print_int(chr_code-toks_base);
+  end
+else  case chr_code of
+  output_routine_loc: print_esc("output");
+  every_par_loc: print_esc("everypar");
+  every_math_loc: print_esc("everymath");
+  every_display_loc: print_esc("everydisplay");
+  every_hbox_loc: print_esc("everyhbox");
+  every_vbox_loc: print_esc("everyvbox");
+  every_job_loc: print_esc("everyjob");
+  every_cr_loc: print_esc("everycr");
+  @/@<Cases of |assign_toks| for |print_cmd_chr|@>@/
+  pdf_pages_attr_loc: print_esc("pdfpagesattr");
+  pdf_page_attr_loc: print_esc("pdfpageattr");
+  pdf_page_resources_loc: print_esc("pdfpageresources");
+  pdf_pk_mode_loc: print_esc("pdfpkmode");
+  othercases print_esc("errhelp")
+  endcases;
+
+@ We initialize most things to null or undefined values. An undefined font
+is represented by the internal code |font_base|.
+
+However, the character code tables are given initial values based on the
+conventional interpretation of ASCII code. These initial values should
+not be changed when \TeX\ is adapted for use with non-English languages;
+all changes to the initialization conventions should be made in format
+packages, not in \TeX\ itself, so that global interchange of formats is
+possible.
+
+@d null_font==font_base
+@d null_ocp==ocp_base
+@d null_ocp_list==ocp_list_base
+@d var_code==@"7000000 {math code meaning ``use the current family''}
+
+@<Initialize table entries...@>=
+par_shape_ptr:=null; eq_type(par_shape_loc):=shape_ref;
+eq_level(par_shape_loc):=level_one;@/
+for k:=etex_pen_base to etex_pens-1 do
+  eqtb[k]:=eqtb[par_shape_loc];
+for k:=output_routine_loc to toks_base+biggest_reg do
+  eqtb[k]:=eqtb[undefined_control_sequence];
+box(0):=null; eq_type(box_base):=box_ref; eq_level(box_base):=level_one;
+for k:=box_base+1 to box_base+biggest_reg do eqtb[k]:=eqtb[box_base];
+cur_font:=null_font; eq_type(cur_font_loc):=data;
+eq_level(cur_font_loc):=level_one;@/
+for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc];
+equiv(cat_code_base):=0; eq_type(cat_code_base):=data;
+eq_level(cat_code_base):=level_one;@/
+eqtb[lc_code_base] :=eqtb[cat_code_base];
+eqtb[uc_code_base] :=eqtb[cat_code_base];
+eqtb[sf_code_base] :=eqtb[cat_code_base];
+eqtb[math_code_base]:=eqtb[cat_code_base];@/
+cat_code_table:=0;
+initex_cat_codes(0);
+for k:="0" to "9" do set_math_code(k,(hi(k+var_code)),level_one);@/
+for k:="A" to "Z" do begin 
+  set_math_code(k,(hi(k+var_code+@"10000)),level_one);
+  set_math_code(k+32,(hi(k+32+var_code+@"10000)),level_one);@/
+  set_lc_code(k,k+32,level_one); set_lc_code(k+32,k+32,level_one);@/
+  set_uc_code(k,k,level_one);    set_uc_code(k+32,k,level_one);@/
+  set_sf_code(k,999,level_one);
+  end;
+
+@ @<Set init...@>=
+static_int_base:=int_base;
+initialize_math_codes;
+initialize_text_codes;
+
+@ @<Show equivalent |n|, in region 4@>=
+if (n=par_shape_loc) or ((n>=etex_pen_base) and (n<etex_pens)) then
+  begin print_cmd_chr(set_shape,n); print_char("=");
+  if equiv(n)=null then print_char("0")
+  else if n>par_shape_loc then
+    begin print_int(penalty(equiv(n))); print_char(" ");
+    print_int(penalty(equiv(n)+1));
+    if penalty(equiv(n))>1 then print_esc("ETC.");
+    end
+  else print_int(vinfo(par_shape_ptr));
+  end
+else if n<toks_base then
+  {TH TODO make extra cases for ocps here! }
+  begin print_cmd_chr(assign_toks,n); print_char("=");
+  if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
+  end
+else if n<box_base then
+  begin print_esc("toks"); print_int(n-toks_base); print_char("=");
+  if equiv(n)<>null then show_token_list(link(equiv(n)),null,32);
+  end
+else if n<cur_font_loc then
+  begin print_esc("box"); print_int(n-box_base); print_char("=");
+  if equiv(n)=null then print("void")
+  else  begin depth_threshold:=0; breadth_max:=1; show_node_list(equiv(n));
+    end;
+  end
+else if n<cat_code_base then @<Show the font identifier in |eqtb[n]|@>
+else @<Show the halfword code in |eqtb[n]|@>
+
+@ @<Show the font identifier in |eqtb[n]|@>=
+begin if n=cur_font_loc then print("current font")
+else if n<math_font_base+script_size then
+  begin print_esc("textfont"); print_int(n-math_font_base);
+  end
+else if n<math_font_base+script_script_size then
+  begin print_esc("scriptfont"); print_int(n-math_font_base-script_size);
+  end
+else  begin print_esc("scriptscriptfont"); print_int(n-math_font_base-script_script_size);
+  end;
+print_char("=");@/
+print_esc(hash[font_id_base+equiv(n)].rh);
+  {that's |font_id_text(equiv(n))|}
+end
+
+@ 
+@d is_omath(#)==  ((((#) mod @"1000000) div @"10000)>15) or
+     (((#) mod @"10000)>255)
+
+@<Show the halfword code in |eqtb[n]|@>=
+if n<math_code_base then
+  begin if n<lc_code_base then
+    begin print_esc("catcode"); print_int(n-cat_code_base);
+    end
+  else if n<uc_code_base then
+    begin print_esc("lccode"); print_int(n-lc_code_base);
+    end
+  else if n<sf_code_base then
+    begin print_esc("uccode"); print_int(n-uc_code_base);
+    end
+  else  begin print_esc("sfcode"); print_int(n-sf_code_base);
+    end;
+  print_char("="); print_int(equiv(n));
+  end
+else begin 
+  if is_omath(get_math_code(n-math_code_base)) then
+    print_esc("omathcode")
+  else    
+    print_esc("mathcode"); 
+  print_int(n-math_code_base);
+  print_char("="); print_int(get_math_code(n-math_code_base));
+  end
+
+@ Region 5 of |eqtb| contains the integer parameters and registers defined
+here, as well as the |del_code| table. The latter table differs from the
+|cat_code..math_code| tables that precede it, since delimiter codes are
+fullword integers while the other kinds of codes occupy at most a
+halfword. This is what makes region~5 different from region~4. We will
+store the |eq_level| information in an auxiliary array of quarterwords
+that will be defined later.
+
+@d pretolerance_code=0 {badness tolerance before hyphenation}
+@d tolerance_code=1 {badness tolerance after hyphenation}
+@d line_penalty_code=2 {added to the badness of every line}
+@d hyphen_penalty_code=3 {penalty for break after discretionary hyphen}
+@d ex_hyphen_penalty_code=4 {penalty for break after explicit hyphen}
+@d club_penalty_code=5 {penalty for creating a club line}
+@d widow_penalty_code=6 {penalty for creating a widow line}
+@d display_widow_penalty_code=7 {ditto, just before a display}
+@d broken_penalty_code=8 {penalty for breaking a page at a broken line}
+@d bin_op_penalty_code=9 {penalty for breaking after a binary operation}
+@d rel_penalty_code=10 {penalty for breaking after a relation}
+@d pre_display_penalty_code=11
+  {penalty for breaking just before a displayed formula}
+@d post_display_penalty_code=12
+  {penalty for breaking just after a displayed formula}
+@d inter_line_penalty_code=13 {additional penalty between lines}
+@d double_hyphen_demerits_code=14 {demerits for double hyphen break}
+@d final_hyphen_demerits_code=15 {demerits for final hyphen break}
+@d adj_demerits_code=16 {demerits for adjacent incompatible lines}
+@d mag_code=17 {magnification ratio}
+@d delimiter_factor_code=18 {ratio for variable-size delimiters}
+@d looseness_code=19 {change in number of lines for a paragraph}
+@d time_code=20 {current time of day}
+@d day_code=21 {current day of the month}
+@d month_code=22 {current month of the year}
+@d year_code=23 {current year of our Lord}
+@d show_box_breadth_code=24 {nodes per level in |show_box|}
+@d show_box_depth_code=25 {maximum level in |show_box|}
+@d hbadness_code=26 {hboxes exceeding this badness will be shown by |hpack|}
+@d vbadness_code=27 {vboxes exceeding this badness will be shown by |vpack|}
+@d pausing_code=28 {pause after each line is read from a file}
+@d tracing_online_code=29 {show diagnostic output on terminal}
+@d tracing_macros_code=30 {show macros as they are being expanded}
+@d tracing_stats_code=31 {show memory usage if \TeX\ knows it}
+@d tracing_paragraphs_code=32 {show line-break calculations}
+@d tracing_pages_code=33 {show page-break calculations}
+@d tracing_output_code=34 {show boxes when they are shipped out}
+@d tracing_lost_chars_code=35 {show characters that aren't in the font}
+@d tracing_commands_code=36 {show command codes at |big_switch|}
+@d tracing_restores_code=37 {show equivalents when they are restored}
+@d uc_hyph_code=38 {hyphenate words beginning with a capital letter}
+@d output_penalty_code=39 {penalty found at current page break}
+@d max_dead_cycles_code=40 {bound on consecutive dead cycles of output}
+@d hang_after_code=41 {hanging indentation changes after this many lines}
+@d floating_penalty_code=42 {penalty for insertions heldover after a split}
+@d global_defs_code=43 {override \.{\\global} specifications}
+@d cur_fam_code=44 {current family}
+@d escape_char_code=45 {escape character for token output}
+@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded}
+@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded}
+@d end_line_char_code=48 {character placed at the right end of the buffer}
+@d new_line_char_code=49 {character that prints as |print_ln|}
+@d language_code=50 {current hyphenation table}
+@d left_hyphen_min_code=51 {minimum left hyphenation fragment size}
+@d right_hyphen_min_code=52 {minimum right hyphenation fragment size}
+@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}}
+@d error_context_lines_code=54 {maximum intermediate line pairs shown}
+@d local_inter_line_penalty_code=55 {local \.{\\interlinepenalty}}
+@d local_broken_penalty_code=56 {local \.{\\brokenpenalty}}
+@d no_local_whatsits_code=57 {counts local whatsits}
+@d no_local_dirs_code=58
+@d level_local_dir_code=59
+@d luastartup_id_code=60
+@d disable_lig_code=61
+@d disable_kern_code=62
+@d cat_code_table_code=63
+@d cur_lang_code=64 {current language id}
+@d ex_hyphen_char_code=65
+@d tex_int_pars=66 {total number of \.{\\TeX} + Aleph integer parameters}
+@#
+@d dir_base=int_base+tex_int_pars
+@d page_direction_code=0
+@d body_direction_code=1
+@d par_direction_code=2
+@d text_direction_code=3
+@d math_direction_code=4
+@d dir_pars=5
+@#
+@d pdftex_first_integer_code = dir_base+dir_pars {base for \pdfTeX's integer parameters}
+@d pdf_output_code           = pdftex_first_integer_code + 0 {switch on PDF output if positive}
+@d pdf_compress_level_code   = pdftex_first_integer_code + 1 {compress level of streams}
+@d pdf_decimal_digits_code   = pdftex_first_integer_code + 2 {digits after the decimal point of numbers}
+@d pdf_move_chars_code       = pdftex_first_integer_code + 3 {move chars 0..31 to higher area if possible}
+@d pdf_image_resolution_code = pdftex_first_integer_code + 4 {default image resolution}
+@d pdf_pk_resolution_code    = pdftex_first_integer_code + 5 {default resolution of PK font}
+@d pdf_unique_resname_code   = pdftex_first_integer_code + 6 {generate unique names for resouces}
+@d pdf_option_always_use_pdfpagebox_code = pdftex_first_integer_code + 7 {if the PDF inclusion should always use a specific PDF page box}
+@d pdf_option_pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 8 {if the PDF inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_minor_version_code = pdftex_first_integer_code + 9 {fractional part of the PDF version produced}
+@d pdf_force_pagebox_code = pdftex_first_integer_code + 10 {if the PDF inclusion should always use a specific PDF page box}
+@d pdf_pagebox_code = pdftex_first_integer_code + 11 {default pagebox to use for PDF inclusion}
+@d pdf_inclusion_errorlevel_code = pdftex_first_integer_code + 12 {if the PDF inclusion should treat pdfs newer than |pdf_minor_version| as an error}
+@d pdf_gamma_code            = pdftex_first_integer_code + 13
+@d pdf_image_gamma_code      = pdftex_first_integer_code + 14
+@d pdf_image_hicolor_code    = pdftex_first_integer_code + 15
+@d pdf_image_apply_gamma_code = pdftex_first_integer_code + 16
+@d pdf_adjust_spacing_code   = pdftex_first_integer_code + 17 {level of spacing adjusting}
+@d pdf_protrude_chars_code   = pdftex_first_integer_code + 18 {protrude chars at left/right edge of paragraphs}
+@d pdf_tracing_fonts_code    = pdftex_first_integer_code + 19 {level of font detail in log}
+@d pdf_objcompresslevel_code = pdftex_first_integer_code + 20 {activate object streams}
+@d pdf_gen_tounicode_code    = pdftex_first_integer_code + 24 {generate ToUnicode for fonts?}
+@d pdf_draftmode_code        = pdftex_first_integer_code + 25 {switch on draftmode if positive}
+@d pdf_replace_font_code     = pdftex_first_integer_code + 26 {generate ToUnicode for fonts?}
+@d pdf_int_pars=pdftex_first_integer_code + 27 {total number of \pdfTeX's integer parameters}
+@#
+@d etex_int_base=pdf_int_pars {base for \eTeX's integer parameters}
+@d tracing_assigns_code=etex_int_base {show assignments}
+@d tracing_groups_code=etex_int_base+1 {show save/restore groups}
+@d tracing_ifs_code=etex_int_base+2 {show conditionals}
+@d tracing_scan_tokens_code=etex_int_base+3 {show pseudo file open and close}
+@d tracing_nesting_code=etex_int_base+4 {show incomplete groups and ifs within files}
+@d pre_display_direction_code=etex_int_base+5 {text direction preceding a display}
+@d last_line_fit_code=etex_int_base+6 {adjustment for last line of paragraph}
+@d saving_vdiscards_code=etex_int_base+7 {save items discarded from vlists}
+@d saving_hyph_codes_code=etex_int_base+8 {save hyphenation codes for languages}
+@d suppress_fontnotfound_error_code=etex_int_base+9 {surpress errors for missing fonts}
+@d etex_int_pars=etex_int_base+10 {total number of \eTeX's integer parameters}
+@#
+@d int_pars=etex_int_pars {total number of integer parameters}
+@d count_base=int_base+int_pars {|number_regs| user \.{\\count} registers}
+@d attribute_base=count_base+number_regs {|number_attrs| user \.{\\attribute} registers}
+@d del_code_base=attribute_base+number_attrs {|number_chars| delimiter code mappings}
+@d dimen_base=del_code_base+1 {beginning of region 6}
+@#
+@d count(#)==eqtb[count_base+#].int
+@d attribute(#)==eqtb[attribute_base+#].int
+@d int_par(#)==eqtb[int_base+#].int {an integer parameter}
+@d pretolerance==int_par(pretolerance_code)
+@d tolerance==int_par(tolerance_code)
+@d line_penalty==int_par(line_penalty_code)
+@d hyphen_penalty==int_par(hyphen_penalty_code)
+@d ex_hyphen_penalty==int_par(ex_hyphen_penalty_code)
+@d club_penalty==int_par(club_penalty_code)
+@d widow_penalty==int_par(widow_penalty_code)
+@d display_widow_penalty==int_par(display_widow_penalty_code)
+@d broken_penalty==int_par(broken_penalty_code)
+@d bin_op_penalty==int_par(bin_op_penalty_code)
+@d rel_penalty==int_par(rel_penalty_code)
+@d pre_display_penalty==int_par(pre_display_penalty_code)
+@d post_display_penalty==int_par(post_display_penalty_code)
+@d inter_line_penalty==int_par(inter_line_penalty_code)
+@d double_hyphen_demerits==int_par(double_hyphen_demerits_code)
+@d final_hyphen_demerits==int_par(final_hyphen_demerits_code)
+@d adj_demerits==int_par(adj_demerits_code)
+@d mag==int_par(mag_code)
+@d delimiter_factor==int_par(delimiter_factor_code)
+@d looseness==int_par(looseness_code)
+@d time==int_par(time_code)
+@d day==int_par(day_code)
+@d month==int_par(month_code)
+@d year==int_par(year_code)
+@d show_box_breadth==int_par(show_box_breadth_code)
+@d show_box_depth==int_par(show_box_depth_code)
+@d hbadness==int_par(hbadness_code)
+@d vbadness==int_par(vbadness_code)
+@d pausing==int_par(pausing_code)
+@d tracing_online==int_par(tracing_online_code)
+@d tracing_macros==int_par(tracing_macros_code)
+@d tracing_stats==int_par(tracing_stats_code)
+@d tracing_paragraphs==int_par(tracing_paragraphs_code)
+@d tracing_pages==int_par(tracing_pages_code)
+@d tracing_output==int_par(tracing_output_code)
+@d tracing_lost_chars==int_par(tracing_lost_chars_code)
+@d tracing_commands==int_par(tracing_commands_code)
+@d tracing_restores==int_par(tracing_restores_code)
+@d uc_hyph==int_par(uc_hyph_code)
+@d output_penalty==int_par(output_penalty_code)
+@d max_dead_cycles==int_par(max_dead_cycles_code)
+@d hang_after==int_par(hang_after_code)
+@d floating_penalty==int_par(floating_penalty_code)
+@d global_defs==int_par(global_defs_code)
+@d cur_fam==int_par(cur_fam_code)
+@d escape_char==int_par(escape_char_code)
+@d default_hyphen_char==int_par(default_hyphen_char_code)
+@d default_skew_char==int_par(default_skew_char_code)
+@d end_line_char==int_par(end_line_char_code)
+@d new_line_char==int_par(new_line_char_code)
+@d local_inter_line_penalty==int_par(local_inter_line_penalty_code)
+@d local_broken_penalty==int_par(local_broken_penalty_code)
+@d no_local_whatsits==int_par(no_local_whatsits_code)
+@d no_local_dirs==int_par(no_local_dirs_code)
+@d level_local_dir==int_par(level_local_dir_code)
+@d dir_par(#)==eqtb[dir_base+#].int {a direction parameter}
+@d page_direction==dir_par(page_direction_code)
+@d body_direction==dir_par(body_direction_code)
+@d par_direction==dir_par(par_direction_code)
+@d text_direction==dir_par(text_direction_code)
+@d math_direction==dir_par(math_direction_code)
+@d language==int_par(language_code)
+@d cur_lang==int_par(cur_lang_code)
+@d ex_hyphen_char==int_par(ex_hyphen_char_code)
+@d left_hyphen_min==int_par(left_hyphen_min_code)
+@d right_hyphen_min==int_par(right_hyphen_min_code)
+@d holding_inserts==int_par(holding_inserts_code)
+@d error_context_lines==int_par(error_context_lines_code)
+@d luastartup_id==int_par(luastartup_id_code)
+@d disable_lig==int_par(disable_lig_code)
+@d disable_kern==int_par(disable_kern_code)
+@d cat_code_table==int_par(cat_code_table_code)
+@#
+@d pdf_adjust_spacing   == int_par(pdf_adjust_spacing_code)
+@d pdf_protrude_chars   == int_par(pdf_protrude_chars_code)
+@d pdf_tracing_fonts    == int_par(pdf_tracing_fonts_code)
+@d pdf_gen_tounicode    == int_par(pdf_gen_tounicode_code)
+@d pdf_output           == int_par(pdf_output_code)
+@d pdf_compress_level   == int_par(pdf_compress_level_code)
+@d pdf_objcompresslevel == int_par(pdf_objcompresslevel_code)
+@d pdf_decimal_digits   == int_par(pdf_decimal_digits_code)
+@d pdf_move_chars       == int_par(pdf_move_chars_code)
+@d pdf_image_resolution == int_par(pdf_image_resolution_code)
+@d pdf_pk_resolution    == int_par(pdf_pk_resolution_code)
+@d pdf_unique_resname   == int_par(pdf_unique_resname_code)
+@d pdf_option_always_use_pdfpagebox == int_par(pdf_option_always_use_pdfpagebox_code)
+@d pdf_option_pdf_inclusion_errorlevel == int_par(pdf_option_pdf_inclusion_errorlevel_code)
+@d pdf_minor_version == int_par(pdf_minor_version_code)
+@d pdf_force_pagebox == int_par(pdf_force_pagebox_code)
+@d pdf_pagebox == int_par(pdf_pagebox_code)
+@d pdf_inclusion_errorlevel == int_par(pdf_inclusion_errorlevel_code)
+@d pdf_gamma            == int_par(pdf_gamma_code)
+@d pdf_image_gamma      == int_par(pdf_image_gamma_code)
+@d pdf_image_hicolor    == int_par(pdf_image_hicolor_code)
+@d pdf_image_apply_gamma == int_par(pdf_image_apply_gamma_code)
+@d pdf_draftmode        == int_par(pdf_draftmode_code)
+@d pdf_replace_font == int_par(pdf_replace_font_code)
+@#
+@d tracing_assigns==int_par(tracing_assigns_code)
+@d tracing_groups==int_par(tracing_groups_code)
+@d tracing_ifs==int_par(tracing_ifs_code)
+@d tracing_scan_tokens==int_par(tracing_scan_tokens_code)
+@d tracing_nesting==int_par(tracing_nesting_code)
+@d pre_display_direction==int_par(pre_display_direction_code)
+@d last_line_fit==int_par(last_line_fit_code)
+@d saving_vdiscards==int_par(saving_vdiscards_code)
+@d saving_hyph_codes==int_par(saving_hyph_codes_code)
+@d suppress_fontnotfound_error==int_par(suppress_fontnotfound_error_code)
+
+@<Assign the values |depth_threshold:=show_box_depth|...@>=
+depth_threshold:=show_box_depth;
+breadth_max:=show_box_breadth
+
+@ We can print the symbolic name of an integer parameter as follows.
+
+@p procedure print_param(@!n:integer);
+begin case n of
+pretolerance_code:print_esc("pretolerance");
+tolerance_code:print_esc("tolerance");
+line_penalty_code:print_esc("linepenalty");
+hyphen_penalty_code:print_esc("hyphenpenalty");
+ex_hyphen_penalty_code:print_esc("exhyphenpenalty");
+club_penalty_code:print_esc("clubpenalty");
+widow_penalty_code:print_esc("widowpenalty");
+display_widow_penalty_code:print_esc("displaywidowpenalty");
+broken_penalty_code:print_esc("brokenpenalty");
+bin_op_penalty_code:print_esc("binoppenalty");
+rel_penalty_code:print_esc("relpenalty");
+pre_display_penalty_code:print_esc("predisplaypenalty");
+post_display_penalty_code:print_esc("postdisplaypenalty");
+inter_line_penalty_code:print_esc("interlinepenalty");
+double_hyphen_demerits_code:print_esc("doublehyphendemerits");
+final_hyphen_demerits_code:print_esc("finalhyphendemerits");
+adj_demerits_code:print_esc("adjdemerits");
+mag_code:print_esc("mag");
+delimiter_factor_code:print_esc("delimiterfactor");
+looseness_code:print_esc("looseness");
+time_code:print_esc("time");
+day_code:print_esc("day");
+month_code:print_esc("month");
+year_code:print_esc("year");
+show_box_breadth_code:print_esc("showboxbreadth");
+show_box_depth_code:print_esc("showboxdepth");
+hbadness_code:print_esc("hbadness");
+vbadness_code:print_esc("vbadness");
+pausing_code:print_esc("pausing");
+tracing_online_code:print_esc("tracingonline");
+tracing_macros_code:print_esc("tracingmacros");
+tracing_stats_code:print_esc("tracingstats");
+tracing_paragraphs_code:print_esc("tracingparagraphs");
+tracing_pages_code:print_esc("tracingpages");
+tracing_output_code:print_esc("tracingoutput");
+tracing_lost_chars_code:print_esc("tracinglostchars");
+tracing_commands_code:print_esc("tracingcommands");
+tracing_restores_code:print_esc("tracingrestores");
+uc_hyph_code:print_esc("uchyph");
+output_penalty_code:print_esc("outputpenalty");
+max_dead_cycles_code:print_esc("maxdeadcycles");
+hang_after_code:print_esc("hangafter");
+floating_penalty_code:print_esc("floatingpenalty");
+global_defs_code:print_esc("globaldefs");
+cur_fam_code:print_esc("fam");
+escape_char_code:print_esc("escapechar");
+default_hyphen_char_code:print_esc("defaulthyphenchar");
+default_skew_char_code:print_esc("defaultskewchar");
+end_line_char_code:print_esc("endlinechar");
+new_line_char_code:print_esc("newlinechar");
+language_code:print_esc("language");
+cur_lang_code:print_esc("setlanguage");
+ex_hyphen_char_code:print_esc("exhyphenchar");
+left_hyphen_min_code:print_esc("lefthyphenmin");
+right_hyphen_min_code:print_esc("righthyphenmin");
+holding_inserts_code:print_esc("holdinginserts");
+error_context_lines_code:print_esc("errorcontextlines");
+luastartup_id_code:print_esc("luastartup");
+disable_lig_code:print_esc("noligs");
+disable_kern_code:print_esc("nokerns");
+cat_code_table_code:print_esc("catcodetable");
+@#
+local_inter_line_penalty_code: print_esc("localinterlinepenalty");
+local_broken_penalty_code: print_esc("localbrokenpenalty");
+{the next three do not have a matching primitive}
+no_local_whatsits_code: print("[no_local_whatsits]");
+no_local_dirs_code: print("[no_local_dirs]");
+level_local_dir_code: print("[level_local_dir]");
+@#
+pdf_output_code:           print_esc("pdfoutput");
+pdf_compress_level_code:   print_esc("pdfcompresslevel");
+pdf_objcompresslevel_code: print_esc("pdfobjcompresslevel");
+pdf_decimal_digits_code:   print_esc("pdfdecimaldigits");
+pdf_move_chars_code:       print_esc("pdfmovechars");
+pdf_image_resolution_code: print_esc("pdfimageresolution");
+pdf_pk_resolution_code:    print_esc("pdfpkresolution");
+pdf_unique_resname_code:   print_esc("pdfuniqueresname");
+pdf_option_always_use_pdfpagebox_code: print_esc("pdfoptionalwaysusepdfpagebox");
+pdf_option_pdf_inclusion_errorlevel_code: print_esc("pdfoptionpdfinclusionerrorlevel");
+pdf_minor_version_code: print_esc("pdfminorversion");
+pdf_force_pagebox_code: print_esc("pdfforcepagebox");
+pdf_pagebox_code: print_esc("pdfpagebox");
+pdf_inclusion_errorlevel_code: print_esc("pdfinclusionerrorlevel");
+pdf_gamma_code:            print_esc("pdfgamma");
+pdf_image_gamma_code:      print_esc("pdfimagegamma");
+pdf_image_hicolor_code:    print_esc("pdfimagehicolor");
+pdf_image_apply_gamma_code: print_esc("pdfimageapplygamma");
+pdf_adjust_spacing_code:   print_esc("pdfadjustspacing");
+pdf_protrude_chars_code:   print_esc("pdfprotrudechars");
+pdf_tracing_fonts_code:    print_esc("pdftracingfonts");
+pdf_gen_tounicode_code:    print_esc("pdfgentounicode");
+pdf_draftmode_code:        print_esc("pdfdraftmode");
+pdf_replace_font_code:    print_esc("pdfreplacefont");
+@/@<Cases for |print_param|@>@/
+othercases begin print("[unknown integer parameter!]"); end
+endcases;
+end;
+
+@ The integer parameter names must be entered into the hash table.
+
+@<Put each...@>=
+primitive("pretolerance",assign_int,int_base+pretolerance_code);@/
+@!@:pretolerance_}{\.{\\pretolerance} primitive@>
+primitive("tolerance",assign_int,int_base+tolerance_code);@/
+@!@:tolerance_}{\.{\\tolerance} primitive@>
+primitive("linepenalty",assign_int,int_base+line_penalty_code);@/
+@!@:line_penalty_}{\.{\\linepenalty} primitive@>
+primitive("hyphenpenalty",assign_int,int_base+hyphen_penalty_code);@/
+@!@:hyphen_penalty_}{\.{\\hyphenpenalty} primitive@>
+primitive("exhyphenpenalty",assign_int,int_base+ex_hyphen_penalty_code);@/
+@!@:ex_hyphen_penalty_}{\.{\\exhyphenpenalty} primitive@>
+primitive("clubpenalty",assign_int,int_base+club_penalty_code);@/
+@!@:club_penalty_}{\.{\\clubpenalty} primitive@>
+primitive("widowpenalty",assign_int,int_base+widow_penalty_code);@/
+@!@:widow_penalty_}{\.{\\widowpenalty} primitive@>
+primitive("displaywidowpenalty",
+  assign_int,int_base+display_widow_penalty_code);@/
+@!@:display_widow_penalty_}{\.{\\displaywidowpenalty} primitive@>
+primitive("brokenpenalty",assign_int,int_base+broken_penalty_code);@/
+@!@:broken_penalty_}{\.{\\brokenpenalty} primitive@>
+primitive("binoppenalty",assign_int,int_base+bin_op_penalty_code);@/
+@!@:bin_op_penalty_}{\.{\\binoppenalty} primitive@>
+primitive("relpenalty",assign_int,int_base+rel_penalty_code);@/
+@!@:rel_penalty_}{\.{\\relpenalty} primitive@>
+primitive("predisplaypenalty",assign_int,int_base+pre_display_penalty_code);@/
+@!@:pre_display_penalty_}{\.{\\predisplaypenalty} primitive@>
+primitive("postdisplaypenalty",assign_int,int_base+post_display_penalty_code);@/
+@!@:post_display_penalty_}{\.{\\postdisplaypenalty} primitive@>
+primitive("interlinepenalty",assign_int,int_base+inter_line_penalty_code);@/
+@!@:inter_line_penalty_}{\.{\\interlinepenalty} primitive@>
+primitive("doublehyphendemerits",
+  assign_int,int_base+double_hyphen_demerits_code);@/
+@!@:double_hyphen_demerits_}{\.{\\doublehyphendemerits} primitive@>
+primitive("finalhyphendemerits",
+  assign_int,int_base+final_hyphen_demerits_code);@/
+@!@:final_hyphen_demerits_}{\.{\\finalhyphendemerits} primitive@>
+primitive("adjdemerits",assign_int,int_base+adj_demerits_code);@/
+@!@:adj_demerits_}{\.{\\adjdemerits} primitive@>
+primitive("mag",assign_int,int_base+mag_code);@/
+@!@:mag_}{\.{\\mag} primitive@>
+primitive("delimiterfactor",assign_int,int_base+delimiter_factor_code);@/
+@!@:delimiter_factor_}{\.{\\delimiterfactor} primitive@>
+primitive("looseness",assign_int,int_base+looseness_code);@/
+@!@:looseness_}{\.{\\looseness} primitive@>
+primitive("time",assign_int,int_base+time_code);@/
+@!@:time_}{\.{\\time} primitive@>
+primitive("day",assign_int,int_base+day_code);@/
+@!@:day_}{\.{\\day} primitive@>
+primitive("month",assign_int,int_base+month_code);@/
+@!@:month_}{\.{\\month} primitive@>
+primitive("year",assign_int,int_base+year_code);@/
+@!@:year_}{\.{\\year} primitive@>
+primitive("showboxbreadth",assign_int,int_base+show_box_breadth_code);@/
+@!@:show_box_breadth_}{\.{\\showboxbreadth} primitive@>
+primitive("showboxdepth",assign_int,int_base+show_box_depth_code);@/
+@!@:show_box_depth_}{\.{\\showboxdepth} primitive@>
+primitive("hbadness",assign_int,int_base+hbadness_code);@/
+@!@:hbadness_}{\.{\\hbadness} primitive@>
+primitive("vbadness",assign_int,int_base+vbadness_code);@/
+@!@:vbadness_}{\.{\\vbadness} primitive@>
+primitive("pausing",assign_int,int_base+pausing_code);@/
+@!@:pausing_}{\.{\\pausing} primitive@>
+primitive("tracingonline",assign_int,int_base+tracing_online_code);@/
+@!@:tracing_online_}{\.{\\tracingonline} primitive@>
+primitive("tracingmacros",assign_int,int_base+tracing_macros_code);@/
+@!@:tracing_macros_}{\.{\\tracingmacros} primitive@>
+primitive("tracingstats",assign_int,int_base+tracing_stats_code);@/
+@!@:tracing_stats_}{\.{\\tracingstats} primitive@>
+primitive("tracingparagraphs",assign_int,int_base+tracing_paragraphs_code);@/
+@!@:tracing_paragraphs_}{\.{\\tracingparagraphs} primitive@>
+primitive("tracingpages",assign_int,int_base+tracing_pages_code);@/
+@!@:tracing_pages_}{\.{\\tracingpages} primitive@>
+primitive("tracingoutput",assign_int,int_base+tracing_output_code);@/
+@!@:tracing_output_}{\.{\\tracingoutput} primitive@>
+primitive("tracinglostchars",assign_int,int_base+tracing_lost_chars_code);@/
+@!@:tracing_lost_chars_}{\.{\\tracinglostchars} primitive@>
+primitive("tracingcommands",assign_int,int_base+tracing_commands_code);@/
+@!@:tracing_commands_}{\.{\\tracingcommands} primitive@>
+primitive("tracingrestores",assign_int,int_base+tracing_restores_code);@/
+@!@:tracing_restores_}{\.{\\tracingrestores} primitive@>
+primitive("uchyph",assign_int,int_base+uc_hyph_code);@/
+@!@:uc_hyph_}{\.{\\uchyph} primitive@>
+primitive("outputpenalty",assign_int,int_base+output_penalty_code);@/
+@!@:output_penalty_}{\.{\\outputpenalty} primitive@>
+primitive("maxdeadcycles",assign_int,int_base+max_dead_cycles_code);@/
+@!@:max_dead_cycles_}{\.{\\maxdeadcycles} primitive@>
+primitive("hangafter",assign_int,int_base+hang_after_code);@/
+@!@:hang_after_}{\.{\\hangafter} primitive@>
+primitive("floatingpenalty",assign_int,int_base+floating_penalty_code);@/
+@!@:floating_penalty_}{\.{\\floatingpenalty} primitive@>
+primitive("globaldefs",assign_int,int_base+global_defs_code);@/
+@!@:global_defs_}{\.{\\globaldefs} primitive@>
+primitive("fam",assign_int,int_base+cur_fam_code);@/
+@!@:fam_}{\.{\\fam} primitive@>
+primitive("escapechar",assign_int,int_base+escape_char_code);@/
+@!@:escape_char_}{\.{\\escapechar} primitive@>
+primitive("defaulthyphenchar",assign_int,int_base+default_hyphen_char_code);@/
+@!@:default_hyphen_char_}{\.{\\defaulthyphenchar} primitive@>
+primitive("defaultskewchar",assign_int,int_base+default_skew_char_code);@/
+@!@:default_skew_char_}{\.{\\defaultskewchar} primitive@>
+primitive("endlinechar",assign_int,int_base+end_line_char_code);@/
+@!@:end_line_char_}{\.{\\endlinechar} primitive@>
+primitive("newlinechar",assign_int,int_base+new_line_char_code);@/
+@!@:new_line_char_}{\.{\\newlinechar} primitive@>
+primitive("language",assign_int,int_base+language_code);@/
+@!@:language_}{\.{\\language} primitive@>
+primitive("setlanguage",assign_int,int_base+cur_lang_code);@/
+@!@:cur_lang_}{\.{\\setlanguage} primitive@>
+primitive("exhyphenchar",assign_int,int_base+ex_hyphen_char_code);@/
+@!@:ex_hyphen_char_}{\.{\\exhyphenchar} primitive@>
+primitive("lefthyphenmin",assign_int,int_base+left_hyphen_min_code);@/
+@!@:left_hyphen_min_}{\.{\\lefthyphenmin} primitive@>
+primitive("righthyphenmin",assign_int,int_base+right_hyphen_min_code);@/
+@!@:right_hyphen_min_}{\.{\\righthyphenmin} primitive@>
+primitive("holdinginserts",assign_int,int_base+holding_inserts_code);@/
+@!@:holding_inserts_}{\.{\\holdinginserts} primitive@>
+primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/
+@!@:error_context_lines_}{\.{\\errorcontextlines} primitive@>
+primitive("luastartup",assign_int,int_base+luastartup_id_code);@/
+@!@:luastartup_id_}{\.{\\luastartup} primitive@>
+primitive("nokerns",assign_int,int_base+disable_kern_code);@/
+@!@:disable_kern_}{\.{\\noligkerns} primitive@>
+primitive("noligs",assign_int,int_base+disable_lig_code);@/
+@!@:disable_lig_}{\.{\\noligs} primitive@>
+primitive("catcodetable",assign_int,int_base+cat_code_table_code);@/
+@!@:cat_code_table_}{\.{\\catcodetable} primitive@>
+primitive("pdfoutput",assign_int,int_base+pdf_output_code);@/
+@!@:pdf_output_}{\.{\\pdfoutput} primitive@>
+primitive("pdfcompresslevel",assign_int,int_base+pdf_compress_level_code);@/
+@!@:pdf_compress_level_}{\.{\\pdfcompresslevel} primitive@>
+primitive("pdfobjcompresslevel",assign_int,int_base+pdf_objcompresslevel_code);@/
+@!@:pdf_objcompresslevel_}{\.{\\pdfobjcompresslevel} primitive@>
+primitive("pdfdecimaldigits",assign_int,int_base+pdf_decimal_digits_code);@/
+@!@:pdf_decimal_digits_}{\.{\\pdfdecimaldigits} primitive@>
+primitive("pdfmovechars",assign_int,int_base+pdf_move_chars_code);@/
+@!@:pdf_move_chars_}{\.{\\pdfmovechars} primitive@>
+primitive("pdfimageresolution",assign_int,int_base+pdf_image_resolution_code);@/
+@!@:pdf_image_resolution_}{\.{\\pdfimageresolution} primitive@>
+primitive("pdfpkresolution",assign_int,int_base+pdf_pk_resolution_code);@/
+@!@:pdf_pk_resolution_}{\.{\\pdfpkresolution} primitive@>
+primitive("pdfuniqueresname",assign_int,int_base+pdf_unique_resname_code);@/
+@!@:pdf_unique_resname_}{\.{\\pdfuniqueresname} primitive@>
+primitive("pdfoptionpdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfoptionpdfminorversion} primitive@>
+primitive("pdfoptionalwaysusepdfpagebox",assign_int,int_base+pdf_option_always_use_pdfpagebox_code);@/
+@!@:pdf_option_always_use_pdfpagebox_}{\.{\\pdfoptionalwaysusepdfpagebox} primitive@>
+primitive("pdfoptionpdfinclusionerrorlevel",assign_int,int_base+pdf_option_pdf_inclusion_errorlevel_code);@/
+@!@:pdf_option_pdf_inclusion_errorlevel_}{\.{\\pdfoptionpdfinclusionerrorlevel} primitive@>
+primitive("pdfminorversion",assign_int,int_base+pdf_minor_version_code);@/
+@!@:pdf_minor_version_}{\.{\\pdfminorversion} primitive@>
+primitive("pdfforcepagebox",assign_int,int_base+pdf_force_pagebox_code);@/
+@!@:pdf_force_pagebox_}{\.{\\pdfforcepagebox} primitive@>
+primitive("pdfpagebox",assign_int,int_base+pdf_pagebox_code);@/
+@!@:pdf_pagebox_}{\.{\\pdfpagebox} primitive@>
+primitive("pdfinclusionerrorlevel",assign_int,int_base+pdf_inclusion_errorlevel_code);@/
+@!@:pdf_inclusion_errorlevel_}{\.{\\pdfinclusionerrorlevel} primitive@>
+primitive("pdfgamma",assign_int,int_base+pdf_gamma_code);@/
+@!@:pdf_gamma_}{\.{\\pdfgamma} primitive@>
+primitive("pdfimagegamma",assign_int,int_base+pdf_image_gamma_code);@/
+@!@:pdf_image_gamma_}{\.{\\pdfimagegamma} primitive@>
+primitive("pdfimagehicolor",assign_int,int_base+pdf_image_hicolor_code);@/
+@!@:pdf_image_hicolor_}{\.{\\pdfimagehicolor} primitive@>
+primitive("pdfimageapplygamma",assign_int,int_base+pdf_image_apply_gamma_code);@/
+@!@:pdf_image_apply_gamma_}{\.{\\pdfimageapplygamma} primitive@>
+primitive("pdfadjustspacing",assign_int,int_base+pdf_adjust_spacing_code);@/
+@!@:pdf_adjust_spacing_}{\.{\\pdfadjustspacing} primitive@>
+primitive("pdfprotrudechars",assign_int,int_base+pdf_protrude_chars_code);@/
+@!@:pdf_protrude_chars_}{\.{\\pdfprotrudechars} primitive@>
+primitive("pdftracingfonts",assign_int,int_base+pdf_tracing_fonts_code);@/
+@!@:pdf_tracing_fonts_}{\.{\\pdftracingfonts} primitive@>
+primitive("pdfgentounicode",assign_int,int_base+pdf_gen_tounicode_code);@/
+@!@:pdf_gen_tounicode_}{\.{\\pdfgentounicode} primitive@>
+primitive("pdfdraftmode",assign_int,int_base+pdf_draftmode_code);@/
+@!@:pdf_draftmode_}{\.{\\pdfdraftmode} primitive@>
+primitive("pdfreplacefont",assign_int,int_base+pdf_replace_font_code);@/
+@!@:pdf_replace_font_}{\.{\\pdfreplacefont} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_int: if chr_code<count_base then print_param(chr_code-int_base)
+  else  begin print_esc("count"); print_int(chr_code-count_base);
+    end;
+assign_attr: begin print_esc("attribute"); print_int(chr_code-attribute_base);
+    end;
+
+@ The integer parameters should really be initialized by a macro package;
+the following initialization does the minimum to keep \TeX\ from
+complete failure.
+@^null delimiter@>
+
+@<Initialize table entries...@>=
+for k:=int_base to attribute_base-1 do eqtb[k].int:=0;
+for k:=attribute_base to del_code_base-1 do eqtb[k].int:=-1;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+eqtb[int_base+level_local_dir_code].int:=level_one;
+set_del_code(".",0,0,level_one); {this null delimiter is used in error recovery}
+ex_hyphen_char:="-";
+
+@ The following procedure, which is called just before \TeX\ initializes its
+input and output, establishes the initial values of the date and time.
+@^system dependencies@>
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+
+@ @<Show equivalent |n|, in region 5@>=
+begin if n<count_base then begin print_param(n-int_base);
+    print_char("="); print_int(eqtb[n].int);
+  end
+else if n<attribute_base then
+  begin print_esc("count"); print_int(n-count_base);
+    print_char("="); print_int(eqtb[n].int);
+  end
+else if n<del_code_base then
+  begin print_esc("attribute"); print_int(n-attribute_base);
+    print_char("="); print_int(eqtb[n].int);
+  end
+else begin 
+  {TH: todo, this stuff doesnt work}
+  print_esc("delcode");
+  end;
+end
+
+@ @<Set variable |c| to the current escape character@>=c:=escape_char
+
+@ @<Character |s| is the current new-line character@>=s=new_line_char
+
+@ \TeX\ is occasionally supposed to print diagnostic information that
+goes only into the transcript file, unless |tracing_online| is positive.
+Here are two routines that adjust the destination of print commands:
+
+@p procedure begin_diagnostic; {prepare to do some tracing}
+begin global_old_setting:=selector;
+if (tracing_online<=0)and(selector=term_and_log) then
+  begin decr(selector);
+  if history=spotless then history:=warning_issued;
+  end;
+end;
+@#
+procedure end_diagnostic(@!blank_line:boolean);
+  {restore proper conditions after tracing}
+begin print_nl("");
+if blank_line then print_ln;
+selector:=global_old_setting;
+end;
+
+@ Of course we had better declare another global variable, if the previous
+routines are going to work.
+
+@<Glob...@>=
+@!global_old_setting:0..max_selector;
+
+@ The final region of |eqtb| contains the dimension parameters defined
+here, and the |number_regs| \.{\\dimen} registers.
+
+@d par_indent_code=0 {indentation of paragraphs}
+@d math_surround_code=1 {space around math in text}
+@d line_skip_limit_code=2 {threshold for |line_skip| instead of |baseline_skip|}
+@d hsize_code=3 {line width in horizontal mode}
+@d vsize_code=4 {page height in vertical mode}
+@d max_depth_code=5 {maximum depth of boxes on main pages}
+@d split_max_depth_code=6 {maximum depth of boxes on split pages}
+@d box_max_depth_code=7 {maximum depth of explicit vboxes}
+@d hfuzz_code=8 {tolerance for overfull hbox messages}
+@d vfuzz_code=9 {tolerance for overfull vbox messages}
+@d delimiter_shortfall_code=10 {maximum amount uncovered by variable delimiters}
+@d null_delimiter_space_code=11 {blank space in null delimiters}
+@d script_space_code=12 {extra space after subscript or superscript}
+@d pre_display_size_code=13 {length of text preceding a display}
+@d display_width_code=14 {length of line for displayed equation}
+@d display_indent_code=15 {indentation of line for displayed equation}
+@d overfull_rule_code=16 {width of rule that identifies overfull hboxes}
+@d hang_indent_code=17 {amount of hanging indentation}
+@d h_offset_code=18 {amount of horizontal offset when shipping pages out}
+@d v_offset_code=19 {amount of vertical offset when shipping pages out}
+@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking}
+@d page_right_offset_code=21
+@d page_bottom_offset_code=22
+@d pdftex_first_dimen_code = 23 {first number defined in this section}
+@d pdf_h_origin_code       = pdftex_first_dimen_code + 0 {horigin of the PDF output}
+@d pdf_v_origin_code       = pdftex_first_dimen_code + 1 {vorigin of the PDF output}
+@d page_width_code         = pdftex_first_dimen_code + 2 {page width of the PDF output}
+@d page_height_code        = pdftex_first_dimen_code + 3 {page height of the PDF output}
+@d pdf_link_margin_code    = pdftex_first_dimen_code + 4 {link margin in the PDF output}
+@d pdf_dest_margin_code    = pdftex_first_dimen_code + 5 {dest margin in the PDF output}
+@d pdf_thread_margin_code  = pdftex_first_dimen_code + 6 {thread margin in the PDF output}
+@d pdf_first_line_height_code = pdftex_first_dimen_code + 7
+@d pdf_last_line_depth_code   = pdftex_first_dimen_code + 8
+@d pdf_each_line_height_code  = pdftex_first_dimen_code + 9
+@d pdf_each_line_depth_code   = pdftex_first_dimen_code + 10
+@d pdf_px_dimen_code       = pdftex_first_dimen_code + 11
+@d pdftex_last_dimen_code  = pdftex_first_dimen_code + 11 {last number defined in this section}
+@d dimen_pars = pdftex_last_dimen_code + 1 {total number of dimension parameters}
+@d scaled_base=dimen_base+dimen_pars
+  {table of |number_regs| user-defined \.{\\dimen} registers}
+@d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|}
+@#
+@d dimen(#)==eqtb[scaled_base+#].sc
+@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity}
+@d par_indent==dimen_par(par_indent_code)
+@d math_surround==dimen_par(math_surround_code)
+@d line_skip_limit==dimen_par(line_skip_limit_code)
+@d hsize==dimen_par(hsize_code)
+@d vsize==dimen_par(vsize_code)
+@d max_depth==dimen_par(max_depth_code)
+@d split_max_depth==dimen_par(split_max_depth_code)
+@d box_max_depth==dimen_par(box_max_depth_code)
+@d hfuzz==dimen_par(hfuzz_code)
+@d vfuzz==dimen_par(vfuzz_code)
+@d delimiter_shortfall==dimen_par(delimiter_shortfall_code)
+@d null_delimiter_space==dimen_par(null_delimiter_space_code)
+@d script_space==dimen_par(script_space_code)
+@d pre_display_size==dimen_par(pre_display_size_code)
+@d display_width==dimen_par(display_width_code)
+@d display_indent==dimen_par(display_indent_code)
+@d overfull_rule==dimen_par(overfull_rule_code)
+@d hang_indent==dimen_par(hang_indent_code)
+@d h_offset==dimen_par(h_offset_code)
+@d v_offset==dimen_par(v_offset_code)
+@d emergency_stretch==dimen_par(emergency_stretch_code)
+@d page_right_offset==dimen_par(page_right_offset_code)
+@d page_bottom_offset==dimen_par(page_bottom_offset_code)
+@d pdf_h_origin      == dimen_par(pdf_h_origin_code)
+@d pdf_v_origin      == dimen_par(pdf_v_origin_code)
+@d page_width    == dimen_par(page_width_code)
+@d page_height   == dimen_par(page_height_code)
+@d pdf_link_margin   == dimen_par(pdf_link_margin_code)
+@d pdf_dest_margin   == dimen_par(pdf_dest_margin_code)
+@d pdf_thread_margin == dimen_par(pdf_thread_margin_code)
+@d pdf_first_line_height == dimen_par(pdf_first_line_height_code)
+@d pdf_last_line_depth   == dimen_par(pdf_last_line_depth_code)
+@d pdf_each_line_height  == dimen_par(pdf_each_line_height_code)
+@d pdf_each_line_depth   == dimen_par(pdf_each_line_depth_code)
+@d pdf_px_dimen      == dimen_par(pdf_px_dimen_code)
+
+@p procedure print_length_param(@!n:integer);
+begin case n of
+par_indent_code:print_esc("parindent");
+math_surround_code:print_esc("mathsurround");
+line_skip_limit_code:print_esc("lineskiplimit");
+hsize_code:print_esc("hsize");
+vsize_code:print_esc("vsize");
+max_depth_code:print_esc("maxdepth");
+split_max_depth_code:print_esc("splitmaxdepth");
+box_max_depth_code:print_esc("boxmaxdepth");
+hfuzz_code:print_esc("hfuzz");
+vfuzz_code:print_esc("vfuzz");
+delimiter_shortfall_code:print_esc("delimitershortfall");
+null_delimiter_space_code:print_esc("nulldelimiterspace");
+script_space_code:print_esc("scriptspace");
+pre_display_size_code:print_esc("predisplaysize");
+display_width_code:print_esc("displaywidth");
+display_indent_code:print_esc("displayindent");
+overfull_rule_code:print_esc("overfullrule");
+hang_indent_code:print_esc("hangindent");
+h_offset_code:print_esc("hoffset");
+v_offset_code:print_esc("voffset");
+emergency_stretch_code:print_esc("emergencystretch");
+page_right_offset_code:print_esc("pagerightoffset");
+page_bottom_offset_code:print_esc("pagebottomoffset");
+pdf_h_origin_code:      print_esc("pdfhorigin");
+pdf_v_origin_code:      print_esc("pdfvorigin");
+page_width_code:    print_esc("pagewidth");
+page_height_code:   print_esc("pageheight");
+pdf_link_margin_code:   print_esc("pdflinkmargin");
+pdf_dest_margin_code:   print_esc("pdfdestmargin");
+pdf_thread_margin_code: print_esc("pdfthreadmargin");
+pdf_first_line_height_code: print_esc("pdffirstlineheight");
+pdf_last_line_depth_code: print_esc("pdflastlinedepth");
+pdf_each_line_height_code: print_esc("pdfeachlineheight");
+pdf_each_line_depth_code: print_esc("pdfeachlinedepth");
+pdf_px_dimen_code:      print_esc("pdfpxdimen");
+othercases print("[unknown dimen parameter!]")
+endcases;
+end;
+
+@ @<Put each...@>=
+primitive("parindent",assign_dimen,dimen_base+par_indent_code);@/
+@!@:par_indent_}{\.{\\parindent} primitive@>
+primitive("mathsurround",assign_dimen,dimen_base+math_surround_code);@/
+@!@:math_surround_}{\.{\\mathsurround} primitive@>
+primitive("lineskiplimit",assign_dimen,dimen_base+line_skip_limit_code);@/
+@!@:line_skip_limit_}{\.{\\lineskiplimit} primitive@>
+primitive("hsize",assign_dimen,dimen_base+hsize_code);@/
+@!@:hsize_}{\.{\\hsize} primitive@>
+primitive("vsize",assign_dimen,dimen_base+vsize_code);@/
+@!@:vsize_}{\.{\\vsize} primitive@>
+primitive("maxdepth",assign_dimen,dimen_base+max_depth_code);@/
+@!@:max_depth_}{\.{\\maxdepth} primitive@>
+primitive("splitmaxdepth",assign_dimen,dimen_base+split_max_depth_code);@/
+@!@:split_max_depth_}{\.{\\splitmaxdepth} primitive@>
+primitive("boxmaxdepth",assign_dimen,dimen_base+box_max_depth_code);@/
+@!@:box_max_depth_}{\.{\\boxmaxdepth} primitive@>
+primitive("hfuzz",assign_dimen,dimen_base+hfuzz_code);@/
+@!@:hfuzz_}{\.{\\hfuzz} primitive@>
+primitive("vfuzz",assign_dimen,dimen_base+vfuzz_code);@/
+@!@:vfuzz_}{\.{\\vfuzz} primitive@>
+primitive("delimitershortfall",
+  assign_dimen,dimen_base+delimiter_shortfall_code);@/
+@!@:delimiter_shortfall_}{\.{\\delimitershortfall} primitive@>
+primitive("nulldelimiterspace",
+  assign_dimen,dimen_base+null_delimiter_space_code);@/
+@!@:null_delimiter_space_}{\.{\\nulldelimiterspace} primitive@>
+primitive("scriptspace",assign_dimen,dimen_base+script_space_code);@/
+@!@:script_space_}{\.{\\scriptspace} primitive@>
+primitive("predisplaysize",assign_dimen,dimen_base+pre_display_size_code);@/
+@!@:pre_display_size_}{\.{\\predisplaysize} primitive@>
+primitive("displaywidth",assign_dimen,dimen_base+display_width_code);@/
+@!@:display_width_}{\.{\\displaywidth} primitive@>
+primitive("displayindent",assign_dimen,dimen_base+display_indent_code);@/
+@!@:display_indent_}{\.{\\displayindent} primitive@>
+primitive("overfullrule",assign_dimen,dimen_base+overfull_rule_code);@/
+@!@:overfull_rule_}{\.{\\overfullrule} primitive@>
+primitive("hangindent",assign_dimen,dimen_base+hang_indent_code);@/
+@!@:hang_indent_}{\.{\\hangindent} primitive@>
+primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/
+@!@:h_offset_}{\.{\\hoffset} primitive@>
+primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/
+@!@:v_offset_}{\.{\\voffset} primitive@>
+primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/
+@!@:emergency_stretch_}{\.{\\emergencystretch} primitive@>
+primitive("pdfhorigin",assign_dimen,dimen_base+pdf_h_origin_code);@/
+@!@:pdf_h_origin_}{\.{\\pdfhorigin} primitive@>
+primitive("pdfvorigin",assign_dimen,dimen_base+pdf_v_origin_code);@/
+@!@:pdf_v_origin_}{\.{\\pdfvorigin} primitive@>
+@#
+primitive("pagewidth",assign_dimen,dimen_base+page_width_code);@/
+primitive("pdfpagewidth",assign_dimen,dimen_base+page_width_code);@/
+@!@:page_width_}{\.{\\pdfpagewidth} primitive@>
+primitive("pageheight",assign_dimen,dimen_base+page_height_code);@/
+primitive("pdfpageheight",assign_dimen,dimen_base+page_height_code);@/
+@!@:page_height_}{\.{\\pdfpageheight} primitive@>
+@#
+primitive("pdflinkmargin",assign_dimen,dimen_base+pdf_link_margin_code);@/
+@!@:pdf_link_margin_}{\.{\\pdflinkmargin} primitive@>
+primitive("pdfdestmargin",assign_dimen,dimen_base+pdf_dest_margin_code);@/
+@!@:pdf_dest_margin_}{\.{\\pdfdestmargin} primitive@>
+primitive("pdfthreadmargin",assign_dimen,dimen_base+pdf_thread_margin_code);@/
+@!@:pdf_thread_margin_}{\.{\\pdfthreadmargin} primitive@>
+primitive("pdffirstlineheight",assign_dimen,dimen_base+pdf_first_line_height_code);@/
+@!@:pdf_first_line_height_}{\.{\\pdffirstlineheight} primitive@>
+primitive("pdflastlinedepth",assign_dimen,dimen_base+pdf_last_line_depth_code);@/
+@!@:pdf_last_line_depth_}{\.{\\pdflastlinedepth} primitive@>
+primitive("pdfeachlineheight",assign_dimen,dimen_base+pdf_each_line_height_code);@/
+@!@:pdf_each_line_height_}{\.{\\pdfeachlineheight} primitive@>
+primitive("pdfeachlinedepth",assign_dimen,dimen_base+pdf_each_line_depth_code);@/
+@!@:pdf_each_line_depth_}{\.{\\pdfeachlinedepth} primitive@>
+primitive("pdfpxdimen",assign_dimen,dimen_base+pdf_px_dimen_code);@/
+@!@:pdf_px_dimen_}{\.{\\pdfpxdimen} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_dimen: if chr_code<scaled_base then
+    print_length_param(chr_code-dimen_base)
+  else  begin print_esc("dimen"); print_int(chr_code-scaled_base);
+    end;
+
+@ @<Initialize table entries...@>=
+for k:=dimen_base to eqtb_size do eqtb[k].sc:=0;
+
+@ @<Show equivalent |n|, in region 6@>=
+begin if n<scaled_base then print_length_param(n-dimen_base)
+else  begin print_esc("dimen"); print_int(n-scaled_base);
+  end;
+print_char("="); print_scaled(eqtb[n].sc); print("pt");
+end
+
+@ Here is a procedure that displays the contents of |eqtb[n]|
+symbolically.
+
+@p@t\4@>@<Declare the procedure called |print_cmd_chr|@>@;@/
+@!stat procedure show_eqtb(@!n:pointer);
+begin if n<active_base then print_char("?") {this can't happen}
+else if n<glue_base then @<Show equivalent |n|, in region 1 or 2@>
+else if n<local_base then @<Show equivalent |n|, in region 3@>
+else if n<int_base then @<Show equivalent |n|, in region 4@>
+else if n<dimen_base then @<Show equivalent |n|, in region 5@>
+else if n<=eqtb_size then @<Show equivalent |n|, in region 6@>
+else print_char("?"); {this can't happen either}
+end;
+tats
+
+@ The last two regions of |eqtb| have fullword values instead of the
+three fields |eq_level|, |eq_type|, and |equiv|. An |eq_type| is unnecessary,
+but \TeX\ needs to store the |eq_level| information in another array
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+
+@ @<Set init...@>=
+for k:=int_base to eqtb_size do xeq_level[k]:=level_one;
+
+@* \[18] The hash table.
+Control sequences are stored and retrieved by means of a fairly standard hash
+table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C
+in {\sl The Art of Computer Programming\/}). Once a control sequence enters the
+table, it is never removed, because there are complicated situations
+involving \.{\\gdef} where the removal of a control sequence at the end of
+a group would be a mistake preventable only by the introduction of a
+complicated reference-count mechanism.
+
+The actual sequence of letters forming a control sequence identifier is
+stored in the |str_pool| array together with all the other strings. An
+auxiliary array |hash| consists of items with two halfword fields per
+word. The first of these, called |next(p)|, points to the next identifier
+belonging to the same coalesced list as the identifier corresponding to~|p|;
+and the other, called |text(p)|, points to the |str_start| entry for
+|p|'s identifier. If position~|p| of the hash table is empty, we have
+|text(p)=0|; if position |p| is either empty or the end of a coalesced
+hash list, we have |next(p)=0|. An auxiliary pointer variable called
+|hash_used| is maintained in such a way that all locations |p>=hash_used|
+are nonempty. The global variable |cs_count| tells how many multiletter
+control sequences have been defined, if statistics are being kept.
+
+A global boolean variable called |no_new_control_sequence| is set to
+|true| during the time that new hash table entries are forbidden.
+
+@d next(#) == hash[#].lh {link for coalesced lists}
+@d text(#) == hash[#].rh {string number for control sequence name}
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+@d ocp_id_text(#) == text(ocp_id_base+#) {a frozen ocp identifier's name}
+@d ocp_list_id_text(#) == text(ocp_list_id_base+#) 
+   {a frozen ocp list identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+  {the hash table}
+@!hash_used:pointer; {allocation pointer for |hash|}
+@!no_new_control_sequence:boolean; {are new identifiers legal?}
+@!cs_count:integer; {total number of known identifiers}
+
+@ Primitive support needs a few extra variables and definitions
+
+@d prim_size=2100 {maximum number of primitives }
+@d prim_prime=1777 {about 85\pct! of |primitive_size|}
+@d prim_base=1
+@d prim_next(#) == prim[#].lh {link for coalesced lists}
+@d prim_text(#) == prim[#].rh {string number for control sequence name}
+@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied}
+@d prim_eq_level_field(#)==#.hh.b1
+@d prim_eq_type_field(#)==#.hh.b0
+@d prim_equiv_field(#)==#.hh.rh
+@d prim_eq_level(#)==prim_eq_level_field(prim_eqtb[#]) {level of definition}
+@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent}
+@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value}
+@d undefined_primitive=0
+
+@<Glob...@>=
+@!prim: array [0..prim_size] of two_halves;  {the primitives table}
+@!prim_used:pointer; {allocation pointer for |prim|}
+@!prim_eqtb:array[0..prim_size] of memory_word;
+
+@ The extra set of functions make sure we can query the
+primitive meanings of thing s from C code
+
+@p 
+function get_char_cat_code(c:integer):quarterword;
+begin
+  if local_catcode_table then 
+     get_char_cat_code:=get_cat_code(line_catcode_table,c) 
+  else 
+     get_char_cat_code:=get_cat_code(cat_code_table,c)
+end;
+function get_prim_eq_level(p:integer):quarterword;
+begin
+  get_prim_eq_level := prim_eq_level(p);
+end;
+function get_prim_eq_type(p:integer):quarterword;
+begin
+  get_prim_eq_type := prim_eq_type(p);
+end;
+function get_prim_equiv(p:integer):halfword;
+begin
+  get_prim_equiv := prim_equiv(p);
+end;
+function get_eq_type(p:integer):quarterword;
+begin
+  get_eq_type := eq_type(p);
+end;
+function get_eq_level(p:integer):quarterword;
+begin
+  get_eq_level := eq_level(p);
+end;
+function is_undefined_cs(cs:integer):boolean;
+begin
+  is_undefined_cs := (cs=undefined_cs);
+end;
+function get_equiv(p:integer):halfword;
+begin
+  get_equiv := equiv(p);
+end;
+function get_cs_text(cs:integer):str_number;
+begin if cs<hash_base then
+    if cs<null_cs then get_cs_text := cs-active_base
+      else  get_cs_text := "\csname\endcsname"
+  else if (text(cs)<0)or(text(cs)>=str_ptr) then get_cs_text := ""
+  else get_cs_text := text(cs);
+end;
+function get_max_command:integer;
+begin
+  get_max_command := max_command;
+end;
+function get_count_base:halfword;
+begin
+  get_count_base := count_base;
+end;
+function get_attribute_base:halfword;
+begin
+  get_attribute_base := attribute_base;
+end;
+function get_scaled_base:halfword;
+begin
+  get_scaled_base := scaled_base;
+end;
+function get_int_base:halfword;
+begin
+  get_int_base := int_base;
+end;
+function get_toks_base:halfword;
+begin
+  get_toks_base := toks_base;
+end;
+function get_every_eof:halfword;
+begin
+  get_every_eof := every_eof;
+end;
+function get_suppress_fontnotfound_error:boolean;
+begin
+  get_suppress_fontnotfound_error := suppress_fontnotfound_error;
+end;
+function get_pdf_image_resolution:integer;
+begin
+  get_pdf_image_resolution := pdf_image_resolution;
+end;
+function get_pdf_minor_version:integer;
+begin
+  get_pdf_minor_version := pdf_minor_version;
+end;
+function get_pdf_inclusion_errorlevel:integer;
+begin
+  get_pdf_inclusion_errorlevel := pdf_inclusion_errorlevel;
+end;
+
+@ @<Set init...@>=
+no_new_control_sequence:=true; {new identifiers are usually forbidden}
+prim_next(0):=0; prim_text(0):=0;
+for k:=1 to prim_size do prim[k]:=prim[0];
+prim_eq_level(0) := level_zero;
+prim_eq_type(0) := undefined_cs;
+prim_equiv(0) := null;
+for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0];
+next(hash_base):=0; text(hash_base):=0;
+for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
+
+@ @<Initialize table entries...@>=
+prim_used:=prim_size; {nothing is used}
+hash_used:=frozen_control_sequence; {nothing is used}
+cs_count:=0;
+eq_type(frozen_dont_expand):=dont_expand;
+text(frozen_dont_expand):="notexpanded:";
+@.notexpanded:@>
+
+eq_type(frozen_primitive):=ignore_spaces;
+equiv(frozen_primitive):=1;
+eq_level(frozen_primitive):=level_one;
+text(frozen_primitive):="primitive";
+
+@ Here is the subroutine that searches the hash table for an identifier
+that matches a given string of length |l>1| appearing in |buffer[j..
+(j+l-1)]|. If the identifier is found, the corresponding hash table address
+is returned. Otherwise, if the global variable |no_new_control_sequence|
+is |true|, the dummy address |undefined_control_sequence| is returned.
+Otherwise the identifier is inserted into the hash table and its location
+is returned.
+
+@p function id_lookup(@!j,@!l:integer):pointer; {search the hash table}
+label found; {go here if you found it}
+var h:integer; {hash code}
+@!d:integer; {number of characters in incomplete current string}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in |buffer| array}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+loop@+begin if text(p)>0 then if length(text(p))=l then
+  if str_eq_buf(text(p),j) then goto found;
+  if next(p)=0 then
+    begin if no_new_control_sequence then
+      p:=undefined_control_sequence
+    else @<Insert a new control sequence after |p|, then make
+      |p| point to it@>;
+    goto found;
+    end;
+  p:=next(p);
+  end;
+found: id_lookup:=p;
+end;
+
+@ @<Insert a new control...@>=
+begin if text(p)>0 then
+  begin repeat if hash_is_full then overflow("hash size",hash_size);
+@:TeX capacity exceeded hash size}{\quad hash size@>
+  decr(hash_used);
+  until text(hash_used)=0; {search for an empty location in |hash|}
+  next(p):=hash_used; p:=hash_used;
+  end;
+str_room(l); d:=cur_length;
+while pool_ptr>str_start_macro(str_ptr) do
+  begin decr(pool_ptr); str_pool[pool_ptr+l]:=str_pool[pool_ptr];
+  end; {move current string up to make room for another}
+for k:=j to j+l-1 do append_char(buffer[k]);
+text(p):=make_string; pool_ptr:=pool_ptr+d; 
+@!stat incr(cs_count);@+tats@;@/
+end
+
+@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it
+should be a prime number.  The theory of hashing tells us to expect fewer
+than two table probes, on the average, when the search is successful.
+[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.]
+@^Vitter, Jeffrey Scott@>
+
+@<Compute the hash code |h|@>=
+h:=buffer[j];
+for k:=j+1 to j+l-1 do
+  begin h:=h+h+buffer[k];
+  while h>=hash_prime do h:=h-hash_prime;
+  end
+
+@ Here is the subroutine that searches the primitive table for an identifier
+
+@p function prim_lookup(@!s:str_number):pointer; {search the primitives table}
+label found; {go here if you found it}
+var h:integer; {hash code}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in string pool}
+@!the_hash_prime:halfword;
+@!j,@!l:integer;
+begin
+the_hash_prime:= prim_prime;
+if s<string_offset then begin
+  p := s;
+  if (p<0) or (get_prim_eq_level(p)<>level_one) then
+    p := undefined_primitive;
+end
+else begin
+  j:=str_start_macro(s);
+  if s = str_ptr then l := cur_length else l := length(s);
+  @<Compute the string hash code |h|@>;
+  p:=h+prim_base; {we start searching here; note that |0<=h<hash_prime|}
+  loop@+begin if prim_text(p)>0 then if length(prim_text(p))=l then
+    if str_eq_str(prim_text(p),s) then goto found;
+    if prim_next(p)=0 then
+      begin if no_new_control_sequence then
+        p:=undefined_primitive
+      else @<Insert a new primitive after |p|, then make
+        |p| point to it@>;
+      goto found;
+      end;
+    p:=prim_next(p);
+    end;
+  end;
+found: prim_lookup:=p;
+end;
+
+function string_lookup(@!s:str_number):pointer; {search the primitives table}
+label found; {go here if you found it}
+var h:integer; {hash code}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in string pool}
+@!the_hash_prime: halfword;
+@!j,@!l:integer;
+begin
+the_hash_prime := hash_prime;
+if s<string_offset then begin
+  p := s;
+  if (p<0) or (eq_level(p)<>level_one) then
+    p := undefined_cs;
+end
+else begin
+  j:=str_start_macro(s);
+  if s = str_ptr then l := cur_length else l := length(s);
+  @<Compute the string hash code |h|@>;
+  p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+  loop@+begin if text(p)>0 then if length(text(p))=l then
+    if str_eq_str(text(p),s) then goto found;
+    if next(p)=0 then
+      begin 
+     	p:=undefined_cs ;
+        goto found;
+      end;
+    p:=next(p);
+    end;
+  end;
+found: string_lookup:=p;
+end;
+
+function is_primitive(csname:str_number):boolean;
+  var n,m:integer;
+begin
+  m := prim_lookup(csname);
+  n := string_lookup(csname);
+  is_primitive :=((n<>undefined_cs) and
+       (m<>undefined_primitive) and
+       (eq_type(n)=get_prim_eq_type(m)) and
+       (equiv(n)=get_prim_equiv(m)));
+end;
+
+@ @<Insert a new primitive...@>=
+begin if prim_text(p)>0 then
+  begin repeat if prim_is_full then overflow("primitive size",prim_size);
+@:TeX capacity exceeded primitive size}{\quad primitive size@>
+  decr(prim_used);
+  until prim_text(prim_used)=0; {search for an empty location in |prim|}
+  prim_next(p):=prim_used; p:=prim_used;
+  end;
+prim_text(p):=s;
+end
+
+@ The value of |prim_prime| should be roughly 85\pct! of
+|prim_size|, and it should be a prime number.
+
+@<Compute the string hash code |h|@>=
+h:=str_pool[j];
+for k:=j+1 to j+l-1 do
+  begin h:=h+h+str_pool[k];
+  while h>=the_hash_prime do h:=h-the_hash_prime;
+  end
+
+
+@ The procedure |print_cs| prints the name of a control sequence, given
+a pointer to its address in |eqtb|. A space is printed after the name
+unless it is a single nonletter or an active character. This procedure
+might be invoked with invalid data, so it is ``extra robust.'' The
+individual characters must be printed one at a time using |print|, since
+they may be unprintable.
+
+@d single_letter(#)==(length(#)=1)or
+   ((length(#)=4)and(str_pool[str_start_macro(#)]>=@"F0))or
+   ((length(#)=3)and(str_pool[str_start_macro(#)]>=@"E0))or
+   ((length(#)=2)and(str_pool[str_start_macro(#)]>=@"C0))
+
+@<Basic printing...@>=
+procedure print_cs(@!p:integer); {prints a purported control sequence}
+begin if p<hash_base then {single character}
+  if p=null_cs then
+    begin print_esc("csname"); print_esc("endcsname");
+    end
+  else if p<active_base then print_esc("IMPOSSIBLE.")
+@.IMPOSSIBLE@>
+  else print(p-active_base)
+else if p>=undefined_control_sequence then print_esc("IMPOSSIBLE.")
+else if (text(p)<0)or(text(p)>=str_ptr) then print_esc("NONEXISTENT.")
+@.NONEXISTENT@>
+else  begin 
+  print_esc(text(p));
+  if single_letter(text(p)) then begin
+   	if get_cat_code(cat_code_table,pool_to_unichar(str_start_macro(text(p))))=letter then
+      print_char(" ")
+    else
+      do_nothing;
+    end
+  else
+    print_char(" ");
+  end;
+end;
+
+@ Here is a similar procedure; it avoids the error checks, and it never
+prints a space after the control sequence.
+
+@<Basic printing procedures@>=
+procedure sprint_cs(@!p:pointer); {prints a control sequence}
+begin if p<hash_base then
+  if p<null_cs then print(p-active_base)
+  else  begin print_esc("csname"); print_esc("endcsname");
+    end
+else print_esc(text(p));
+end;
+
+@ We need to put \TeX's ``primitive'' control sequences into the hash
+table, together with their command code (which will be the |eq_type|)
+and an operand (which will be the |equiv|). The |primitive| procedure
+does this, in a way that no \TeX\ user can. The global value |cur_val|
+contains the new |eqtb| pointer after |primitive| has acted.
+
+@p @!init procedure primitive(@!ss:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!s:str_number; {actual |str_number| used }
+@!j:0..buf_size; {index into |buffer|}
+@!l:small_number; {length of the string}
+@!prim_val:integer; {needed to fill |prim_eqtb|}
+begin if ss<number_chars then begin
+  if ss>127 then confusion("prim"); { should be ASCII }
+  append_char(ss); 
+  s:=make_string;
+  end
+else
+  s:=ss;
+k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
+    {we will move |s| into the (possibly non-empty) |buffer|}
+if first+l>buf_size+1 then
+  check_buffer_overflow(first+l);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
+cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
+flush_string; text(cur_val):=s; {we don't want to have the string twice}
+prim_val:=prim_lookup(s);
+eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+prim_eq_level(prim_val) := level_one;
+prim_eq_type(prim_val) := c;
+prim_equiv(prim_val) := o;
+end;
+tini
+
+@ Many of \TeX's primitives need no |equiv|, since they are identifiable
+by their |eq_type| alone. These primitives are loaded into the hash table
+as follows:
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive(" ",ex_space,0);@/
+@!@:Single-character primitives /}{\quad\.{\\\ }@>
+primitive("/",ital_corr,0);@/
+@!@:Single-character primitives /}{\quad\.{\\/}@>
+primitive("accent",accent,0);@/
+@!@:accent_}{\.{\\accent} primitive@>
+primitive("advance",advance,0);@/
+@!@:advance_}{\.{\\advance} primitive@>
+primitive("afterassignment",after_assignment,0);@/
+@!@:after_assignment_}{\.{\\afterassignment} primitive@>
+primitive("aftergroup",after_group,0);@/
+@!@:after_group_}{\.{\\aftergroup} primitive@>
+primitive("begingroup",begin_group,0);@/
+@!@:begin_group_}{\.{\\begingroup} primitive@>
+primitive("char",char_num,0);@/
+@!@:char_}{\.{\\char} primitive@>
+primitive("csname",cs_name,0);@/
+@!@:cs_name_}{\.{\\csname} primitive@>
+primitive("delimiter",delim_num,0);@/
+@!@:delimiter_}{\.{\\delimiter} primitive@>
+primitive("odelimiter",delim_num,1);@/
+@!@:odelimiter_}{\.{\\odelimiter} primitive@>
+primitive("divide",divide,0);@/
+@!@:divide_}{\.{\\divide} primitive@>
+primitive("endcsname",end_cs_name,0);@/
+@!@:end_cs_name_}{\.{\\endcsname} primitive@>
+primitive("endgroup",end_group,0);
+@!@:end_group_}{\.{\\endgroup} primitive@>
+text(frozen_end_group):="endgroup"; eqtb[frozen_end_group]:=eqtb[cur_val];@/
+primitive("expandafter",expand_after,0);@/
+@!@:expand_after_}{\.{\\expandafter} primitive@>
+primitive("font",def_font,0);@/
+@!@:font_}{\.{\\font} primitive@>
+primitive("letterspacefont",letterspace_font,0);@/
+@!@:letterspace_font_}{\.{\\letterspacefont} primitive@>
+primitive("fontdimen",assign_font_dimen,0);@/
+@!@:font_dimen_}{\.{\\fontdimen} primitive@>
+primitive("halign",halign,0);@/
+@!@:halign_}{\.{\\halign} primitive@>
+primitive("hrule",hrule,0);@/
+@!@:hrule_}{\.{\\hrule} primitive@>
+primitive("ignorespaces",ignore_spaces,0);@/
+@!@:ignore_spaces_}{\.{\\ignorespaces} primitive@>
+primitive("insert",insert,0);@/
+@!@:insert_}{\.{\\insert} primitive@>
+primitive("leftghost",char_ghost,0);@/
+@!@:leftghost_}{\.{\\leftghost} primitive@>
+primitive("mark",mark,0);@/
+@!@:mark_}{\.{\\mark} primitive@>
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("omathaccent",math_accent,1);@/
+@!@:math_accent_}{\.{\\omathaccent} primitive@>
+primitive("omathchar",math_char_num,1);@/
+@!@:math_char_}{\.{\\omathchar} primitive@>
+primitive("mathchoice",math_choice,0);@/
+@!@:math_choice_}{\.{\\mathchoice} primitive@>
+primitive("multiply",multiply,0);@/
+@!@:multiply_}{\.{\\multiply} primitive@>
+primitive("noalign",no_align,0);@/
+@!@:no_align_}{\.{\\noalign} primitive@>
+primitive("noboundary",no_boundary,0);@/
+@!@:no_boundary_}{\.{\\noboundary} primitive@>
+primitive("noexpand",no_expand,0);@/
+@!@:no_expand_}{\.{\\noexpand} primitive@>
+primitive("primitive",no_expand,1);@/
+@!@:primitive_}{\.{\\primitive} primitive@>
+primitive("pdfprimitive",no_expand,1);@/
+@!@:pdfprimitive_}{\.{\\pdfprimitive} primitive@>
+primitive("nonscript",non_script,0);@/
+@!@:non_script_}{\.{\\nonscript} primitive@>
+primitive("omit",omit,0);@/
+@!@:omit_}{\.{\\omit} primitive@>
+primitive("parshape",set_shape,par_shape_loc);@/
+@!@:par_shape_}{\.{\\parshape} primitive@>
+primitive("penalty",break_penalty,0);@/
+@!@:penalty_}{\.{\\penalty} primitive@>
+primitive("prevgraf",set_prev_graf,0);@/
+@!@:prev_graf_}{\.{\\prevgraf} primitive@>
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("oradical",radical,1);@/
+@!@:radical_}{\.{\\oradical} primitive@>
+primitive("read",read_to_cs,0);@/
+@!@:read_}{\.{\\read} primitive@>
+primitive("relax",relax,too_big_char);
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+primitive("rightghost",char_ghost,1);@/
+@!@:rightghost_}{\.{\\rightghost} primitive@>
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+primitive("the",the,0);@/
+@!@:the_}{\.{\\the} primitive@>
+primitive("toks",toks_register,0);@/
+@!@:toks_}{\.{\\toks} primitive@>
+primitive("vadjust",vadjust,0);@/
+@!@:vadjust_}{\.{\\vadjust} primitive@>
+primitive("valign",valign,0);@/
+@!@:valign_}{\.{\\valign} primitive@>
+primitive("vcenter",vcenter,0);@/
+@!@:vcenter_}{\.{\\vcenter} primitive@>
+primitive("vrule",vrule,0);@/
+@!@:vrule_}{\.{\\vrule} primitive@>
+
+@ Each primitive has a corresponding inverse, so that it is possible to
+display the cryptic numeric contents of |eqtb| in symbolic form.
+Every call of |primitive| in this program is therefore accompanied by some
+straightforward code that forms part of the |print_cmd_chr| routine
+below.
+
+@<Cases of |print_cmd_chr|...@>=
+accent: print_esc("accent");
+advance: print_esc("advance");
+after_assignment: print_esc("afterassignment");
+after_group: print_esc("aftergroup");
+assign_font_dimen: print_esc("fontdimen");
+begin_group: print_esc("begingroup");
+break_penalty: print_esc("penalty");
+char_num: print_esc("char");
+char_ghost: if cur_chr=0 then print_esc("leftghost")
+  else print_esc("rightghost");
+cs_name: print_esc("csname");
+def_font: print_esc("font");
+letterspace_font: print_esc("letterspacefont");
+delim_num: if chr_code=0 then print_esc("delimiter") else print_esc("odelimiter") ;
+divide: print_esc("divide");
+end_cs_name: print_esc("endcsname");
+end_group: print_esc("endgroup");
+ex_space: print_esc(" ");
+expand_after: if chr_code=0 then print_esc("expandafter")
+  @<Cases of |expandafter| for |print_cmd_chr|@>;
+halign: print_esc("halign");
+hrule: print_esc("hrule");
+ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive");
+insert: print_esc("insert");
+ital_corr: print_esc("/");
+mark: begin
+  if chr_code=0 then print_esc("mark")
+  else if chr_code=1 then print_esc("clearmarks")
+  else print_esc("marks");
+  end;
+math_accent: if chr_code=0 then print_esc("mathaccent") else print_esc("omathaccent");
+math_char_num: if chr_code=0 then print_esc("mathchar") else print_esc("omathchar");
+math_choice: print_esc("mathchoice");
+multiply: print_esc("multiply");
+no_align: print_esc("noalign");
+no_boundary:print_esc("noboundary");
+no_expand: if chr_code=0 then print_esc("noexpand")
+   else print_esc("primitive");
+non_script: print_esc("nonscript");
+omit: print_esc("omit");
+radical: if chr_code=0 then print_esc("radical") else print_esc("oradical");
+read_to_cs: if chr_code=0 then print_esc("read")
+  @<Cases of |read| for |print_cmd_chr|@>;
+relax: print_esc("relax");
+set_box: print_esc("setbox");
+set_prev_graf: print_esc("prevgraf");
+set_shape: case chr_code of
+  par_shape_loc: print_esc("parshape");
+  @<Cases of |set_shape| for |print_cmd_chr|@>@;@/
+  end; {there are no other cases}
+the: if chr_code=0 then print_esc("the")
+  @<Cases of |the| for |print_cmd_chr|@>;
+toks_register: print_esc("toks");
+vadjust: print_esc("vadjust");
+valign: print_esc("valign");
+vcenter: print_esc("vcenter");
+vrule: print_esc("vrule");
+
+@ We will deal with the other primitives later, at some point in the program
+where their |eq_type| and |equiv| values are more meaningful.  For example,
+the primitives for math mode will be loaded when we consider the routines
+that deal with formulas. It is easy to find where each particular
+primitive was treated by looking in the index at the end; for example, the
+section where |"radical"| entered |eqtb| is listed under `\.{\\radical}
+primitive'. (Primitives consisting of a single nonalphabetic character,
+@!like `\.{\\/}', are listed under `Single-character primitives'.)
+@!@^Single-character primitives@>
+
+
+@* \[19] Saving and restoring equivalents.
+The nested structure provided by `$\.{\char'173}\ldots\.{\char'175}$' groups
+in \TeX\ means that |eqtb| entries valid in outer groups should be saved
+and restored later if they are overridden inside the braces. When a new |eqtb|
+value is being assigned, the program therefore checks to see if the previous
+entry belongs to an outer level. In such a case, the old value is placed
+on the |save_stack| just before the new value enters |eqtb|. At the
+end of a grouping level, i.e., when the right brace is sensed, the
+|save_stack| is used to restore the outer values, and the inner ones are
+destroyed.
+
+Entries on the |save_stack| are of type |memory_word|. The top item on
+this stack is |save_stack[p]|, where |p=save_ptr-1|; it contains three
+fields called |save_type|, |save_level|, and |save_index|, and it is
+interpreted in one of four ways:
+
+\yskip\hangg 1) If |save_type(p)=restore_old_value|, then
+|save_index(p)| is a location in |eqtb| whose current value should
+be destroyed at the end of the current group and replaced by |save_stack[p-1]|.
+Furthermore if |save_index(p)>=int_base|, then |save_level(p)|
+should replace the corresponding entry in |xeq_level|.
+
+\yskip\hangg 2) If |save_type(p)=restore_zero|, then |save_index(p)|
+is a location in |eqtb| whose current value should be destroyed at the end
+of the current group, when it should be
+replaced by the current value of |eqtb[undefined_control_sequence]|.
+
+\yskip\hangg 3) If |save_type(p)=insert_token|, then |save_index(p)|
+is a token that should be inserted into \TeX's input when the current
+group ends.
+
+\yskip\hangg 4) If |save_type(p)=level_boundary|, then |save_level(p)|
+is a code explaining what kind of group we were previously in, and
+|save_index(p)| points to the level boundary word at the bottom of
+the entries for that group.
+Furthermore, in extended \eTeX\ mode, |save_stack[p-1]| contains the
+source line number at which the current level of grouping was entered.
+
+@d save_type(#)==save_stack[#].hh.b0 {classifies a |save_stack| entry}
+@d save_level(#)==save_stack[#].hh.b1
+  {saved level for regions 5 and 6, or group code}
+@d save_index(#)==save_stack[#].hh.rh
+  {|eqtb| location or |save_stack| location}
+@d restore_old_value=0 {|save_type| when a value should be restored later}
+@d restore_zero=1 {|save_type| when an undefined entry should be restored}
+@d insert_token=2 {|save_type| when a token is being saved for later use}
+@d level_boundary=3 {|save_type| corresponding to beginning of group}
+
+@p@t\4@>@<Declare \eTeX\ procedures for tracing and input@>
+
+@ Here are the group codes that are used to discriminate between different
+kinds of groups. They allow \TeX\ to decide what special actions, if any,
+should be performed when a group ends.
+\def\grp{\.{\char'173...\char'175}}
+
+Some groups are not supposed to be ended by right braces. For example,
+the `\.\$' that begins a math formula causes a |math_shift_group| to
+be started, and this should be terminated by a matching `\.\$'. Similarly,
+a group that starts with \.{\\left} should end with \.{\\right}, and
+one that starts with \.{\\begingroup} should end with \.{\\endgroup}.
+
+@d bottom_level=0 {group code for the outside world}
+@d simple_group=1 {group code for local structure only}
+@d hbox_group=2 {code for `\.{\\hbox}\grp'}
+@d adjusted_hbox_group=3 {code for `\.{\\hbox}\grp' in vertical mode}
+@d vbox_group=4 {code for `\.{\\vbox}\grp'}
+@d vtop_group=5 {code for `\.{\\vtop}\grp'}
+@d align_group=6 {code for `\.{\\halign}\grp', `\.{\\valign}\grp'}
+@d no_align_group=7 {code for `\.{\\noalign}\grp'}
+@d output_group=8 {code for output routine}
+@d math_group=9 {code for, e.g, `\.{\char'136}\grp'}
+@d disc_group=10 {code for `\.{\\discretionary}\grp\grp\grp'}
+@d insert_group=11 {code for `\.{\\insert}\grp', `\.{\\vadjust}\grp'}
+@d vcenter_group=12 {code for `\.{\\vcenter}\grp'}
+@d math_choice_group=13 {code for `\.{\\mathchoice}\grp\grp\grp\grp'}
+@d semi_simple_group=14 {code for `\.{\\begingroup...\\endgroup}'}
+@d math_shift_group=15 {code for `\.{\$...\$}'}
+@d math_left_group=16 {code for `\.{\\left...\\right}'}
+@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
+@d max_group_code=17
+@d split_off_group=18 {box code for the top part of a \.{\\vsplit}}
+@d split_keep_group=19 {box code for the bottom part of a \.{\\vsplit}}
+@d preamble_group=20 {box code for the preamble processing  in an alignment}
+@d align_set_group=21 {box code for the final item pass in an alignment}
+@d fin_row_group=22 {box code for a provisory line in an alignment}
+
+@<Types...@>=
+@!group_code=0..max_group_code; {|save_level| for a level boundary}
+
+@ The global variable |cur_group| keeps track of what sort of group we are
+currently in. Another global variable, |cur_boundary|, points to the
+topmost |level_boundary| word.  And |cur_level| is the current depth of
+nesting. The routines are designed to preserve the condition that no entry
+in the |save_stack| or in |eqtb| ever has a level greater than |cur_level|.
+
+@ @<Glob...@>=
+@!save_stack : array[0..save_size] of memory_word;
+@!save_ptr : 0..save_size; {first unused entry on |save_stack|}
+@!max_save_stack:0..save_size; {maximum usage of save stack}
+@!cur_level: quarterword; {current nesting level for groups}
+@!cur_group: group_code; {current group type}
+@!cur_boundary: 0..save_size; {where the current level begins}
+
+@ At this time it might be a good idea for the reader to review the introduction
+to |eqtb| that was given above just before the long lists of parameter names.
+Recall that the ``outer level'' of the program is |level_one|, since
+undefined control sequences are assumed to be ``defined'' at |level_zero|.
+
+@<Set init...@>=
+save_ptr:=0; cur_level:=level_one; cur_group:=bottom_level; cur_boundary:=0;
+max_save_stack:=0;
+
+@ The following macro is used to test if there is room for up to eight more
+entries on |save_stack|. By making a conservative test like this, we can
+get by with testing for overflow in only a few places.
+
+@d check_full_save_stack==if save_ptr>max_save_stack then
+  begin max_save_stack:=save_ptr;
+  if max_save_stack>save_size-8 then overflow("save size",save_size);
+@:TeX capacity exceeded save size}{\quad save size@>
+  end
+
+@ Procedure |new_save_level| is called when a group begins. The
+argument is a group identification code like `|hbox_group|'. After
+calling this routine, it is safe to put six more entries on |save_stack|.
+
+In some cases integer-valued items are placed onto the
+|save_stack| just below a |level_boundary| word, because this is a
+convenient place to keep information that is supposed to ``pop up'' just
+when the group has finished.
+For example, when `\.{\\hbox to 100pt}\grp' is being treated, the 100pt
+dimension is stored on |save_stack| just before |new_save_level| is
+called.
+
+We use the notation |saved(k)| to stand for an integer item that
+appears in location |save_ptr+k| of the save stack.
+
+@d saved(#)==save_stack[save_ptr+#].int
+
+@p procedure new_save_level(@!c:group_code); {begin a new level of grouping}
+begin check_full_save_stack;
+saved(0):=line; incr(save_ptr);
+save_type(save_ptr):=level_boundary; save_level(save_ptr):=cur_group;
+save_index(save_ptr):=cur_boundary;
+if cur_level=max_quarterword then overflow("grouping levels",
+@:TeX capacity exceeded grouping levels}{\quad grouping levels@>
+  max_quarterword-min_quarterword);
+  {quit if |(cur_level+1)| is too big to be stored in |eqtb|}
+cur_boundary:=save_ptr; cur_group:=c;
+@!stat if tracing_groups>0 then group_trace(false);@+tats@;@/
+incr(cur_level); incr(save_ptr);
+end;
+
+@ Just before an entry of |eqtb| is changed, the following procedure should
+be called to update the other data structures properly. It is important
+to keep in mind that reference counts in |mem| include references from
+within |save_stack|, so these counts must be handled carefully.
+@^reference counts@>
+
+@p procedure eq_destroy(@!w:memory_word); {gets ready to forget |w|}
+var q:pointer; {|equiv| field of |w|}
+begin case eq_type_field(w) of
+call,long_call,outer_call,long_outer_call: delete_token_ref(equiv_field(w));
+glue_ref: delete_glue_ref(equiv_field(w));
+shape_ref: begin q:=equiv_field(w); {we need to free a \.{\\parshape} block}
+  if q<>null then flush_node(q);
+  end; {such a block is |2n+1| words long, where |n=vinfo(q)|}
+box_ref: flush_node_list(equiv_field(w));
+othercases do_nothing
+endcases;
+end;
+
+@ To save a value of |eqtb[p]| that was established at level |l|, we
+can use the following subroutine.
+
+@p procedure eq_save(@!p:pointer;@!l:quarterword); {saves |eqtb[p]|}
+begin check_full_save_stack;
+if l=level_zero then save_type(save_ptr):=restore_zero
+else  begin save_stack[save_ptr]:=eqtb[p]; incr(save_ptr);
+  save_type(save_ptr):=restore_old_value;
+  end;
+save_level(save_ptr):=l; save_index(save_ptr):=p; incr(save_ptr);
+end;
+
+@ The procedure |eq_define| defines an |eqtb| entry having specified
+|eq_type| and |equiv| fields, and saves the former value if appropriate.
+This procedure is used only for entries in the first four regions of |eqtb|,
+i.e., only for entries that have |eq_type| and |equiv| fields.
+After calling this routine, it is safe to put four more entries on
+|save_stack|, provided that there was room for four more entries before
+the call, since |eq_save| makes the necessary test.
+
+@d assign_trace(#)==@!stat if tracing_assigns>0 then restore_trace(#);
+  tats
+
+@p procedure eq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
+  {new data for |eqtb|}
+label exit;
+begin if (eq_type(p)=t)and(equiv(p)=e) then
+  begin assign_trace(p,"reassigning")@;@/
+  eq_destroy(eqtb[p]); return;
+  end;
+assign_trace(p,"changing")@;@/
+if eq_level(p)=cur_level then eq_destroy(eqtb[p])
+else if cur_level>level_one then eq_save(p,eq_level(p));
+eq_level(p):=cur_level; eq_type(p):=t; equiv(p):=e;
+assign_trace(p,"into")@;@/
+exit:end;
+
+@ The counterpart of |eq_define| for the remaining (fullword) positions in
+|eqtb| is called |eq_word_define|. Since |xeq_level[p]>=level_one| for all
+|p|, a `|restore_zero|' will never be used in this case.
+
+@p procedure eq_word_define(@!p:pointer;@!w:integer);
+label exit;
+begin if eqtb[p].int=w then
+  begin assign_trace(p,"reassigning")@;@/
+  return;
+  end;
+assign_trace(p,"changing")@;@/
+if xeq_level[p]<>cur_level then
+  begin eq_save(p,xeq_level[p]); xeq_level[p]:=cur_level;
+  end;
+eqtb[p].int:=w;
+assign_trace(p,"into")@;@/
+exit:end;
+
+@ The |eq_define| and |eq_word_define| routines take care of local definitions.
+@^global definitions@>
+Global definitions are done in almost the same way, but there is no need
+to save old values, and the new value is associated with |level_one|.
+
+@p procedure geq_define(@!p:pointer;@!t:quarterword;@!e:halfword);
+  {global |eq_define|}
+begin assign_trace(p,"globally changing")@;@/
+begin eq_destroy(eqtb[p]);
+eq_level(p):=level_one; eq_type(p):=t; equiv(p):=e;
+end;
+assign_trace(p,"into")@;@/
+end;
+@#
+procedure geq_word_define(@!p:pointer;@!w:integer); {global |eq_word_define|}
+begin assign_trace(p,"globally changing")@;@/
+begin eqtb[p].int:=w; xeq_level[p]:=level_one;
+end;
+assign_trace(p,"into")@;@/
+end;
+
+@ Subroutine |save_for_after| puts a token on the stack for save-keeping.
+
+@p procedure save_for_after(@!t:halfword);
+begin if cur_level>level_one then
+  begin check_full_save_stack;
+  save_type(save_ptr):=insert_token; save_level(save_ptr):=level_zero;
+  save_index(save_ptr):=t; incr(save_ptr);
+  end;
+end;
+
+@ The |unsave| routine goes the other way, taking items off of |save_stack|.
+This routine takes care of restoration when a level ends; everything
+belonging to the topmost group is cleared off of the save stack.
+
+@p
+procedure@?back_input; forward; @t\2@>
+procedure unsave; {pops the top level off the save stack}
+label done;
+var p:pointer; {position to be restored}
+@!l:quarterword; {saved level, if in fullword regions of |eqtb|}
+@!t:halfword; {saved value of |cur_tok|}
+@!a:boolean; {have we already processed an \.{\\aftergroup} ?}
+begin a:=false; l:=level_one; {just in case}
+unsave_math_codes(cur_level);
+unsave_cat_codes (cat_code_table,cur_level);
+unsave_text_codes(cur_level);
+if cur_level>level_one then
+  begin decr(cur_level);
+  @<Clear off top level from |save_stack|@>;
+  end
+else confusion("curlevel"); {|unsave| is not used when |cur_group=bottom_level|}
+@:this can't happen curlevel}{\quad curlevel@>
+attr_list_cache:=cache_disabled;
+end;
+
+@ @<Clear off...@>=
+loop@+begin decr(save_ptr);
+  if save_type(save_ptr)=level_boundary then goto done;
+  p:=save_index(save_ptr);
+  if save_type(save_ptr)=insert_token then
+    @<Insert token |p| into \TeX's input@>
+  else  begin if save_type(save_ptr)=restore_old_value then
+      begin l:=save_level(save_ptr); decr(save_ptr);
+      end
+    else save_stack[save_ptr]:=eqtb[undefined_control_sequence];
+    @<Store \(s)|save_stack[save_ptr]| in |eqtb[p]|, unless
+      |eqtb[p]| holds a global value@>;
+    end;
+  end;
+done: @!stat if tracing_groups>0 then group_trace(true);@+tats@;@/
+if grp_stack[in_open]=cur_boundary then group_warning;
+  {groups possibly not properly nested with files}
+cur_group:=save_level(save_ptr); cur_boundary:=save_index(save_ptr);
+decr(save_ptr)
+
+@ A global definition, which sets the level to |level_one|,
+@^global definitions@>
+will not be undone by |unsave|. If at least one global definition of
+|eqtb[p]| has been carried out within the group that just ended, the
+last such definition will therefore survive.
+
+@<Store \(s)|save...@>=
+if p<int_base then
+  if eq_level(p)=level_one then
+    begin eq_destroy(save_stack[save_ptr]); {destroy the saved value}
+    @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
+    end
+  else  begin eq_destroy(eqtb[p]); {destroy the current value}
+    eqtb[p]:=save_stack[save_ptr]; {restore the saved value}
+    @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+    end
+else if xeq_level[p]<>level_one then
+  begin eqtb[p]:=save_stack[save_ptr]; xeq_level[p]:=l;
+  @!stat if tracing_restores>0 then restore_trace(p,"restoring");@+tats@;@/
+  end
+else  begin
+  @!stat if tracing_restores>0 then restore_trace(p,"retaining");@+tats@;@/
+  end
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure restore_trace(@!p:pointer;@!s:str_number);
+  {|eqtb[p]| has just been restored or retained}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+show_eqtb(p); print_char("}");
+end_diagnostic(false);
+end;
+tats
+
+@ Most of the parameters kept in |eqtb| can be changed freely, but there's
+an exception:  The magnification should not be used with two different
+values during any \TeX\ job, since a single magnification is applied to an
+entire run. The global variable |mag_set| is set to the current magnification
+whenever it becomes necessary to ``freeze'' it at a particular value.
+
+@<Glob...@>=
+@!mag_set:integer; {if nonzero, this magnification should be used henceforth}
+
+@ @<Set init...@>=
+mag_set:=0;
+
+@ The |prepare_mag| subroutine is called whenever \TeX\ wants to use |mag|
+for magnification.
+
+@p procedure prepare_mag;
+begin if (mag_set>0)and(mag<>mag_set) then
+  begin print_err("Incompatible magnification ("); print_int(mag);
+@.Incompatible magnification@>
+  print(");"); print_nl(" the previous value will be retained");
+  help2("I can handle only one magnification ratio per job. So I've")@/
+  ("reverted to the magnification you used earlier on this run.");@/
+  int_error(mag_set);
+  geq_word_define(int_base+mag_code,mag_set); {|mag:=mag_set|}
+  end;
+if (mag<=0)or(mag>32768) then
+  begin print_err("Illegal magnification has been changed to 1000");@/
+@.Illegal magnification...@>
+  help1("The magnification ratio must be between 1 and 32768.");
+  int_error(mag); geq_word_define(int_base+mag_code,1000);
+  end;
+mag_set:=mag;
+end;
+
+@* \[20] Token lists.
+A \TeX\ token is either a character or a control sequence, and it is
+@^token@>
+represented internally in one of two ways: (1)~A character whose ASCII
+code number is |c| and whose command code is |m| is represented as the
+number $2^{21}m+c$; the command code is in the range |1<=m<=14|. (2)~A control
+sequence whose |eqtb| address is |p| is represented as the number
+|cs_token_flag+p|. Here |cs_token_flag=@t$2^{25}-1$@>| is larger than
+$2^{21}m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|;
+thus, a token fits comfortably in a halfword.
+
+A token |t| represents a |left_brace| command if and only if
+|t<left_brace_limit|; it represents a |right_brace| command if and only if
+we have |left_brace_limit<=t<right_brace_limit|; and it represents a |match| or
+|end_match| command if and only if |match_token<=t<=end_match_token|.
+The following definitions take care of these token-oriented constants
+and a few others.
+
+@d cs_token_flag==@"1FFFFFFF {amount added to the |eqtb| location in a
+  token that stands for a control sequence; is a multiple of~$2^{21}$, less~1}
+@d left_brace_token=@"200000   {$2^{21}\cdot|left_brace|$}
+@d left_brace_limit=@"400000   {$2^{21}\cdot(|left_brace|+1)$}
+@d right_brace_token=@"400000  {$2^{21}\cdot|right_brace|$}
+@d right_brace_limit=@"600000  {$2^{21}\cdot(|right_brace|+1)$}
+@d math_shift_token= @"600000  {$2^{21}\cdot|math_shift|$}
+@d tab_token=@"800000          {$2^{21}\cdot|tab_mark|$}
+@d out_param_token=@"A00000    {$2^{21}\cdot|out_param|$}
+@d space_token=@"1400020       {$2^{21}\cdot|spacer|+|" "|$}
+@d letter_token=@"1600000      {$2^{21}\cdot|letter|$}
+@d other_token=@"1800000       {$2^{21}\cdot|other_char|$}
+@d match_token=@"1A00000       {$2^{21}\cdot|match|$}
+@d end_match_token=@"1C00000   {$2^{21}\cdot|end_match|$}
+@d protected_token=@"1C00001   {$2^{21}\cdot|end_match|+1$}
+
+@ @<Check the ``constant''...@>=
+if cs_token_flag+undefined_control_sequence>max_halfword then bad:=21;
+
+@ A token list is a singly linked list of one-word nodes in |mem|, where
+each word contains a token and a link. Macro definitions, output-routine
+definitions, marks, \.{\\write} texts, and a few other things
+are remembered by \TeX\ in the form
+of token lists, usually preceded by a node with a reference count in its
+|token_ref_count| field. The token stored in location |p| is called
+|info(p)|.
+
+Three special commands appear in the token lists of macro definitions.
+When |m=match|, it means that \TeX\ should scan a parameter
+for the current macro; when |m=end_match|, it means that parameter
+matching should end and \TeX\ should start reading the macro text; and
+when |m=out_param|, it means that \TeX\ should insert parameter
+number |c| into the text at this point.
+
+The enclosing \.{\char'173} and \.{\char'175} characters of a macro
+definition are omitted, but the final right brace of an output routine
+is included at the end of its token list.
+
+Here is an example macro definition that illustrates these conventions.
+After \TeX\ processes the text
+$$\.{\\def\\mac a\#1\#2 \\b \{\#1\\-a \#\#1\#2 \#2\}}$$
+the definition of \.{\\mac} is represented as a token list containing
+$$\def\,{\hskip2pt}
+\vbox{\halign{\hfil#\hfil\cr
+(reference count), |letter|\,\.a, |match|\,\#, |match|\,\#, |spacer|\,\.\ ,
+\.{\\b}, |end_match|,\cr
+|out_param|\,1, \.{\\-}, |letter|\,\.a, |spacer|\,\.\ , |mac_param|\,\#,
+|other_char|\,\.1,\cr
+|out_param|\,2, |spacer|\,\.\ , |out_param|\,2.\cr}}$$
+The procedure |scan_toks| builds such token lists, and |macro_call|
+does the parameter matching.
+@^reference counts@>
+
+Examples such as
+$$\.{\\def\\m\{\\def\\m\{a\}\ b\}}$$
+explain why reference counts would be needed even if \TeX\ had no \.{\\let}
+operation: When the token list for \.{\\m} is being read, the redefinition of
+\.{\\m} changes the |eqtb| entry before the token list has been fully
+consumed, so we dare not simply destroy a token list when its
+control sequence is being redefined.
+
+If the parameter-matching part of a definition ends with `\.{\#\{}',
+the corresponding token list will have `\.\{' just before the `|end_match|'
+and also at the very end. The first `\.\{' is used to delimit the parameter; the
+second one keeps the first from disappearing.
+
+@ The procedure |show_token_list|, which prints a symbolic form of
+the token list that starts at a given node |p|, illustrates these
+conventions. The token list being displayed should not begin with a reference
+count. However, the procedure is intended to be robust, so that if the
+memory links are awry or if |p| is not really a pointer to a token list,
+nothing catastrophic will happen.
+
+An additional parameter |q| is also given; this parameter is either null
+or it points to a node in the token list where a certain magic computation
+takes place that will be explained later. (Basically, |q| is non-null when
+we are printing the two-line context information at the time of an error
+message; |q| marks the place corresponding to where the second line
+should begin.)
+
+For example, if |p| points to the node containing the first \.a in the
+token list above, then |show_token_list| will print the string
+$$\hbox{`\.{a\#1\#2\ \\b\ ->\#1\\-a\ \#\#1\#2\ \#2}';}$$
+and if |q| points to the node containing the second \.a,
+the magic computation will be performed just before the second \.a is printed.
+
+The generation will stop, and `\.{\\ETC.}' will be printed, if the length
+of printing exceeds a given limit~|l|. Anomalous entries are printed in the
+form of control sequences that are not followed by a blank space, e.g.,
+`\.{\\BAD.}'; this cannot be confused with actual control sequences because
+a real control sequence named \.{BAD} would come out `\.{\\BAD\ }'.
+
+@<Declare the procedure called |show_token_list|@>=
+procedure show_token_list(@!p,@!q:integer;@!l:integer);
+label exit;
+var m,@!c:integer; {pieces of a token}
+@!match_chr:ASCII_code; {character used in a `|match|'}
+@!n:ASCII_code; {the highest parameter number, as an ASCII digit}
+begin match_chr:="#"; n:="0"; tally:=0;
+while (p<>null) and (tally<l) do
+  begin if p=q then @<Do magic computation@>;
+  @<Display token |p|, and |return| if there are problems@>;
+  p:=link(p);
+  end;
+if p<>null then print_esc("ETC.");
+@.ETC@>
+exit:
+end;
+
+@ @<Display token |p|...@>=
+if (p<fix_mem_min) or (p>fix_mem_end) then
+  begin print_esc("CLOBBERED."); return;
+@.CLOBBERED@>
+  end;
+if info(p)>=cs_token_flag then begin
+  if not ((inhibit_par_tokens) and (info(p)=par_token)) then
+	  print_cs(info(p)-cs_token_flag);
+  end
+else  begin m:=info(p) div string_offset; c:=info(p) mod string_offset;
+  if info(p)<0 then print_esc("BAD.")
+@.BAD@>
+  else @<Display the token $(|m|,|c|)$@>;
+  end
+
+@ The procedure usually ``learns'' the character code used for macro
+parameters by seeing one in a |match| command before it runs into any
+|out_param| commands.
+
+@<Display the token ...@>=
+case m of
+left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer,
+  letter,other_char: print(c);
+mac_param: begin print(c); print(c);
+  end;
+out_param: begin print(match_chr);
+  if c<=9 then print_char(c+"0")
+  else  begin print_char("!"); return;
+    end;
+  end;
+match: begin match_chr:=c; print(c); incr(n); print_char(n);
+  if n>"9" then return;
+  end;
+end_match: if c=0 then print("->");
+@.->@>
+othercases print_esc("BAD.")
+@.BAD@>
+endcases
+
+@ Here's the way we sometimes want to display a token list, given a pointer
+to its reference count; the pointer may be null.
+
+@p procedure token_show(@!p:pointer);
+begin if p<>null then show_token_list(link(p),null,10000000);
+end;
+
+@ The |print_meaning| subroutine displays |cur_cmd| and |cur_chr| in
+symbolic form, including the expansion of a macro or mark.
+
+@p procedure print_meaning;
+begin print_cmd_chr(cur_cmd,cur_chr);
+if cur_cmd>=call then
+  begin print_char(":"); print_ln; token_show(cur_chr);
+  end
+else  @<Show the meaning of a mark node@>;
+end;
+
+@* \[21] Introduction to the syntactic routines.
+Let's pause a moment now and try to look at the Big Picture.
+The \TeX\ program consists of three main parts: syntactic routines,
+semantic routines, and output routines. The chief purpose of the
+syntactic routines is to deliver the user's input to the semantic routines,
+one token at a time. The semantic routines act as an interpreter
+responding to these tokens, which may be regarded as commands. And the
+output routines are periodically called on to convert box-and-glue
+lists into a compact set of instructions that will be sent
+to a typesetter. We have discussed the basic data structures and utility
+routines of \TeX, so we are good and ready to plunge into the real activity by
+considering the syntactic routines.
+
+Our current goal is to come to grips with the |get_next| procedure,
+which is the keystone of \TeX's input mechanism. Each call of |get_next|
+sets the value of three variables |cur_cmd|, |cur_chr|, and |cur_cs|,
+representing the next input token.
+$$\vbox{\halign{#\hfil\cr
+  \hbox{|cur_cmd| denotes a command code from the long list of codes
+   given above;}\cr
+  \hbox{|cur_chr| denotes a character code or other modifier of the command
+   code;}\cr
+  \hbox{|cur_cs| is the |eqtb| location of the current control sequence,}\cr
+  \hbox{\qquad if the current token was a control sequence,
+   otherwise it's zero.}\cr}}$$
+Underlying this external behavior of |get_next| is all the machinery
+necessary to convert from character files to tokens. At a given time we
+may be only partially finished with the reading of several files (for
+which \.{\\input} was specified), and partially finished with the expansion
+of some user-defined macros and/or some macro parameters, and partially
+finished with the generation of some text in a template for \.{\\halign},
+and so on. When reading a character file, special characters must be
+classified as math delimiters, etc.; comments and extra blank spaces must
+be removed, paragraphs must be recognized, and control sequences must be
+found in the hash table. Furthermore there are occasions in which the
+scanning routines have looked ahead for a word like `\.{plus}' but only
+part of that word was found, hence a few characters must be put back
+into the input and scanned again.
+
+To handle these situations, which might all be present simultaneously,
+\TeX\ uses various stacks that hold information about the incomplete
+activities, and there is a finite state control for each level of the
+input mechanism. These stacks record the current state of an implicitly
+recursive process, but the |get_next| procedure is not recursive.
+Therefore it will not be difficult to translate these algorithms into
+low-level languages that do not support recursion.
+
+@<Glob...@>=
+@!cur_cmd: eight_bits; {current command set by |get_next|}
+@!cur_chr: halfword; {operand of current command}
+@!cur_cs: pointer; {control sequence found here, zero if none found}
+@!cur_tok: halfword; {packed representative of |cur_cmd| and |cur_chr|}
+
+@ The |print_cmd_chr| routine prints a symbolic interpretation of a
+command code and its modifier. This is used in certain `\.{You can\'t}'
+error messages, and in the implementation of diagnostic routines like
+\.{\\show}.
+
+The body of |print_cmd_chr| is a rather tedious listing of print
+commands, and most of it is essentially an inverse to the |primitive|
+routine that enters a \TeX\ primitive into |eqtb|. Therefore much of
+this procedure appears elsewhere in the program,
+together with the corresponding |primitive| calls.
+
+@d chr_cmd(#)==begin print(#); print(chr_code);
+  end
+
+@<Declare the procedure called |print_cmd_chr|@>=
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+begin case cmd of
+left_brace: chr_cmd("begin-group character ");
+right_brace: chr_cmd("end-group character ");
+math_shift: chr_cmd("math shift character ");
+mac_param: chr_cmd("macro parameter character ");
+sup_mark: chr_cmd("superscript character ");
+sub_mark: chr_cmd("subscript character ");
+endv: print("end of alignment template");
+spacer: chr_cmd("blank space ");
+letter: chr_cmd("the letter ");
+other_char: chr_cmd("the character ");
+@t\4@>@<Cases of |print_cmd_chr| for symbolic printing of primitives@>@/
+othercases print("[unknown command code!]")
+endcases;
+end;
+
+@ Here is a procedure that displays the current command.
+
+@p procedure show_cur_cmd_chr;
+var n:integer; {level of \.{\\if...\\fi} nesting}
+@!l:integer; {line where \.{\\if} started}
+@!p:pointer;
+begin begin_diagnostic; print_nl("{");
+if mode<>shown_mode then
+  begin print_mode(mode); print(": "); shown_mode:=mode;
+  end;
+print_cmd_chr(cur_cmd,cur_chr);
+if tracing_ifs>0 then
+  if cur_cmd>=if_test then if cur_cmd<=fi_or_else then
+    begin print(": ");
+    if cur_cmd=fi_or_else then
+      begin print_cmd_chr(if_test,cur_if); print_char(" ");
+      n:=0; l:=if_line;
+      end
+    else  begin n:=1; l:=line;
+      end;
+    p:=cond_ptr;
+    while p<>null do
+      begin incr(n); p:=vlink(p);
+      end;
+    print("(level "); print_int(n); print_char(")"); print_if_line(l);
+    end;
+print_char("}");
+end_diagnostic(false);
+end;
+
+@* \[22] Input stacks and states.
+This implementation of
+\TeX\ uses two different conventions for representing sequential stacks.
+@^stack conventions@>@^conventions for representing stacks@>
+
+\yskip\hangg 1) If there is frequent access to the top entry, and if the
+stack is essentially never empty, then the top entry is kept in a global
+variable (even better would be a machine register), and the other entries
+appear in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the
+semantic stack described above is handled this way, and so is the input
+stack that we are about to study.
+
+\yskip\hangg 2) If there is infrequent top access, the entire stack contents
+are in the array $\\{stack}[0\to(\\{ptr}-1)]$. For example, the |save_stack|
+is treated this way, as we have seen.
+
+\yskip\noindent
+The state of \TeX's input mechanism appears in the input stack, whose
+entries are records with six fields, called |state|, |index|, |start|, |loc|,
+|limit|, and |name|. This stack is maintained with
+convention~(1), so it is declared in the following way:
+
+@<Types...@>=
+@!in_state_record = record
+  @!state_field, @!index_field: quarterword;
+  @!start_field,@!loc_field, @!limit_field, @!name_field,
+  @!ocp_lstack_field: halfword; {used for omega translation processes}
+  @!ocp_no_field: halfword; {used for omega translation processes} 
+  @!nofilter_field: boolean; {used by token filtering}
+  end;
+
+@ @<Glob...@>=
+@!input_stack : array[0..stack_size] of in_state_record;
+@!input_ptr : 0..stack_size; {first unused location of |input_stack|}
+@!max_in_stack: 0..stack_size; {largest value of |input_ptr| when pushing}
+@!cur_input : in_state_record;
+  {the ``top'' input state, according to convention (1)}
+
+@ We've already defined the special variable |loc==cur_input.loc_field|
+in our discussion of basic input-output routines. The other components of
+|cur_input| are defined in the same way:
+
+@d state==cur_input.state_field {current scanner state}
+@d index==cur_input.index_field {reference for buffer information}
+@d start==cur_input.start_field {starting position in |buffer|}
+@d limit==cur_input.limit_field {end of current line in |buffer|}
+@d nofilter==cur_input.nofilter_field {is token filtering explicitly disallowed?}
+@d name==cur_input.name_field {name of the current file}
+@d current_ocp_lstack==cur_input.ocp_lstack_field {name of the current ocp}
+@d current_ocp_no==cur_input.ocp_no_field {name of the current ocp}
+
+@ Let's look more closely now at the control variables
+(|state|,~|index|,~|start|,~|loc|,~|limit|,~|name|),
+assuming that \TeX\ is reading a line of characters that have been input
+from some file or from the user's terminal. There is an array called
+|buffer| that acts as a stack of all lines of characters that are
+currently being read from files, including all lines on subsidiary
+levels of the input stack that are not yet completed. \TeX\ will return to
+the other lines when it is finished with the present input file.
+
+(Incidentally, on a machine with byte-oriented addressing, it might be
+appropriate to combine |buffer| with the |str_pool| array,
+letting the buffer entries grow downward from the top of the string pool
+and checking that these two tables don't bump into each other.)
+
+The line we are currently working on begins in position |start| of the
+buffer; the next character we are about to read is |buffer[loc]|; and
+|limit| is the location of the last character present.  If |loc>limit|,
+the line has been completely read. Usually |buffer[limit]| is the
+|end_line_char|, denoting the end of a line, but this is not
+true if the current line is an insertion that was entered on the user's
+terminal in response to an error message.
+
+The |name| variable is a string number that designates the name of
+the current file, if we are reading a text file. It is zero if we
+are reading from the terminal; it is |n+1| if we are reading from
+input stream |n|, where |0<=n<=16|. (Input stream 16 stands for
+an invalid stream number; in such cases the input is actually from
+the terminal, under control of the procedure |read_toks|.)
+Finally |18<=name<=20| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} or \.{\\scantextokens} command.
+
+The |state| variable has one of three values, when we are scanning such
+files:
+$$\baselineskip 15pt\vbox{\halign{#\hfil\cr
+1) |state=mid_line| is the normal state.\cr
+2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr
+3) |state=new_line| is the state at the beginning of a line.\cr}}$$
+These state values are assigned numeric codes so that if we add the state
+code to the next character's command code, we get distinct values. For
+example, `|mid_line+spacer|' stands for the case that a blank
+space character occurs in the middle of a line when it is not being
+ignored; after this case is processed, the next value of |state| will
+be |skip_blanks|.
+
+@d mid_line=1 {|state| code when scanning a line of characters}
+@d skip_blanks=2+max_char_code {|state| code when ignoring blanks}
+@d new_line=3+max_char_code+max_char_code {|state| code at start of line}
+
+@ Additional information about the current line is available via the
+|index| variable, which counts how many lines of characters are present
+in the buffer below the current level. We have |index=0| when reading
+from the terminal and prompting the user for each line; then if the user types,
+e.g., `\.{\\input paper}', we will have |index=1| while reading
+the file \.{paper.tex}. However, it does not follow that |index| is the
+same as the input stack pointer, since many of the levels on the input
+stack may come from token lists. For example, the instruction `\.{\\input
+paper}' might occur in a token list.
+
+The global variable |in_open| is equal to the |index|
+value of the highest non-token-list level. Thus, the number of partially read
+lines in the buffer is |in_open+1|, and we have |in_open=index|
+when we are not reading a token list.
+
+If we are not currently reading from the terminal, or from an input
+stream, we are reading from the file variable |input_file[index]|. We use
+the notation |terminal_input| as a convenient abbreviation for |name=0|,
+and |cur_file| as an abbreviation for |input_file[index]|.
+
+The global variable |line| contains the line number in the topmost
+open file, for use in error messages. If we are not reading from
+the terminal, |line_stack[index]| holds the line number for the
+enclosing level, so that |line| can be restored when the current
+file has been read. Line numbers should never be negative, since the
+negative of the current line number is used to identify the user's output
+routine in the |mode_line| field of the semantic nest entries.
+
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable |@!page|, maintained for enclosing levels in
+`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@^system dependencies@>
+
+@d terminal_input==(name=0) {are we reading from the terminal?}
+@d cur_file==input_file[index] {the current |alpha_file| variable}
+
+@<Glob...@>=
+@!in_open : 0..max_in_open; {the number of lines in the buffer, less one}
+@!open_parens : 0..max_in_open; {the number of open text files}
+@!input_file : array[1..max_in_open] of alpha_file;
+@!line : integer; {current line number in the current source file}
+@!line_stack : array[1..max_in_open] of integer;
+
+@ Users of \TeX\ sometimes forget to balance left and right braces properly,
+and one of the ways \TeX\ tries to spot such errors is by considering an
+input file as broken into subfiles by control sequences that
+are declared to be \.{\\outer}.
+
+A variable called |scanner_status| tells \TeX\ whether or not to complain
+when a subfile ends. This variable has six possible values:
+
+\yskip\hang|normal|, means that a subfile can safely end here without incident.
+
+\yskip\hang|skipping|, means that a subfile can safely end here, but not a file,
+because we're reading past some conditional text that was not selected.
+
+\yskip\hang|defining|, means that a subfile shouldn't end now because a
+macro is being defined.
+
+\yskip\hang|matching|, means that a subfile shouldn't end now because a
+macro is being used and we are searching for the end of its arguments.
+
+\yskip\hang|aligning|, means that a subfile shouldn't end now because we are
+not finished with the preamble of an \.{\\halign} or \.{\\valign}.
+
+\yskip\hang|absorbing|, means that a subfile shouldn't end now because we are
+reading a balanced token list for \.{\\message}, \.{\\write}, etc.
+
+\yskip\noindent
+If the |scanner_status| is not |normal|, the variable |warning_index| points
+to the |eqtb| location for the relevant control sequence name to print
+in an error message.
+
+@d skipping=1 {|scanner_status| when passing conditional text}
+@d defining=2 {|scanner_status| when reading a macro definition}
+@d matching=3 {|scanner_status| when reading macro arguments}
+@d aligning=4 {|scanner_status| when reading an alignment preamble}
+@d absorbing=5 {|scanner_status| when reading a balanced text}
+
+@<Glob...@>=
+@!scanner_status : normal..absorbing; {can a subfile end now?}
+@!warning_index : pointer; {identifier relevant to non-|normal| scanner status}
+@!def_ref : pointer; {reference count of token list being defined}
+
+@ Here is a procedure that uses |scanner_status| to print a warning message
+when a subfile has ended, and at certain other crucial times:
+
+@<Declare the procedure called |runaway|@>=
+procedure runaway;
+var p:pointer; {head of runaway list}
+begin p:=null;
+  if scanner_status>skipping then
+  begin print_nl("Runaway ");
+@.Runaway...@>
+  case scanner_status of
+  defining: begin print("definition"); p:=def_ref;
+    end;
+  matching: begin print("argument"); p:=temp_token_head;
+    end;
+  aligning: begin print("preamble"); p:=hold_token_head;
+    end;
+  absorbing: begin print("text"); p:=def_ref;
+    end;
+  end; {there are no other cases}
+  print_char("?");print_ln; show_token_list(link(p),null,error_line-10);
+  end;
+end;
+
+@ However, all this discussion about input state really applies only to the
+case that we are inputting from a file. There is another important case,
+namely when we are currently getting input from a token list. In this case
+|state=token_list|, and the conventions about the other state variables
+are different:
+
+\yskip\hang|loc| is a pointer to the current node in the token list, i.e.,
+the node that will be read next. If |loc=null|, the token list has been
+fully read.
+
+\yskip\hang|start| points to the first node of the token list; this node
+may or may not contain a reference count, depending on the type of token
+list involved.
+
+\yskip\hang|token_type|, which takes the place of |index| in the
+discussion above, is a code number that explains what kind of token list
+is being scanned.
+
+\yskip\hang|name| points to the |eqtb| address of the control sequence
+being expanded, if the current token list is a macro.
+
+\yskip\hang|param_start|, which takes the place of |limit|, tells where
+the parameters of the current macro begin in the |param_stack|, if the
+current token list is a macro.
+
+\yskip\noindent The |token_type| can take several values, depending on
+where the current token list came from:
+
+\yskip\hang|parameter|, if a parameter is being scanned;
+
+\hang|u_template|, if the \<u_j> part of an alignment
+template is being scanned;
+
+\hang|v_template|, if the \<v_j> part of an alignment
+template is being scanned;
+
+\hang|backed_up|, if the token list being scanned has been inserted as
+`to be read again'.
+
+\hang|inserted|, if the token list being scanned has been inserted as
+the text expansion of a \.{\\count} or similar variable;
+
+\hang|macro|, if a user-defined control sequence is being scanned;
+
+\hang|output_text|, if an \.{\\output} routine is being scanned;
+
+\hang|every_par_text|, if the text of \.{\\everypar} is being scanned;
+
+\hang|every_math_text|, if the text of \.{\\everymath} is being scanned;
+
+\hang|every_display_text|, if the text of \.{\\everydisplay} is being scanned;
+
+\hang|every_hbox_text|, if the text of \.{\\everyhbox} is being scanned;
+
+\hang|every_vbox_text|, if the text of \.{\\everyvbox} is being scanned;
+
+\hang|every_job_text|, if the text of \.{\\everyjob} is being scanned;
+
+\hang|every_cr_text|, if the text of \.{\\everycr} is being scanned;
+
+\hang|mark_text|, if the text of a \.{\\mark} is being scanned;
+
+\hang|write_text|, if the text of a \.{\\write} is being scanned.
+
+\yskip\noindent
+The codes for |output_text|, |every_par_text|, etc., are equal to a constant
+plus the corresponding codes for token list parameters |output_routine_loc|,
+|every_par_loc|, etc.  The token list begins with a reference count if and
+only if |token_type>=macro|.
+@^reference counts@>
+
+Since \eTeX's additional token list parameters precede |toks_base|, the
+corresponding token types must precede |write_text|.
+
+@d token_list=0 {|state| code when scanning a token list}
+@d token_type==index {type of current token list}
+@d param_start==limit {base of macro parameters in |param_stack|}
+@d parameter=0 {|token_type| code for parameter}
+@d u_template=1 {|token_type| code for \<u_j> template}
+@d v_template=2 {|token_type| code for \<v_j> template}
+@d backed_up=3 {|token_type| code for text to be reread}
+@d inserted=4 {|token_type| code for inserted texts}
+@d macro=5 {|token_type| code for defined control sequences}
+@d output_text=6 {|token_type| code for output routines}
+@d every_par_text=7 {|token_type| code for \.{\\everypar}}
+@d every_math_text=8 {|token_type| code for \.{\\everymath}}
+@d every_display_text=9 {|token_type| code for \.{\\everydisplay}}
+@d every_hbox_text=10 {|token_type| code for \.{\\everyhbox}}
+@d every_vbox_text=11 {|token_type| code for \.{\\everyvbox}}
+@d every_job_text=12 {|token_type| code for \.{\\everyjob}}
+@d every_cr_text=13 {|token_type| code for \.{\\everycr}}
+@d mark_text=14 {|token_type| code for \.{\\topmark}, etc.}
+@#
+@d eTeX_text_offset=output_routine_loc-output_text
+@d every_eof_text=every_eof_loc-eTeX_text_offset
+  {|token_type| code for \.{\\everyeof}}
+@#
+@d write_text=etex_toks-eTeX_text_offset {|token_type| code for \.{\\write}}
+
+@ The |param_stack| is an auxiliary array used to hold pointers to the token
+lists for parameters at the current level and subsidiary levels of input.
+This stack is maintained with convention (2), and it grows at a different
+rate from the others.
+
+@<Glob...@>=
+@!param_stack:array [0..param_size] of pointer;
+  {token list pointers for parameters}
+@!param_ptr:0..param_size; {first unused entry in |param_stack|}
+@!max_param_stack:integer;
+  {largest value of |param_ptr|, will be |<=param_size+9|}
+
+@ The input routines must also interact with the processing of
+\.{\\halign} and \.{\\valign}, since the appearance of tab marks and
+\.{\\cr} in certain places is supposed to trigger the beginning of special
+\<v_j> template text in the scanner. This magic is accomplished by an
+|align_state| variable that is increased by~1 when a `\.{\char'173}' is
+scanned and decreased by~1 when a `\.{\char'175}' is scanned. The |align_state|
+is nonzero during the \<u_j> template, after which it is set to zero; the
+\<v_j> template begins when a tab mark or \.{\\cr} occurs at a time that
+|align_state=0|.
+
+@<Glob...@>=
+@!align_state:integer; {group level with respect to current alignment}
+
+@ Thus, the ``current input state'' can be very complicated indeed; there
+can be many levels and each level can arise in a variety of ways. The
+|show_context| procedure, which is used by \TeX's error-reporting routine to
+print out the current input state on all levels down to the most recent
+line of characters from an input file, illustrates most of these conventions.
+The global variable |base_ptr| contains the lowest level that was
+displayed by this procedure.
+
+@<Glob...@>=
+@!base_ptr:0..stack_size; {shallowest level shown by |show_context|}
+
+@ The status at each level is indicated by printing two lines, where the first
+line indicates what was read so far and the second line shows what remains
+to be read. The context is cropped, if necessary, so that the first line
+contains at most |half_error_line| characters, and the second contains
+at most |error_line|. Non-current input levels whose |token_type| is
+`|backed_up|' are shown only if they have not been fully read.
+
+@p procedure show_context; {prints where the scanner is}
+label done;
+var old_setting:0..max_selector; {saved |selector| setting}
+@!nn:integer; {number of contexts shown so far, less one}
+@!bottom_line:boolean; {have we reached the final context to be shown?}
+@<Local variables for formatting calculations@>@/
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+  {store current state}
+nn:=-1; bottom_line:=false;
+loop@+begin cur_input:=input_stack[base_ptr]; {enter into the context}
+  if (state<>token_list) then
+    if (name>21) or (base_ptr=0) then bottom_line:=true;
+  if (base_ptr=input_ptr)or bottom_line or(nn<error_context_lines) then
+    @<Display the current context@>
+  else if nn=error_context_lines then
+    begin print_nl("..."); incr(nn); {omitted if |error_context_lines<0|}
+    end;
+  if bottom_line then goto done;
+  decr(base_ptr);
+  end;
+done: cur_input:=input_stack[input_ptr]; {restore original state}
+end;
+
+@ @<Display the current context@>=
+begin if (base_ptr=input_ptr) or (state<>token_list) or
+   (token_type<>backed_up) or (loc<>null) then
+    {we omit backed-up token lists that have already been read}
+  begin tally:=0; {get ready to count characters}
+  old_setting:=selector;
+  if current_ocp_lstack>0 then
+  begin print_nl("OCP stack "); print_scaled(current_ocp_lstack); 
+        print(" entry "); print_int(current_ocp_no); print(":");
+    @<Pseudoprint the line@>;
+  end
+  else if state<>token_list then
+    begin @<Print location of current line@>;
+    @<Pseudoprint the line@>;
+    end
+  else  begin @<Print type of token list@>;
+    @<Pseudoprint the token list@>;
+    end;
+  selector:=old_setting; {stop pseudoprinting}
+  @<Print two lines using the tricky pseudoprinted information@>;
+  incr(nn);
+  end;
+end
+
+@ This routine should be changed, if necessary, to give the best possible
+indication of where the current line resides in the input file.
+For example, on some systems it is best to print both a page and line number.
+@^system dependencies@>
+
+@<Print location of current line@>=
+if name<=17 then
+  if terminal_input then
+    if base_ptr=0 then print_nl("<*>") else print_nl("<insert> ")
+  else  begin print_nl("<read ");
+    if name=17 then print_char("*")@+else print_int(name-1);
+@.*\relax@>
+    print_char(">");
+    end
+else if index<>in_open then {input from a pseudo file}
+  begin print_nl("l."); print_int(line_stack[index+1]);
+  end
+else  begin print_nl("l."); print_int(line);
+  end;
+print_char(" ")
+
+@ @<Print type of token list@>=
+case token_type of
+parameter: print_nl("<argument> ");
+u_template,v_template: print_nl("<template> ");
+backed_up: if loc=null then print_nl("<recently read> ")
+  else print_nl("<to be read again> ");
+inserted: print_nl("<inserted text> ");
+macro: begin print_ln; print_cs(name);
+  end;
+output_text: print_nl("<output> ");
+every_par_text: print_nl("<everypar> ");
+every_math_text: print_nl("<everymath> ");
+every_display_text: print_nl("<everydisplay> ");
+every_hbox_text: print_nl("<everyhbox> ");
+every_vbox_text: print_nl("<everyvbox> ");
+every_job_text: print_nl("<everyjob> ");
+every_cr_text: print_nl("<everycr> ");
+mark_text: print_nl("<mark> ");
+every_eof_text: print_nl("<everyeof> ");
+write_text: print_nl("<write> ");
+othercases print_nl("?") {this should never happen}
+endcases
+
+@ Here it is necessary to explain a little trick. We don't want to store a long
+string that corresponds to a token list, because that string might take up
+lots of memory; and we are printing during a time when an error message is
+being given, so we dare not do anything that might overflow one of \TeX's
+tables. So `pseudoprinting' is the answer: We enter a mode of printing
+that stores characters into a buffer of length |error_line|, where character
+$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
+|k<trick_count|, otherwise character |k| is dropped. Initially we set
+|tally:=0| and |trick_count:=1000000|; then when we reach the
+point where transition from line 1 to line 2 should occur, we
+set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
+tally+1+error_line-half_error_line)|. At the end of the
+pseudoprinting, the values of |first_count|, |tally|, and
+|trick_count| give us all the information we need to print the two lines,
+and all of the necessary text is in |trick_buf|.
+
+Namely, let |l| be the length of the descriptive information that appears
+on the first line. The length of the context information gathered for that
+line is |k=first_count|, and the length of the context information
+gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
+where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
+descriptive information on line~1, and set |n:=l+k|; here |n| is the
+length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
+and print `\.{...}' followed by
+$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
+where subscripts of |trick_buf| are circular modulo |error_line|. The
+second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
+unless |n+m>error_line|; in the latter case, further cropping is done.
+This is easier to program than to explain.
+
+@<Local variables for formatting...@>=
+@!i:0..buf_size; {index into |buffer|}
+@!j:0..buf_size; {end of current line in |buffer|}
+@!l:0..half_error_line; {length of descriptive information on line 1}
+@!m:integer; {context information gathered for line 2}
+@!n:0..error_line; {length of line 1}
+@!p: integer; {starting or ending place in |trick_buf|}
+@!q: integer; {temporary index}
+
+@ The following code sets up the print routines so that they will gather
+the desired information.
+
+@d begin_pseudoprint==
+  begin l:=tally; tally:=0; selector:=pseudo;
+  trick_count:=1000000;
+  end
+@d set_trick_count==
+  begin first_count:=tally;
+  trick_count:=tally+1+error_line-half_error_line;
+  if trick_count<error_line then trick_count:=error_line;
+  end
+
+@ And the following code uses the information after it has been gathered.
+
+@<Print two lines using the tricky pseudoprinted information@>=
+if trick_count=1000000 then set_trick_count;
+  {|set_trick_count| must be performed}
+if tally<trick_count then m:=tally-first_count
+else m:=trick_count-first_count; {context on line 2}
+if l+first_count<=half_error_line then
+  begin p:=0; n:=l+first_count;
+  end
+else  begin print("..."); p:=l+first_count-half_error_line+3;
+  n:=half_error_line;
+  end;
+for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]);
+print_ln;
+for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2}
+if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3);
+for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]);
+if m+n>error_line then print("...")
+
+@ But the trick is distracting us from our current goal, which is to
+understand the input state. So let's concentrate on the data structures that
+are being pseudoprinted as we finish up the |show_context| procedure.
+
+@<Pseudoprint the line@>=
+begin_pseudoprint;
+if buffer[limit]=end_line_char then j:=limit
+else j:=limit+1; {determine the effective end of the line}
+if j>0 then for i:=start to j-1 do
+  begin if i=loc then set_trick_count;
+  print_char(buffer[i]);
+  end
+
+@ @<Pseudoprint the token list@>=
+begin_pseudoprint;
+if token_type<macro then show_token_list(start,loc,100000)
+else show_token_list(link(start),loc,100000) {avoid reference count}
+
+@ Here is the missing piece of |show_token_list| that is activated when the
+token beginning line~2 is about to be shown:
+
+@<Do magic computation@>=set_trick_count
+
+@* \[23] Maintaining the input stacks.
+The following subroutines change the input status in commonly needed ways.
+
+First comes |push_input|, which stores the current state and creates a
+new level (having, initially, the same properties as the old).
+
+@d push_input==@t@> {enter a new input level, save the old}
+  begin if input_ptr>max_in_stack then
+    begin max_in_stack:=input_ptr;
+    if input_ptr=stack_size then overflow("input stack size",stack_size);
+@:TeX capacity exceeded input stack size}{\quad input stack size@>
+    end;
+  input_stack[input_ptr]:=cur_input; {stack the record}
+  nofilter:=false;
+  incr(input_ptr);
+  end
+
+@ And of course what goes up must come down.
+
+@d pop_input==@t@> {leave an input level, re-enter the old}
+  begin decr(input_ptr); cur_input:=input_stack[input_ptr];
+  end
+
+@ Here is a procedure that starts a new level of token-list input, given
+a token list |p| and its type |t|. If |t=macro|, the calling routine should
+set |name| and |loc|.
+
+@d back_list(#)==begin_token_list(#,backed_up) {backs up a simple token list}
+@d ins_list(#)==begin_token_list(#,inserted) {inserts a simple token list}
+
+@p procedure begin_token_list(@!p:pointer;@!t:quarterword);
+begin push_input; state:=token_list; start:=p; token_type:=t;
+if t>=macro then {the token list starts with a reference count}
+  begin add_token_ref(p);
+  if t=macro then param_start:=param_ptr
+  else  begin loc:=link(p);
+    if tracing_macros>1 then
+      begin begin_diagnostic; print_nl("");
+      case t of
+      mark_text:print_esc("mark");
+      write_text:print_esc("write");
+      othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc)
+      endcases;@/
+      print("->"); token_show(p); end_diagnostic(false);
+      end;
+    end;
+  end
+else loc:=p;
+end;
+
+@ When a token list has been fully scanned, the following computations
+should be done as we leave that level of input. The |token_type| tends
+to be equal to either |backed_up| or |inserted| about 2/3 of the time.
+@^inner loop@>
+
+@p procedure end_token_list; {leave a token-list input level}
+begin if token_type>=backed_up then {token list to be deleted}
+  begin if token_type<=inserted then flush_list(start)
+  else  begin delete_token_ref(start); {update reference count}
+    if token_type=macro then {parameters must be flushed}
+      while param_ptr>param_start do
+        begin decr(param_ptr);
+        flush_list(param_stack[param_ptr]);
+        end;
+    end;
+  end
+else if token_type=u_template then
+  if align_state>500000 then align_state:=0
+  else fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+pop_input;
+check_interrupt;
+end;
+
+@ Sometimes \TeX\ has read too far and wants to ``unscan'' what it has
+seen. The |back_input| procedure takes care of this by putting the token
+just scanned back into the input stream, ready to be read again. This
+procedure can be used only if |cur_tok| represents the token to be
+replaced. Some applications of \TeX\ use this procedure a lot,
+so it has been slightly optimized for speed.
+@^inner loop@>
+
+@p procedure back_input; {undoes one token of input}
+var p:pointer; {a token list of length one}
+begin while (state=token_list)and(loc=null)and(token_type<>v_template) do
+  end_token_list; {conserve stack space}
+p:=get_avail; info(p):=cur_tok;
+if cur_tok<right_brace_limit then
+  if cur_tok<left_brace_limit then decr(align_state)
+  else incr(align_state);
+push_input; state:=token_list; start:=p; token_type:=backed_up;
+loc:=p; {that was |back_list(p)|, without procedure overhead}
+end;
+
+@ @<Insert token |p| into \TeX's input@>=
+begin t:=cur_tok; cur_tok:=p;
+if a then
+  begin p:=get_avail; info(p):=cur_tok; link(p):=loc; loc:=p; start:=p;
+  if cur_tok<right_brace_limit then
+    if cur_tok<left_brace_limit then decr(align_state)
+    else incr(align_state);
+  end
+else  begin back_input; a:=1; { etex is always on }
+  end;
+cur_tok:=t;
+end
+
+@ The |back_error| routine is used when we want to replace an offending token
+just before issuing an error message. This routine, like |back_input|,
+requires that |cur_tok| has been set. We disable interrupts during the
+call of |back_input| so that the help message won't be lost.
+
+@p procedure back_error; {back up one token and call |error|}
+begin OK_to_interrupt:=false; back_input; OK_to_interrupt:=true; error;
+end;
+@#
+procedure ins_error; {back up one inserted token and call |error|}
+begin OK_to_interrupt:=false; back_input; token_type:=inserted;
+OK_to_interrupt:=true; error;
+end;
+
+@ The |begin_file_reading| procedure starts a new level of input for lines
+of characters to be read from a file, or as an insertion from the
+terminal. It does not take care of opening the file, nor does it set |loc|
+or |limit| or |line|.
+@^system dependencies@>
+
+@p procedure begin_file_reading;
+begin if in_open=max_in_open then overflow("text input levels",max_in_open);
+@:TeX capacity exceeded text input levels}{\quad text input levels@>
+if first=buf_size then check_buffer_overflow(first);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+incr(in_open); push_input; index:=in_open;
+eof_seen[index]:=false;
+grp_stack[index]:=cur_boundary; if_stack[index]:=cond_ptr;
+line_stack[index]:=line; start:=first; state:=mid_line;
+name:=0; {|terminal_input| is now |true|}
+end;
+
+@ Conversely, the variables must be downdated when such a level of input
+is finished:
+
+@p procedure end_file_reading;
+begin first:=start; line:=line_stack[index];
+if (name>=18)and(name<=20) then pseudo_close else
+if name=21 then luacstring_close(index) else
+if name>17 then lua_a_close_in(cur_file,0); {forget it}
+pop_input; decr(in_open);
+end;
+
+@ In order to keep the stack from overflowing during a long sequence of
+inserted `\.{\\show}' commands, the following routine removes completed
+error-inserted lines from memory.
+
+@p procedure clear_for_error_prompt;
+begin while (state<>token_list)and terminal_input and@|
+  (input_ptr>0)and(loc>limit) do end_file_reading;
+print_ln; clear_terminal;
+end;
+
+@ To get \TeX's whole input mechanism going, we perform the following
+actions.
+
+@<Initialize the input routines@>=
+begin input_ptr:=0; max_in_stack:=0;
+in_open:=0; open_parens:=0; max_buf_stack:=0;
+grp_stack[0]:=0; if_stack[0]:=null;
+param_ptr:=0; max_param_stack:=0;
+first:=buf_size; repeat buffer[first]:=0; decr(first); until first=0;
+scanner_status:=normal; warning_index:=null; first:=1;
+state:=new_line; start:=1; index:=0; line:=0; name:=0;
+current_ocp_lstack:=0; current_ocp_no:=0; nofilter:=false;
+force_eof:=false; luacstrings :=0;
+align_state:=1000000;@/
+if not init_terminal then goto final_end;
+limit:=last; first:=last+1; {|init_terminal| has set |loc| and |last|}
+end
+
+@* \[24] Getting the next token.
+The heart of \TeX's input mechanism is the |get_next| procedure, which
+we shall develop in the next few sections of the program. Perhaps we
+shouldn't actually call it the ``heart,'' however, because it really acts
+as \TeX's eyes and mouth, reading the source files and gobbling them up.
+And it also helps \TeX\ to regurgitate stored token lists that are to be
+processed again.
+@^eyes and mouth@>
+
+The main duty of |get_next| is to input one token and to set |cur_cmd|
+and |cur_chr| to that token's command code and modifier. Furthermore, if
+the input token is a control sequence, the |eqtb| location of that control
+sequence is stored in |cur_cs|; otherwise |cur_cs| is set to zero.
+
+Underlying this simple description is a certain amount of complexity
+because of all the cases that need to be handled.
+However, the inner loop of |get_next| is reasonably short and fast.
+
+When |get_next| is asked to get the next token of a \.{\\read} line,
+it sets |cur_cmd=cur_chr=cur_cs=0| in the case that no more tokens
+appear on that line. (There might not be any tokens at all, if the
+|end_line_char| has |ignore| as its catcode.)
+
+@ The value of |par_loc| is the |eqtb| address of `\.{\\par}'. This quantity
+is needed because a blank line of input is supposed to be exactly equivalent
+to the appearance of \.{\\par}; we must set |cur_cs:=par_loc|
+when detecting a blank line.
+
+@<Glob...@>=
+@!par_loc:pointer; {location of `\.{\\par}' in |eqtb|}
+@!par_token:halfword; {token representing `\.{\\par}'}
+
+@ @<Put each...@>=
+primitive("par",par_end,too_big_char); {cf. |scan_file_name|}
+@!@:par_}{\.{\\par} primitive@>
+par_loc:=cur_val; par_token:=cs_token_flag+par_loc;
+
+@ @<Cases of |print_cmd_chr|...@>=
+par_end:print_esc("par");
+
+@ The function |get_next| is now defined in |textoken.c|. Parts of
+this routine are executed more often than any other instructions of \TeX.
+@^mastication@>@^inner loop@>
+
+@ The global variable |force_eof| is normally |false|; it is set |true|
+by an \.{\\endinput} command. |luacstrings| is the number of lua print 
+statements waiting to be input, it is changed by |luatokencall|.
+ 
+|no_expand_flag| is a special character value that is inserted by
+|get_next| if it wants to suppress expansion.
+
+@d no_expand_flag==special_char {this characterizes a special variant of |relax|}
+@d end_line_char_inactive==(end_line_char<0)or(end_line_char>127)
+
+
+@<Glob...@>=
+@!force_eof:boolean; {should the next \.{\\input} be aborted early?}
+@!luacstrings:integer;  {how many lua strings are waiting to be input?}
+
+@ If the user has set the |pausing| parameter to some positive value,
+and if nonstop mode has not been selected, each line of input is displayed
+on the terminal and the transcript file, followed by `\.{=>}'.
+\TeX\ waits for a response. If the response is simply |carriage_return|, the
+line is accepted as it stands, otherwise the line typed is
+used instead of the line in the file.
+
+@p procedure firm_up_the_line;
+var k:0..buf_size; {an index into |buffer|}
+begin limit:=last;
+if pausing>0 then if interaction>nonstop_mode then
+  begin wake_up_terminal; print_ln;
+  if start<limit then for k:=start to limit-1 do print(buffer[k]);
+  first:=limit; prompt_input("=>"); {wait for user response}
+@.=>@>
+  if last>first then
+    begin for k:=first to last-1 do {move line down in buffer}
+      buffer[k+start-first]:=buffer[k];
+    limit:=start+last-first;
+    end;
+  end;
+end;
+
+@ Since |get_next| is used so frequently in \TeX, it is convenient
+to define three related procedures that do a little more:
+
+\yskip\hang|get_token| not only sets |cur_cmd| and |cur_chr|, it
+also sets |cur_tok|, a packed halfword version of the current token.
+
+\yskip\hang|get_x_token|, meaning ``get an expanded token,'' is like
+|get_token|, but if the current token turns out to be a user-defined
+control sequence (i.e., a macro call), or a conditional,
+or something like \.{\\topmark} or \.{\\expandafter} or \.{\\csname},
+it is eliminated from the input by beginning the expansion of the macro
+or the evaluation of the conditional.
+
+\yskip\hang|x_token| is like |get_x_token| except that it assumes that
+|get_next| has already been called.
+
+\yskip\noindent
+In fact, these three procedures account for {\sl all\/} uses of |get_next|,
+except for two places in the ``inner loop'' when |cur_tok| need not be set,
+and except when the arguments to \.{\\ifx} are being scanned.
+
+@ No new control sequences will be defined except during a call of
+|get_token|, or when \.{\\csname} compresses a token list, because
+|no_new_control_sequence| is always |true| at other times.
+
+@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|}
+begin no_new_control_sequence:=false; get_filtered_next; no_new_control_sequence:=true;
+@^inner loop@>
+if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@* \[25] Expanding the next token.
+Only a dozen or so command codes |>max_command| can possibly be returned by
+|get_next|; in increasing order, they are |undefined_cs|, |expand_after|,
+|no_expand|, |input|, |if_test|, |fi_or_else|, |cs_name|, |convert|, |the|,
+|top_bot_mark|, |call|, |long_call|, |outer_call|, |long_outer_call|, and
+|end_template|.{\emergencystretch=40pt\par}
+
+@ Sometimes, recursive calls to the following |expand| routine may 
+cause exhaustion of the run-time calling stack, resulting in
+forced execution stops by the operating system. To diminish the chance
+of this happening, a counter is used to keep track of the recursion
+depth, in conjunction with a constant called |expand_depth|. 
+
+Note that this does not catch all possible infinite recursion loops,
+just the ones that exhaust the application calling stack. The
+actual maximum value of |expand_depth| is outside of our control, but
+the initial setting of |100| should be enough to prevent problems.
+@^system dependencies@>
+
+@<Global...@>=
+expand_depth_count:integer;
+
+@ @<Initialize whatever ...@>=
+expand_depth_count:=0;
+
+@ The |expand| subroutine is used when |cur_cmd>max_command|. It removes a
+``call'' or a conditional or one of the other special operations just
+listed.  It follows that |expand| might invoke itself recursively. In all
+cases, |expand| destroys the current token, but it sets things up so that
+the next |get_next| will deliver the appropriate next token. The value of
+|cur_tok| need not be known when |expand| is called.
+
+Since several of the basic scanning routines communicate via global variables,
+their values are saved as local variables of |expand| so that
+recursive calls don't invalidate them.
+@^recursion@>
+
+@p@t\4@>@<Declare the procedure called |macro_call|@>@;@/
+@t\4@>@<Declare the procedure called |insert_relax|@>@;@/
+@t\4@>@<Declare \eTeX\ procedures for expanding@>@;@/
+procedure@?pass_text; forward;@t\2@>
+procedure@?start_input; forward;@t\2@>
+procedure@?conditional; forward;@t\2@>
+procedure@?get_x_token; forward;@t\2@>
+procedure@?conv_toks; forward;@t\2@>
+procedure@?ins_the_toks; forward;@t\2@>
+procedure expand;
+label reswitch;
+var t:halfword; {token that is being ``expanded after''}
+@!p,@!q,@!r:pointer; {for list manipulation}
+@!cur_ptr:pointer; { for a local token list pointer }
+@!j:0..buf_size; {index into |buffer|}
+@!s:ASCII_code; { a character }
+@!cv_backup:integer; {to save the global quantity |cur_val|}
+@!cvl_backup,@!radix_backup,@!co_backup:small_number;
+  {to save |cur_val_level|, etc.}
+@!backup_backup:pointer; {to save |link(backup_head)|}
+@!save_scanner_status:small_number; {temporary storage of |scanner_status|}
+begin 
+incr(expand_depth_count);
+if expand_depth_count>=expand_depth then overflow("expansion depth",expand_depth);
+cv_backup:=cur_val; cvl_backup:=cur_val_level; radix_backup:=radix;
+co_backup:=cur_order; backup_backup:=link(backup_head);
+reswitch:
+if cur_cmd<call then @<Expand a nonmacro@>
+else if cur_cmd<end_template then macro_call
+else @<Insert a token containing |frozen_endv|@>;
+cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup;
+cur_order:=co_backup; link(backup_head):=backup_backup;
+decr(expand_depth_count);
+end;
+
+@ @<Glob...@>=
+@!is_in_csname: boolean;
+
+@ @<Set init...@>=
+is_in_csname := false;
+
+@ @<Expand a nonmacro@>=
+begin if tracing_commands>1 then show_cur_cmd_chr;
+case cur_cmd of
+top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>;
+expand_after:if cur_chr=0 then @<Expand the token after the next token@>
+  else @<Negate a boolean conditional and |goto reswitch|@>;
+no_expand: if cur_chr=0 then @<Suppress expansion of the next token@> 
+  else @<Implement \.{\\primitive}@>;
+cs_name:@<Manufacture a control sequence name@>;
+convert:conv_toks; {this procedure is discussed in Part 27 below}
+the:ins_the_toks; {this procedure is discussed in Part 27 below}
+if_test:conditional; {this procedure is discussed in Part 28 below}
+fi_or_else:@<Terminate the current conditional and skip to \.{\\fi}@>;
+input:@<Initiate or terminate input from a file@>;
+othercases @<Complain about an undefined macro@>
+endcases;
+end
+
+@ It takes only a little shuffling to do what \TeX\ calls \.{\\expandafter}.
+
+@<Expand the token after...@>=
+begin get_token; t:=cur_tok; get_token;
+if cur_cmd>max_command then expand@+else back_input;
+cur_tok:=t; back_input;
+end
+
+@ The implementation of \.{\\noexpand} is a bit trickier, because it is
+necessary to insert a special `|dont_expand|' marker into \TeX's reading
+mechanism.  This special marker is processed by |get_next|, but it does
+not slow down the inner loop.
+
+Since \.{\\outer} macros might arise here, we must also
+clear the |scanner_status| temporarily.
+
+@<Suppress expansion...@>=
+begin save_scanner_status:=scanner_status; scanner_status:=normal;
+get_token; scanner_status:=save_scanner_status; t:=cur_tok;
+back_input; {now |start| and |loc| point to the backed-up token |t|}
+if t>=cs_token_flag then
+  begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand;
+  link(p):=loc; start:=p; loc:=p;
+  end;
+end
+
+@ The \.{\\primitive} handling. If the primitive meaning of the next 
+token is an expandable command, it suffices to replace the current
+token with the primitive one and restart |expand|. 
+
+Otherwise, the token we just read has to be pushed back, as well
+as a token matching the internal form of \.{\\primitive}, that is
+sneaked in as an alternate form of |ignore_spaces|.
+@!@:primitive_}{\.{\\primitive} primitive (internalized)@>
+
+An implementation problem surfaces: There really is no |cur_cs|
+attached to the inserted primitive command, so it is safer to set
+|cur_cs| to zero.  |cur_tok| has a similar problem. And for the
+non-expanded branch, simply pushing back a token that matches the
+correct internal command does not work, because that approach would
+not survive roundtripping to a temporary file or even a token list.
+
+In a next version, it would be smart to create |frozen_| versions of
+all the primitives.  Then, this problem would not happen, at the
+expense of a few hundred extra control sequences.
+
+@<Implement \.{\\primitive}@>=
+begin save_scanner_status := scanner_status; scanner_status:=normal;
+get_token; scanner_status:=save_scanner_status;
+cur_cs := prim_lookup(text(cur_cs));
+if cur_cs<>undefined_primitive then begin
+  t:=get_prim_eq_type(cur_cs);
+  if t>max_command then begin
+    cur_cmd := t;
+    cur_chr := get_prim_equiv(cur_cs);
+    cur_tok := (cur_cmd*string_offset)+cur_chr;
+    cur_cs  := 0;
+    goto reswitch;
+    end 
+  else begin
+    back_input; { now |loc| and |start| point to a one-item list }
+    p:=get_avail; info(p):=cs_token_flag+frozen_primitive;
+    link(p):=loc; loc:=p; start:=p; 
+    end;
+  end;
+end
+
+@ @<Complain about an undefined macro@>=
+begin print_err("Undefined control sequence");
+@.Undefined control sequence@>
+help5("The control sequence at the end of the top line")@/
+("of your error message was never \def'ed. If you have")@/
+("misspelled it (e.g., `\hobx'), type `I' and the correct")@/
+("spelling (e.g., `I\hbox'). Otherwise just continue,")@/
+("and I'll forget about whatever was undefined.");
+error;
+end
+
+@ The |expand| procedure and some other routines that construct token
+lists find it convenient to use the following macros, which are valid only if
+the variables |p| and |q| are reserved for token-list building.
+
+@d store_new_token(#)==begin q:=get_avail; link(p):=q; info(q):=#;
+  p:=q; {|link(p)| is |null|}
+  end
+@d fast_store_new_token(#)==begin fast_get_avail(q); link(p):=q; info(q):=#;
+  p:=q; {|link(p)| is |null|}
+  end
+
+@ @<Manufacture a control...@>=
+begin r:=get_avail; p:=r; {head of the list of characters}
+is_in_csname := true;
+repeat get_x_token;
+if cur_cs=0 then store_new_token(cur_tok);
+until cur_cs<>0;
+if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+is_in_csname := false;
+@<Look up the characters of list |r| in the hash table, and set |cur_cs|@>;
+flush_list(r);
+if eq_type(cur_cs)=undefined_cs then
+  begin eq_define(cur_cs,relax,too_big_char); {N.B.: The |save_stack| might change}
+  end; {the control sequence will now match `\.{\\relax}'}
+cur_tok:=cur_cs+cs_token_flag; back_input;
+end
+
+@ @<Complain about missing \.{\\endcsname}@>=
+begin print_err("Missing "); print_esc("endcsname"); print(" inserted");
+@.Missing \\endcsname...@>
+help2("The control sequence marked <to be read again> should")@/
+  ("not appear between \csname and \endcsname.");
+back_error;
+end
+
+@ @<Look up the characters of list |r| in the hash table...@>=
+j:=first; p:=link(r);
+while p<>null do
+  begin if j>=max_buf_stack then
+    begin max_buf_stack:=j+4;
+    if max_buf_stack=buf_size then
+      check_buffer_overflow(max_buf_stack);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+    end;
+  s := info(p) mod string_offset;
+  if s <= @"7F then begin
+    buffer[j]:=s; incr(j);
+    end
+  else if s<=@"7FF then begin
+    buffer[j]:=@"C0 + s div @"40; incr(j);
+    buffer[j]:=@"80 + s mod @"40; incr(j);
+    end
+  else if s<=@"FFFF then begin
+    buffer[j]:=@"E0 + s div @"1000; incr(j);
+    buffer[j]:=@"80 + (s mod @"1000) div @"40; incr(j);
+    buffer[j]:=@"80 + (s mod @"1000) mod @"40; incr(j);
+    end 
+  else begin
+    buffer[j]:=@"F0 + s div @"40000;  incr(j);
+    buffer[j]:=@"80 + (s mod @"40000) div @"1000;  incr(j);
+    buffer[j]:=@"80 + ((s mod @"40000) mod @"1000) div @"40;  incr(j);
+    buffer[j]:=@"80 + ((s mod @"40000) mod @"1000) mod @"40;  incr(j);
+    end;
+  p:=link(p); 
+  end;
+if j>first then
+  begin no_new_control_sequence:=false; cur_cs:=id_lookup(first,j-first);
+  no_new_control_sequence:=true;
+  end
+else if j=first then cur_cs:=null_cs {the list is empty}
+
+@ An |end_template| command is effectively changed to an |endv| command
+by the following code. (The reason for this is discussed below; the
+|frozen_end_template| at the end of the template has passed the
+|check_outer_validity| test, so its mission of error detection has been
+accomplished.)
+
+@<Insert a token containing |frozen_endv|@>=
+begin cur_tok:=cs_token_flag+frozen_endv; back_input;
+end
+
+@ The processing of \.{\\input} involves the |start_input| subroutine,
+which will be declared later; the processing of \.{\\endinput} is trivial.
+
+@<Put each...@>=
+primitive("input",input,0);@/
+@!@:input_}{\.{\\input} primitive@>
+primitive("endinput",input,1);@/
+@!@:end_input_}{\.{\\endinput} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+input: if chr_code=0 then print_esc("input")
+  @/@<Cases of |input| for |print_cmd_chr|@>@/
+  else print_esc("endinput");
+
+@ @<Initiate or terminate input...@>=
+if cur_chr=1 then force_eof:=true
+@/@<Cases for |input|@>@/
+else if name_in_progress then insert_relax
+else start_input
+
+@ Sometimes the expansion looks too far ahead, so we want to insert
+a harmless \.{\\relax} into the user's input.
+
+@<Declare the procedure called |insert_relax|@>=
+procedure insert_relax;
+begin cur_tok:=cs_token_flag+cur_cs; back_input;
+cur_tok:=cs_token_flag+frozen_relax; back_input; token_type:=inserted;
+end;
+
+@ Here is a recursive procedure that is \TeX's usual way to get the
+next token of input. It has been slightly optimized to take account of
+common cases.
+
+@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+  and expands macros}
+label restart,done;
+begin restart: get_filtered_next;
+@^inner loop@>
+if cur_cmd<=max_command then goto done;
+if cur_cmd>=call then
+  if cur_cmd<end_template then macro_call
+  else  begin cur_cs:=frozen_endv; cur_cmd:=endv;
+    goto done; {|cur_chr=null_list|}
+    end
+else expand;
+goto restart;
+done: if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ The |get_x_token| procedure is equivalent to two consecutive
+procedure calls: |get_next; x_token|.
+
+@p procedure x_token; {|get_x_token| without the initial |get_next|}
+begin while cur_cmd>max_command do
+  begin expand;
+  get_filtered_next;
+  end;
+if cur_cs=0 then cur_tok:=(cur_cmd*string_offset)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ The |get_filtered_next| procedure allows Lua code to mutate the 
+output of |get_next| before \TeX\ looks at it. The implementation
+is in the C file |luatoken.c|.
+
+@d get_filtered_next==get_token_lua
+
+
+
+@ A control sequence that has been \.{\\def}'ed by the user is expanded by
+\TeX's |macro_call| procedure.
+
+Before we get into the details of |macro_call|, however, let's consider the
+treatment of primitives like \.{\\topmark}, since they are essentially
+macros without parameters. The token lists for such marks are kept in five
+global arrays of pointers; we refer to the individual entries of these
+arrays by symbolic macros |top_mark|, etc. The value of |top_mark(x)|, etc.
+is either |null| or a pointer to the reference count of a token list.
+
+The variable |biggest_used_mark| is an aid to try and keep the code
+somehwat efficient without too much extra work: it registers the
+highest mark class ever instantiated by the user, so the loops
+in |fire_up| and |vsplit| do not have to traverse the full range
+|0..biggest_mark|.
+
+@d top_mark_code=0 {the mark in effect at the previous page break}
+@d first_mark_code=1 {the first mark between |top_mark| and |bot_mark|}
+@d bot_mark_code=2 {the mark in effect at the current page break}
+@d split_first_mark_code=3 {the first mark found by \.{\\vsplit}}
+@d split_bot_mark_code=4 {the last mark found by \.{\\vsplit}}
+@#
+@d top_mark(#)==top_marks_array[#]
+@d first_mark(#)==first_marks_array[#]
+@d bot_mark(#)==bot_marks_array[#]
+@d split_first_mark(#)==split_first_marks_array[#]
+@d split_bot_mark(#)==split_bot_marks_array[#]
+@#
+@d delete_top_mark(#)==begin if top_mark(#)<>null then 
+      delete_token_ref(top_mark(#)); top_mark(#):=null; end
+@d delete_bot_mark(#)==begin if bot_mark(#)<>null then
+      delete_token_ref(bot_mark(#)); bot_mark(#):=null; end
+@d delete_first_mark(#)==begin if first_mark(#)<>null then
+      delete_token_ref(first_mark(#)); first_mark(#):=null; end
+@d delete_split_first_mark(#)==begin if split_first_mark(#)<>null then
+      delete_token_ref(split_first_mark(#)); split_first_mark(#):=null; end
+@d delete_split_bot_mark(#)==begin if split_bot_mark(#)<>null then
+      delete_token_ref(split_bot_mark(#)); split_bot_mark(#):=null; end
+@#
+@d clear_marks_code=1
+@d marks_code=5
+@#
+
+@<Glob...@>=
+@!top_marks_array:array[0..biggest_mark] of pointer;
+@!first_marks_array:array[0..biggest_mark] of pointer;
+@!bot_marks_array:array[0..biggest_mark] of pointer;
+@!split_first_marks_array:array[0..biggest_mark] of pointer;
+@!split_bot_marks_array:array[0..biggest_mark] of pointer;
+biggest_used_mark:halfword;
+
+@ @<Set init...@>=
+biggest_used_mark:=0;
+for i:=0 to biggest_mark do begin
+  top_mark(i):=null;
+  first_mark(i):=null;
+  bot_mark(i):=null;
+  split_first_mark(i):=null;
+  split_bot_mark(i):=null;
+end;
+
+@ @<Put each...@>=
+primitive("topmark",top_bot_mark,top_mark_code);
+@!@:top_mark_}{\.{\\topmark} primitive@>
+primitive("firstmark",top_bot_mark,first_mark_code);
+@!@:first_mark_}{\.{\\firstmark} primitive@>
+primitive("botmark",top_bot_mark,bot_mark_code);
+@!@:bot_mark_}{\.{\\botmark} primitive@>
+primitive("splitfirstmark",top_bot_mark,split_first_mark_code);
+@!@:split_first_mark_}{\.{\\splitfirstmark} primitive@>
+primitive("splitbotmark",top_bot_mark,split_bot_mark_code);
+@!@:split_bot_mark_}{\.{\\splitbotmark} primitive@>
+primitive("clearmarks",mark,clear_marks_code);@/
+@!@:clearmarks_}{\.{\\clearmarks} primitive@>
+primitive("marks",mark,marks_code);
+@!@:marks_}{\.{\\marks} primitive@>
+primitive("topmarks",top_bot_mark,top_mark_code+marks_code);
+@!@:top_marks_}{\.{\\topmarks} primitive@>
+primitive("firstmarks",top_bot_mark,first_mark_code+marks_code);
+@!@:first_marks_}{\.{\\firstmarks} primitive@>
+primitive("botmarks",top_bot_mark,bot_mark_code+marks_code);
+@!@:bot_marks_}{\.{\\botmarks} primitive@>
+primitive("splitfirstmarks",top_bot_mark,split_first_mark_code+marks_code);
+@!@:split_first_marks_}{\.{\\splitfirstmarks} primitive@>
+primitive("splitbotmarks",top_bot_mark,split_bot_mark_code+marks_code);
+@!@:split_bot_marks_}{\.{\\splitbotmarks} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+top_bot_mark: begin case (chr_code mod marks_code) of
+  first_mark_code: print_esc("firstmark");
+  bot_mark_code: print_esc("botmark");
+  split_first_mark_code: print_esc("splitfirstmark");
+  split_bot_mark_code: print_esc("splitbotmark");
+  othercases print_esc("topmark")
+  endcases;
+  if chr_code>=marks_code then print_char("s");
+  end;
+
+@ The following code is activated when |cur_cmd=top_bot_mark| and
+when |cur_chr| is a code like |top_mark_code|.
+
+@<Insert the \(a)appropriate mark text into the scanner@>=
+begin t:=cur_chr mod marks_code;
+if cur_chr>=marks_code then scan_mark_num@+else cur_val:=0;
+case t of
+  first_mark_code:       cur_ptr:=first_mark(cur_val);
+  bot_mark_code:         cur_ptr:=bot_mark(cur_val);
+  split_first_mark_code: cur_ptr:=split_first_mark(cur_val);
+  split_bot_mark_code:   cur_ptr:=split_bot_mark(cur_val);
+  othercases             cur_ptr:=top_mark(cur_val)
+endcases;
+if cur_ptr<>null then begin_token_list(cur_ptr,mark_text);
+end
+
+@ Now let's consider |macro_call| itself, which is invoked when \TeX\ is
+scanning a control sequence whose |cur_cmd| is either |call|, |long_call|,
+|outer_call|, or |long_outer_call|.  The control sequence definition
+appears in the token list whose reference count is in location |cur_chr|
+of |mem|.
+
+The global variable |long_state| will be set to |call| or to |long_call|,
+depending on whether or not the control sequence disallows \.{\\par}
+in its parameters. The |get_next| routine will set |long_state| to
+|outer_call| and emit \.{\\par}, if a file ends or if an \.{\\outer}
+control sequence occurs in the midst of an argument.
+
+@<Glob...@>=
+@!long_state:call..long_outer_call; {governs the acceptance of \.{\\par}}
+
+@ The parameters, if any, must be scanned before the macro is expanded.
+Parameters are token lists without reference counts. They are placed on
+an auxiliary stack called |pstack| while they are being scanned, since
+the |param_stack| may be losing entries during the matching process.
+(Note that |param_stack| can't be gaining entries, since |macro_call| is
+the only routine that puts anything onto |param_stack|, and it
+is not recursive.)
+
+@<Glob...@>=
+@!pstack:array[0..8] of pointer; {arguments supplied to a macro}
+
+@ After parameter scanning is complete, the parameters are moved to the
+|param_stack|. Then the macro body is fed to the scanner; in other words,
+|macro_call| places the defined text of the control sequence at the
+top of\/ \TeX's input stack, so that |get_next| will proceed to read it
+next.
+
+The global variable |cur_cs| contains the |eqtb| address of the control sequence
+being expanded, when |macro_call| begins. If this control sequence has not been
+declared \.{\\long}, i.e., if its command code in the |eq_type| field is
+not |long_call| or |long_outer_call|, its parameters are not allowed to contain
+the control sequence \.{\\par}. If an illegal \.{\\par} appears, the macro
+call is aborted, and the \.{\\par} will be rescanned.
+
+@<Declare the procedure called |macro_call|@>=
+procedure macro_call; {invokes a user-defined control sequence}
+label exit, continue, done, done1, found;
+var r:pointer; {current node in the macro's token list}
+@!p:pointer; {current node in parameter token list being built}
+@!q:pointer; {new node being put into the token list}
+@!s:pointer; {backup pointer for parameter matching}
+@!t:pointer; {cycle pointer for backup recovery}
+@!u,@!v:pointer; {auxiliary pointers for backup recovery}
+@!rbrace_ptr:pointer; {one step before the last |right_brace| token}
+@!n:small_number; {the number of parameters scanned}
+@!unbalance:halfword; {unmatched left braces in current parameter}
+@!m:halfword; {the number of tokens or groups (usually)}
+@!ref_count:pointer; {start of the token list}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_warning_index:pointer; {|warning_index| upon entry}
+@!match_chr:ASCII_code; {character used in parameter}
+begin save_scanner_status:=scanner_status; save_warning_index:=warning_index;
+warning_index:=cur_cs; ref_count:=cur_chr; r:=link(ref_count); n:=0;
+p:=null; m:=0; rbrace_ptr:=null; match_chr:=0;
+if tracing_macros>0 then @<Show the text of the macro being expanded@>;
+if info(r)=protected_token then r:=link(r);
+if info(r)<>end_match_token then
+  @<Scan the parameters and make |link(r)| point to the macro body; but
+    |return| if an illegal \.{\\par} is detected@>;
+@<Feed the macro body and its parameters to the scanner@>;
+exit:scanner_status:=save_scanner_status; warning_index:=save_warning_index;
+end;
+
+@ Before we put a new token list on the input stack, it is wise to clean off
+all token lists that have recently been depleted. Then a user macro that ends
+with a call to itself will not require unbounded stack space.
+
+@<Feed the macro body and its parameters to the scanner@>=
+while (state=token_list)and(loc=null)and(token_type<>v_template) do
+  end_token_list; {conserve stack space}
+begin_token_list(ref_count,macro); name:=warning_index; loc:=link(r);
+if n>0 then
+  begin if param_ptr+n>max_param_stack then
+    begin max_param_stack:=param_ptr+n;
+    if max_param_stack>param_size then
+      overflow("parameter stack size",param_size);
+@:TeX capacity exceeded parameter stack size}{\quad parameter stack size@>
+    end;
+  for m:=0 to n-1 do param_stack[param_ptr+m]:=pstack[m];
+  param_ptr:=param_ptr+n;
+  end
+
+@ At this point, the reader will find it advisable to review the explanation
+of token list format that was presented earlier, since many aspects of that
+format are of importance chiefly in the |macro_call| routine.
+
+The token list might begin with a string of compulsory tokens before the
+first |match| or |end_match|. In that case the macro name is supposed to be
+followed by those tokens; the following program will set |s=null| to
+represent this restriction. Otherwise |s| will be set to the first token of
+a string that will delimit the next parameter.
+
+@<Scan the parameters and make |link(r)| point to the macro body...@>=
+begin scanner_status:=matching; unbalance:=0;
+long_state:=eq_type(cur_cs);
+if long_state>=outer_call then long_state:=long_state-2;
+repeat link(temp_token_head):=null;
+if (info(r)>=end_match_token)or(info(r)<match_token) then s:=null
+else  begin match_chr:=info(r)-match_token; s:=link(r); r:=s;
+  p:=temp_token_head; m:=0;
+  end;
+@<Scan a parameter until its delimiter string has been found; or, if |s=null|,
+  simply scan the delimiter string@>;@/
+{now |info(r)| is a token whose command code is either |match| or |end_match|}
+until info(r)=end_match_token;
+end
+
+@ If |info(r)| is a |match| or |end_match| command, it cannot be equal to
+any token found by |get_token|. Therefore an undelimited parameter---i.e.,
+a |match| that is immediately followed by |match| or |end_match|---will
+always fail the test `|cur_tok=info(r)|' in the following algorithm.
+
+@<Scan a parameter until its delimiter string has been found; or, ...@>=
+continue: get_token; {set |cur_tok| to the next token of input}
+if cur_tok=info(r) then
+  @<Advance \(r)|r|; |goto found| if the parameter delimiter has been
+    fully matched, otherwise |goto continue|@>;
+@<Contribute the recently matched tokens to the current parameter, and
+  |goto continue| if a partial match is still in effect;
+  but abort if |s=null|@>;
+if cur_tok=par_token then if long_state<>long_call then
+  @<Report a runaway argument and abort@>;
+if cur_tok<right_brace_limit then
+  if cur_tok<left_brace_limit then
+    @<Contribute an entire group to the current parameter@>
+  else @<Report an extra right brace and |goto continue|@>
+else @<Store the current token, but |goto continue| if it is
+   a blank space that would become an undelimited parameter@>;
+incr(m);
+if info(r)>end_match_token then goto continue;
+if info(r)<match_token then goto continue;
+found: if s<>null then @<Tidy up the parameter just scanned, and tuck it away@>
+
+@ @<Store the current token, but |goto continue| if it is...@>=
+begin if cur_tok=space_token then
+  if info(r)<=end_match_token then
+    if info(r)>=match_token then goto continue;
+store_new_token(cur_tok);
+end
+
+@ A slightly subtle point arises here: When the parameter delimiter ends
+with `\.{\#\{}', the token list will have a left brace both before and
+after the |end_match|\kern-.4pt. Only one of these should affect the
+|align_state|, but both will be scanned, so we must make a correction.
+
+@<Advance \(r)|r|; |goto found| if the parameter delimiter has been fully...@>=
+begin r:=link(r);
+if (info(r)>=match_token)and(info(r)<=end_match_token) then
+  begin if cur_tok<left_brace_limit then decr(align_state);
+  goto found;
+  end
+else goto continue;
+end
+
+@ @<Report an extra right brace and |goto continue|@>=
+begin back_input; print_err("Argument of "); sprint_cs(warning_index);
+@.Argument of \\x has...@>
+print(" has an extra }");
+help6("I've run across a `}' that doesn't seem to match anything.")@/
+  ("For example, `\def\a#1{...}' and `\a}' would produce")@/
+  ("this error. If you simply proceed now, the `\par' that")@/
+  ("I've just inserted will cause me to report a runaway")@/
+  ("argument that might be the root of the problem. But if")@/
+  ("your `}' was spurious, just type `2' and it will go away.");
+incr(align_state); long_state:=call; cur_tok:=par_token; ins_error;
+end {a white lie; the \.{\\par} won't always trigger a runaway}
+
+@ If |long_state=outer_call|, a runaway argument has already been reported.
+
+@<Report a runaway argument and abort@>=
+begin if long_state=call then
+  begin runaway; print_err("Paragraph ended before ");
+@.Paragraph ended before...@>
+  sprint_cs(warning_index); print(" was complete");
+  help3("I suspect you've forgotten a `}', causing me to apply this")@/
+    ("control sequence to too much text. How can we recover?")@/
+    ("My plan is to forget the whole thing and hope for the best.");
+  back_error;
+  end;
+pstack[n]:=link(temp_token_head); align_state:=align_state-unbalance;
+for m:=0 to n do flush_list(pstack[m]);
+return;
+end
+
+@ When the following code becomes active, we have matched tokens from |s| to
+the predecessor of |r|, and we have found that |cur_tok<>info(r)|. An
+interesting situation now presents itself: If the parameter is to be
+delimited by a string such as `\.{ab}', and if we have scanned `\.{aa}',
+we want to contribute one `\.a' to the current parameter and resume
+looking for a `\.b'. The program must account for such partial matches and
+for others that can be quite complex.  But most of the time we have |s=r|
+and nothing needs to be done.
+
+Incidentally, it is possible for \.{\\par} tokens to sneak in to certain
+parameters of non-\.{\\long} macros. For example, consider a case like
+`\.{\\def\\a\#1\\par!\{...\}}' where the first \.{\\par} is not followed
+by an exclamation point. In such situations it does not seem appropriate
+to prohibit the \.{\\par}, so \TeX\ keeps quiet about this bending of
+the rules.
+
+@<Contribute the recently matched tokens to the current parameter...@>=
+if s<>r then
+  if s=null then @<Report an improper use of the macro and abort@>
+  else  begin t:=s;
+    repeat store_new_token(info(t)); incr(m); u:=link(t); v:=s;
+    loop@+  begin if u=r then
+        if cur_tok<>info(v) then goto done
+        else  begin r:=link(v); goto continue;
+          end;
+      if info(u)<>info(v) then goto done;
+      u:=link(u); v:=link(v);
+      end;
+    done: t:=link(t);
+    until t=r;
+    r:=s; {at this point, no tokens are recently matched}
+    end
+
+@ @<Report an improper use...@>=
+begin print_err("Use of "); sprint_cs(warning_index);
+@.Use of x doesn't match...@>
+print(" doesn't match its definition");
+help4("If you say, e.g., `\def\a1{...}', then you must always")@/
+  ("put `1' after `\a', since control sequence names are")@/
+  ("made up of letters only. The macro here has not been")@/
+  ("followed by the required stuff, so I'm ignoring it.");
+error; return;
+end
+
+@ @<Contribute an entire group to the current parameter@>=
+begin unbalance:=1;
+@^inner loop@>
+loop@+  begin fast_store_new_token(cur_tok); get_token;
+  if cur_tok=par_token then if long_state<>long_call then
+    @<Report a runaway argument and abort@>;
+  if cur_tok<right_brace_limit then
+    if cur_tok<left_brace_limit then incr(unbalance)
+    else  begin decr(unbalance);
+      if unbalance=0 then goto done1;
+      end;
+  end;
+done1: rbrace_ptr:=p; store_new_token(cur_tok);
+end
+
+@ If the parameter consists of a single group enclosed in braces, we must
+strip off the enclosing braces. That's why |rbrace_ptr| was introduced.
+
+@<Tidy up the parameter just scanned, and tuck it away@>=
+begin if (m=1)and(info(p)<right_brace_limit)and(p<>temp_token_head) then
+  begin link(rbrace_ptr):=null; free_avail(p);
+  p:=link(temp_token_head); pstack[n]:=link(p); free_avail(p);
+  end
+else pstack[n]:=link(temp_token_head);
+incr(n);
+if tracing_macros>0 then
+  begin begin_diagnostic; print_nl(match_chr); print_int(n);
+  print("<-"); show_token_list(pstack[n-1],null,1000);
+  end_diagnostic(false);
+  end;
+end
+
+@ @<Show the text of the macro being expanded@>=
+begin begin_diagnostic; print_ln; print_cs(warning_index);
+token_show(ref_count); end_diagnostic(false);
+end
+
+@* \[26] Basic scanning subroutines.
+Let's turn now to some procedures that \TeX\ calls upon frequently to digest
+certain kinds of patterns in the input. Most of these are quite simple;
+some are quite elaborate. Almost all of the routines call |get_x_token|,
+which can cause them to be invoked recursively.
+@^stomach@>
+@^recursion@>
+
+@ The |scan_left_brace| routine is called when a left brace is supposed to be
+the next non-blank token. (The term ``left brace'' means, more precisely,
+a character whose catcode is |left_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |left_brace|.
+
+@p procedure scan_left_brace; {reads a mandatory |left_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>left_brace then
+  begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+  help4("A left brace was mandatory here, so I've put one in.")@/
+    ("You might want to delete and/or insert some corrections")@/
+    ("so that I will find a matching right brace soon.")@/
+    ("(If you're confused by all this, try typing `I}' now.)");
+  back_error; cur_tok:=left_brace_token+"{"; cur_cmd:=left_brace;
+  cur_chr:="{"; incr(align_state);
+  end;
+end;
+
+@ The |scan_right_brace| routine is called when a right brace is supposed to be
+the next non-blank token. (The term ``right brace'' means, more precisely,
+a character whose catcode is |right_brace|.) \TeX\ allows \.{\\relax} to
+appear before the |right_brace|.
+
+@p procedure scan_right_brace; {reads a mandatory |right_brace|}
+begin @<Get the next non-blank non-relax non-call token@>;
+if cur_cmd<>right_brace then
+  begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+  help4("A right brace was mandatory here, so I've put one in.")@/
+    ("You might want to delete and/or insert some corrections")@/
+    ("so that I will find a matching right brace soon.")@/
+    ("(If you're confused by all this, try typing `I}' now.)");
+  back_error; cur_tok:=right_brace_token+"}"; cur_cmd:=right_brace;
+  cur_chr:="}"; incr(align_state);
+  end;
+end;
+
+@ @<Get the next non-blank non-relax non-call token@>=
+repeat get_x_token;
+until (cur_cmd<>spacer)and(cur_cmd<>relax)
+
+@ The |scan_optional_equals| routine looks for an optional `\.=' sign preceded
+by optional spaces; `\.{\\relax}' is not ignored here.
+
+@p procedure scan_optional_equals;
+begin  @<Get the next non-blank non-call token@>;
+if cur_tok<>other_token+"=" then back_input;
+end;
+
+@ @<Get the next non-blank non-call token@>=
+repeat get_x_token;
+until cur_cmd<>spacer
+
+@ In case you are getting bored, here is a slightly less trivial routine:
+Given a string of lowercase letters, like `\.{pt}' or `\.{plus}' or
+`\.{width}', the |scan_keyword| routine checks to see whether the next
+tokens of input match this string. The match must be exact, except that
+uppercase letters will match their lowercase counterparts; uppercase
+equivalents are determined by subtracting |"a"-"A"|, rather than using the
+|uc_code| table, since \TeX\ uses this routine only for its own limited
+set of keywords.
+
+If a match is found, the characters are effectively removed from the input
+and |true| is returned. Otherwise |false| is returned, and the input
+is left essentially unchanged (except for the fact that some macros
+may have been expanded, etc.).
+@^inner loop@>
+
+@p function scan_keyword(@!s:str_number):boolean; {look for a given string}
+label exit;
+var p:pointer; {tail of the backup list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!k:pool_pointer; {index into |str_pool|}
+begin 
+if s<number_chars then begin 
+	@<Get the next non-blank non-call token@>;
+    if (cur_cs=0)and((cur_chr=s)or(cur_chr=s-"a"+"A")) then
+      scan_keyword:=true
+    else 
+      begin back_input;
+      scan_keyword:=false; return;
+      end;
+  end 
+else begin
+  p:=backup_head; link(p):=null; 
+  k:=str_start_macro(s);
+  while k<str_start_macro(s+1) do
+    begin get_x_token; {recursion is possible here}
+@^recursion@>
+    if (cur_cs=0)and@|
+     ((cur_chr=so(str_pool[k]))or(cur_chr=so(str_pool[k])-"a"+"A")) then
+      begin store_new_token(cur_tok); incr(k);
+      end
+    else if (cur_cmd<>spacer)or(p<>backup_head) then
+      begin 
+      if p<>backup_head then begin
+         q:=get_avail; info(q):=cur_tok; link(q):=null;
+         link(p) := q;
+         back_list(link(backup_head));
+	     end
+      else
+         back_input;
+      scan_keyword:=false; return;
+      end;
+    end;
+  flush_list(link(backup_head)); scan_keyword:=true;
+end;
+exit:end;
+
+@ Here is a procedure that sounds an alarm when mu and non-mu units
+are being switched.
+
+@p procedure mu_error;
+begin print_err("Incompatible glue units");
+@.Incompatible glue units@>
+help1("I'm going to assume that 1mu=1pt when they're mixed.");
+error;
+end;
+
+@ The next routine `|scan_something_internal|' is used to fetch internal
+numeric quantities like `\.{\\hsize}', and also to handle the `\.{\\the}'
+when expanding constructions like `\.{\\the\\toks0}' and
+`\.{\\the\\baselineskip}'. Soon we will be considering the |scan_int|
+procedure, which calls |scan_something_internal|; on the other hand,
+|scan_something_internal| also calls |scan_int|, for constructions like
+`\.{\\catcode\`\\\$}' or `\.{\\fontdimen} \.3 \.{\\ff}'. So we
+have to declare |scan_int| as a |forward| procedure. A few other
+procedures are also declared at this point.
+
+@p procedure@?scan_int; forward; {scans an integer value}
+@t\4\4@>@<Declare procedures that scan restricted classes of integers@>@;
+@t\4\4@>@<Declare \eTeX\ procedures for scanning@>@;
+@t\4\4@>@<Declare procedures that scan font-related stuff@>
+@t\4\4@>@<Declare procedures that scan ocp-related stuff@>
+
+@ \TeX\ doesn't know exactly what to expect when
+|scan_something_internal| begins.  For example, an integer or
+dimension or glue value could occur immediately after `\.{\\hskip}';
+and one can even say \.{\\the} with respect to token lists in
+constructions like `\.{\\xdef\\o\{\\the\\output\}}'.  On the other
+hand, only integers are allowed after a construction like
+`\.{\\count}'. To handle the various possibilities,
+|scan_something_internal| has a |level| parameter, which tells the
+``highest'' kind of quantity that |scan_something_internal| is allowed
+to produce. Eight levels are distinguished, namely |int_val|,
+|attr_val|, |dimen_val|, |glue_val|, |mu_val|, |dir_val|, |ident_val|,
+and |tok_val|.
+
+The output of |scan_something_internal| (and of the other routines
+|scan_int|, |scan_dimen|, and |scan_glue| below) is put into the global
+variable |cur_val|, and its level is put into |cur_val_level|. The highest
+values of |cur_val_level| are special: |mu_val| is used only when
+|cur_val| points to something in a ``muskip'' register, or to one of the
+three parameters \.{\\thinmuskip}, \.{\\medmuskip}, \.{\\thickmuskip};
+|ident_val| is used only when |cur_val| points to a font identifier;
+|tok_val| is used only when |cur_val| points to |null| or to the reference
+count of a token list. The last two cases are allowed only when
+|scan_something_internal| is called with |level=tok_val|.
+
+If the output is glue, |cur_val| will point to a glue specification, and
+the reference count of that glue will have been updated to reflect this
+reference; if the output is a nonempty token list, |cur_val| will point to
+its reference count, but in this case the count will not have been updated.
+Otherwise |cur_val| will contain the integer or scaled value in question.
+
+@d int_val=0 {integer values}
+@d attr_val=1 {integer values}
+@d dimen_val=2 {dimension values}
+@d glue_val=3 {glue specifications}
+@d mu_val=4 {math glue specifications}
+@d dir_val=5 {directions}
+@d ident_val=6 {font identifier}
+@d tok_val=7 {token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {delcodes are now 51 digits}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+
+@ The hash table is initialized with `\.{\\count}', `\.{\\attribute}',
+`\.{\\dimen}', `\.{\\skip}', and `\.{\\muskip}' all having |register|
+as their command code; they are distinguished by the |chr_code|, which
+is either |int_val|, |attr_val|, |dimen_val|, |glue_val|, or |mu_val|.
+
+@<Put each...@>=
+primitive("count",register,int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("attribute",register,attr_val);
+@!@:count_}{\.{\\attribute} primitive@>
+primitive("dimen",register,dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mu_val);
+
+@ @<Cases of |print_cmd_chr|...@>=
+register: if chr_code=int_val then print_esc("count")
+  else if chr_code=attr_val then print_esc("attribute")
+  else if chr_code=dimen_val then print_esc("dimen")
+  else if chr_code=glue_val then print_esc("skip")
+  else print_esc("muskip");
+
+@ OK, we're ready for |scan_something_internal| itself. A second parameter,
+|negative|, is set |true| if the value that is found should be negated.
+It is assumed that |cur_cmd| and |cur_chr| represent the first token of
+the internal quantity to be scanned; an error will be signalled if
+|cur_cmd<min_internal| or |cur_cmd>max_internal|.
+
+@d scanned_result_end(#)==cur_val_level:=#;@+end
+@d scanned_result(#)==@+begin cur_val:=#;scanned_result_end
+
+@p procedure scan_something_internal(@!level:small_number;@!negative:boolean);
+  {fetch an internal parameter}
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+    n, k: integer; {accumulators}
+@!q:halfword; {general purpose index}
+@!p:0..nest_size; {index into |nest|}
+begin m:=cur_chr;
+case cur_cmd of
+def_code: @<Fetch a character code from some table@>;
+extdef_code: @<Fetch an ext character code from some table@>;
+toks_register,assign_toks,def_family,set_font,def_font,letterspace_font: @<Fetch a token list or
+  font identifier, provided that |level=tok_val|@>;
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_attr: scanned_result(eqtb[m].int)(int_val);
+assign_box_dir: begin
+  scan_register_num;
+  m:=cur_val;
+  if box(m)<>null then cur_val:=box_dir(box(m))
+  else cur_val:=0;
+  cur_val_level:=dir_val;
+  end;
+assign_dir: scanned_result(eqtb[m].int)(dir_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+assign_glue: scanned_result(equiv(m))(glue_val);
+assign_mu_glue: scanned_result(equiv(m))(mu_val);
+set_aux: @<Fetch the |space_factor| or the |prev_depth|@>;
+set_prev_graf: @<Fetch the |prev_graf|@>;
+set_page_int:@<Fetch the |dead_cycles| or the |insert_penalties|@>;
+set_page_dimen: @<Fetch something on the |page_so_far|@>;
+set_shape: @<Fetch the |par_shape| size@>;
+set_box_dimen: @<Fetch a box dimension@>;
+char_given,math_given,omath_given: scanned_result(cur_chr)(int_val);
+assign_font_dimen: @<Fetch a font dimension@>;
+assign_font_int: @<Fetch a font integer@>;
+register: @<Fetch a register@>;
+last_item: @<Fetch an item in the current node, if appropriate@>;
+othercases @<Complain that \.{\\the} can't do this; give zero result@>
+endcases;@/
+while cur_val_level>level do @<Convert \(c)|cur_val| to a lower level@>;
+@<Fix the reference count, if any, and negate |cur_val| if |negative|@>;
+exit:end;
+
+procedure scan_something_simple(@!cmd:halfword;@!subitem:halfword);
+  {fetch an internal parameter}
+label exit;
+var m:halfword; {|chr_code| part of the operand token}
+@!p:0..nest_size; {index into |nest|}
+@!level:small_number; { allowed level}
+begin m:=subitem; level:=tok_val;
+case cmd of
+assign_toks: scanned_result(equiv(m))(tok_val);
+assign_int: scanned_result(eqtb[m].int)(int_val);
+assign_attr: scanned_result(eqtb[m].int)(int_val);
+assign_dir: scanned_result(eqtb[m].int)(dir_val);
+assign_dimen: scanned_result(eqtb[m].sc)(dimen_val);
+assign_glue: scanned_result(equiv(m))(glue_val);
+assign_mu_glue: scanned_result(equiv(m))(mu_val);
+set_aux: @<Fetch the |space_factor| or the |prev_depth|@>;
+set_prev_graf: @<Fetch the |prev_graf|@>;
+set_page_int:@<Fetch the |dead_cycles| or the |insert_penalties|@>;
+set_page_dimen: @<Fetch something on the |page_so_far|@>;
+set_shape: @<Fetch the |par_shape| size@>;
+char_given,math_given,omath_given: scanned_result(m)(int_val); {TH: TODO, doesnt work}
+othercases @<Complain that |texlib| can't do this; give zero result@>
+endcases;@/
+exit:end;
+
+@ @<Fetch a character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then begin
+  cur_val1:=get_math_code(cur_val);
+  if ((cur_val1 div @"1000000)>8) or
+     (((cur_val1 mod @"1000000) div @"10000)>15) or
+     ((cur_val1 mod @"10000)>255) then
+    begin print_err("Extended mathchar used as mathchar");
+@.Bad mathchar@>
+    help2("A mathchar number must be between 0 and ""7FFF.")@/
+      ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0;
+    end;
+  cur_val1:=((cur_val1 div @"1000000)*@"1000) +
+            (((cur_val1 mod @"1000000) div @"10000)*@"100) +
+            (cur_val1 mod @"10000);
+  scanned_result(cur_val1)(int_val);
+  end
+else if m=lc_code_base then begin
+  cur_val1:=get_lc_code(cur_val);
+  scanned_result(cur_val1)(int_val);
+  end
+else if m=uc_code_base then begin
+  cur_val1:=get_uc_code(cur_val);
+  scanned_result(cur_val1)(int_val);
+  end
+else if m=sf_code_base then begin
+  cur_val1:=get_sf_code(cur_val);
+  scanned_result(cur_val1)(int_val);
+  end
+else if m=cat_code_base then begin
+  cur_val1:=get_cat_code(cat_code_table,cur_val);
+  scanned_result(cur_val1)(int_val);
+  end
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+end
+
+@ @<Fetch an ext character code from some table@>=
+begin scan_char_num;
+if m=math_code_base then scanned_result(get_math_code(cur_val))(int_val)
+{ TH: next two lines should not be possible }
+else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else scanned_result(eqtb[m+cur_val].int)(int_val);
+end
+
+@ @<Fetch a token list...@>=
+if level<>tok_val then
+  begin print_err("Missing number, treated as zero");
+@.Missing number...@>
+  help3("A number should have been here; I inserted `0'.")@/
+    ("(If you can't figure out why I needed to see a number,")@/
+    ("look up `weird error' in the index to The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+  back_error; scanned_result(0)(dimen_val);
+  end
+else if cur_cmd<=assign_toks then
+  begin if cur_cmd<assign_toks then {|cur_cmd=toks_register|}
+    begin scan_register_num; m:=toks_base+cur_val;
+    end;
+  scanned_result(equiv(m))(tok_val);
+  end
+else  begin back_input; scan_font_ident;
+  scanned_result(font_id_base+cur_val)(ident_val);
+  end
+
+@ Users refer to `\.{\\the\\spacefactor}' only in horizontal
+mode, and to `\.{\\the\\prevdepth}' only in vertical mode; so we put the
+associated mode in the modifier part of the |set_aux| command.
+The |set_page_int| command has modifier 0 or 1, for `\.{\\deadcycles}' and
+`\.{\\insertpenalties}', respectively. The |set_box_dimen| command is
+modified by either |width_offset|, |height_offset|, or |depth_offset|.
+And the |last_item| command is modified by either |int_val|, |dimen_val|,
+|glue_val|, |input_line_no_code|, or |badness_code|.
+\pdfTeX\ adds the codes for its extensions: |pdftex_version_code|, \dots\ .
+\eTeX\ inserts |last_node_type_code| after |glue_val| and adds
+the codes for its extensions: |eTeX_version_code|, \dots\ .
+
+@d last_node_type_code=glue_val+1 {code for \.{\\lastnodetype}}
+@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
+@d badness_code=input_line_no_code+1 {code for \.{\\badness}}
+@#
+@d pdftex_first_rint_code     = badness_code + 1 {base for \pdfTeX's command codes}
+@d pdftex_version_code        = pdftex_first_rint_code + 0 {code for \.{\\pdftexversion}}
+@d pdf_last_obj_code          = pdftex_first_rint_code + 1 {code for \.{\\pdflastobj}}
+@d pdf_last_xform_code        = pdftex_first_rint_code + 2 {code for \.{\\pdflastxform}}
+@d pdf_last_ximage_code       = pdftex_first_rint_code + 3 {code for \.{\\pdflastximage}}
+@d pdf_last_ximage_pages_code = pdftex_first_rint_code + 4 {code for \.{\\pdflastximagepages}}
+@d pdf_last_annot_code        = pdftex_first_rint_code + 5 {code for \.{\\pdflastannot}}
+@d pdf_last_x_pos_code        = pdftex_first_rint_code + 6 {code for \.{\\pdflastxpos}}
+@d pdf_last_y_pos_code        = pdftex_first_rint_code + 7 {code for \.{\\pdflastypos}}
+@d pdf_retval_code            = pdftex_first_rint_code + 8 {global multi-purpose return value}
+@d pdf_last_ximage_colordepth_code = pdftex_first_rint_code + 9 {code for \.{\\pdflastximagecolordepth}}
+@d random_seed_code           = pdftex_first_rint_code + 10 {code for \.{\\pdfrandomseed}}
+@d pdf_last_link_code         = pdftex_first_rint_code + 11 {code for \.{\\pdflastlink}}
+@d luatex_version_code        = pdftex_first_rint_code + 12 {code for \.{\\luatexversion}}
+@d pdftex_last_item_codes     = pdftex_first_rint_code + 12 {end of \pdfTeX's command codes}
+@#
+@d Aleph_int=pdftex_last_item_codes+1 {first of \Aleph\ codes for integers}
+@d Aleph_int_num=5 {number of \Aleph\ integers}
+@d eTeX_int=Aleph_int+Aleph_int_num {first of \eTeX\ codes for integers}
+@d eTeX_dim=eTeX_int+8 {first of \eTeX\ codes for dimensions}
+@d eTeX_glue=eTeX_dim+9 {first of \eTeX\ codes for glue}
+@d eTeX_mu=eTeX_glue+1 {first of \eTeX\ codes for muglue}
+@d eTeX_expr=eTeX_mu+1 {first of \eTeX\ codes for expressions}
+
+@<Put each...@>=
+primitive("spacefactor",set_aux,hmode);
+@!@:space_factor_}{\.{\\spacefactor} primitive@>
+primitive("prevdepth",set_aux,vmode);@/
+@!@:prev_depth_}{\.{\\prevdepth} primitive@>
+primitive("deadcycles",set_page_int,0);
+@!@:dead_cycles_}{\.{\\deadcycles} primitive@>
+primitive("insertpenalties",set_page_int,1);
+@!@:insert_penalties_}{\.{\\insertpenalties} primitive@>
+primitive("wd",set_box_dimen,width_offset);
+@!@:wd_}{\.{\\wd} primitive@>
+primitive("ht",set_box_dimen,height_offset);
+@!@:ht_}{\.{\\ht} primitive@>
+primitive("dp",set_box_dimen,depth_offset);
+@!@:dp_}{\.{\\dp} primitive@>
+primitive("lastpenalty",last_item,int_val);
+@!@:last_penalty_}{\.{\\lastpenalty} primitive@>
+primitive("lastkern",last_item,dimen_val);
+@!@:last_kern_}{\.{\\lastkern} primitive@>
+primitive("lastskip",last_item,glue_val);
+@!@:last_skip_}{\.{\\lastskip} primitive@>
+primitive("inputlineno",last_item,input_line_no_code);
+@!@:input_line_no_}{\.{\\inputlineno} primitive@>
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("pdftexversion",last_item,pdftex_version_code);@/
+@!@:pdftex_version_}{\.{\\pdftexversion} primitive@>
+primitive("luatexversion",last_item,luatex_version_code);@/
+@!@:luatex_version_}{\.{\\luatexversion} primitive@>
+primitive("pdflastobj",last_item,pdf_last_obj_code);@/
+@!@:pdf_last_obj_}{\.{\\pdflastobj} primitive@>
+primitive("pdflastxform",last_item,pdf_last_xform_code);@/
+@!@:pdf_last_xform_}{\.{\\pdflastxform} primitive@>
+primitive("pdflastximage",last_item,pdf_last_ximage_code);@/
+@!@:pdf_last_ximage_}{\.{\\pdflastximage} primitive@>
+primitive("pdflastximagepages",last_item,pdf_last_ximage_pages_code);@/
+@!@:pdf_last_ximage_pages_}{\.{\\pdflastximagepages} primitive@>
+primitive("pdflastannot",last_item,pdf_last_annot_code);@/
+@!@:pdf_last_annot_}{\.{\\pdflastannot} primitive@>
+primitive("pdflastxpos",last_item,pdf_last_x_pos_code);@/
+@!@:pdf_last_x_pos_}{\.{\\pdflastxpos} primitive@>
+primitive("pdflastypos",last_item,pdf_last_y_pos_code);@/
+@!@:pdf_last_y_pos_}{\.{\\pdflastypos} primitive@>
+primitive("pdfretval",last_item,pdf_retval_code);@/
+@!@:pdf_retval_}{\.{\\pdfretval} primitive@>
+primitive("pdflastximagecolordepth",last_item,pdf_last_ximage_colordepth_code);@/
+@!@:pdf_last_ximage_colordepth_}{\.{\\pdflastximagecolordepth} primitive@>
+primitive("pdfrandomseed",last_item,random_seed_code);
+@!@:random_seed_}{\.{\\pdfrandomseed} primitive@>
+primitive("pdflastlink",last_item,pdf_last_link_code);@/
+@!@:pdf_last_link_}{\.{\\pdflastlink} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_aux: if chr_code=vmode then print_esc("prevdepth")
+@+else print_esc("spacefactor");
+set_page_int: if chr_code=0 then print_esc("deadcycles")
+@/@<Cases of |set_page_int| for |print_cmd_chr|@>@/
+@+else print_esc("insertpenalties");
+set_box_dimen: if chr_code=width_offset then print_esc("wd")
+else if chr_code=height_offset then print_esc("ht")
+else print_esc("dp");
+last_item: case chr_code of
+  int_val: print_esc("lastpenalty");
+  dimen_val: print_esc("lastkern");
+  glue_val: print_esc("lastskip");
+  input_line_no_code: print_esc("inputlineno");
+  @/@<Cases of |last_item| for |print_cmd_chr|@>@/
+  pdftex_version_code:  print_esc("pdftexversion");
+  luatex_version_code:  print_esc("luatexversion");
+  pdf_last_obj_code:    print_esc("pdflastobj");
+  pdf_last_xform_code:  print_esc("pdflastxform");
+  pdf_last_ximage_code: print_esc("pdflastximage");
+  pdf_last_ximage_pages_code: print_esc("pdflastximagepages");
+  pdf_last_annot_code:  print_esc("pdflastannot");
+  pdf_last_x_pos_code:  print_esc("pdflastxpos");
+  pdf_last_y_pos_code:  print_esc("pdflastypos");
+  pdf_retval_code:      print_esc("pdfretval");
+  pdf_last_ximage_colordepth_code: print_esc("pdflastximagecolordepth");
+  random_seed_code:     print_esc("pdfrandomseed");
+  pdf_last_link_code:   print_esc("pdflastlink");
+  othercases print_esc("badness")
+  endcases;
+
+@ @<Fetch the |space_factor| or the |prev_depth|@>=
+if abs(mode)<>m then
+  begin print_err("Improper "); print_cmd_chr(set_aux,m);
+@.Improper \\spacefactor@>
+@.Improper \\prevdepth@>
+  help4("You can refer to \spacefactor only in horizontal mode;")@/
+    ("you can refer to \prevdepth only in vertical mode; and")@/
+    ("neither of these is meaningful inside \write. So")@/
+    ("I'm forgetting what you said and using zero instead.");
+  error;
+  if level<>tok_val then scanned_result(0)(dimen_val)
+  else scanned_result(0)(int_val);
+  end
+else if m=vmode then
+  begin cur_val:=prev_depth; cur_val_level:=dimen_val;
+  end
+else begin cur_val:=space_factor; cur_val_level:=int_val;
+  end
+
+@ @<Fetch the |dead_cycles| or the |insert_penalties|@>=
+begin if m=0 then cur_val:=dead_cycles
+@/@<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>@/
+else cur_val:=insert_penalties;
+cur_val_level:=int_val;
+end
+
+@ @<Fetch a box dimension@>=
+begin scan_register_num;
+if box(cur_val)=null then cur_val:=0 @+else cur_val:=vmem(box(cur_val)+m).sc;
+cur_val_level:=dimen_val;
+end
+
+@ Inside an \.{\\output} routine, a user may wish to look at the page totals
+that were present at the moment when output was triggered.
+
+@d max_dimen==@'7777777777 {$2^{30}-1$}
+
+@<Fetch something on the |page_so_far|@>=
+begin if (page_contents=empty) and (not output_active) then
+  if m=0 then cur_val:=max_dimen@+else cur_val:=0
+else cur_val:=page_so_far[m];
+cur_val_level:=dimen_val;
+end
+
+@ @<Fetch the |prev_graf|@>=
+if mode=0 then scanned_result(0)(int_val) {|prev_graf=0| within \.{\\write}}
+else begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
+  while abs(nest[p].mode_field)<>vmode do decr(p);
+  scanned_result(nest[p].pg_field)(int_val);
+  end
+
+@ @<Fetch the |par_shape| size@>=
+begin if m>par_shape_loc then @<Fetch a penalties array element@>
+else if par_shape_ptr=null then cur_val:=0
+else cur_val:=vinfo(par_shape_ptr);
+cur_val_level:=int_val;
+end
+
+@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, and \.{\\lastskip} are
+implemented. The reference count for \.{\\lastskip} will be updated later.
+
+We also handle \.{\\inputlineno} and \.{\\badness} here, because they are
+legal in similar contexts.
+
+@<Fetch an item in the current node...@>=
+if m>=input_line_no_code then
+ if m>=eTeX_glue then @<Process an expression and |return|@>@;
+ else if m>=eTeX_dim then
+  begin case m of
+  @/@<Cases for fetching a dimension value@>@/
+  end; {there are no other cases}
+  cur_val_level:=dimen_val;
+  end
+ else begin case m of
+  input_line_no_code: cur_val:=line;
+  badness_code: cur_val:=last_badness;
+  pdftex_version_code:  cur_val := pdftex_version;
+  luatex_version_code:  cur_val := luatex_version;
+  pdf_last_obj_code:    cur_val := pdf_last_obj;
+  pdf_last_xform_code:  cur_val := pdf_last_xform;
+  pdf_last_ximage_code: cur_val := pdf_last_ximage;
+  pdf_last_ximage_pages_code: cur_val := pdf_last_ximage_pages;
+  pdf_last_annot_code:  cur_val := pdf_last_annot;
+  pdf_last_x_pos_code:  cur_val := pdf_last_x_pos;
+  pdf_last_y_pos_code:  cur_val := pdf_last_y_pos;
+  pdf_retval_code:      cur_val := pdf_retval;
+  pdf_last_ximage_colordepth_code: cur_val := pdf_last_ximage_colordepth;
+  random_seed_code:  cur_val := random_seed;
+  pdf_last_link_code:   cur_val := pdf_last_link;
+  @/@<Cases for fetching an integer value@>@/
+  end; {there are no other cases}
+  cur_val_level:=int_val;
+  end
+else begin if cur_chr=glue_val then cur_val:=zero_glue@+else cur_val:=0;
+  if cur_chr=last_node_type_code then
+    begin cur_val_level:=int_val;
+    if (tail=head)or(mode=0) then cur_val:=-1;
+    end
+  else cur_val_level:=cur_chr;
+  {TODO: check this thoroughly! The structural change to the 
+   |is_char_node| macro was wreaking havoc here, and possibly elsewhere.}
+  if tail<>contrib_head and not is_char_node(tail)and(mode<>0) then
+    case cur_chr of
+    int_val: if type(tail)=penalty_node then cur_val:=penalty(tail);
+    dimen_val: if type(tail)=kern_node then cur_val:=width(tail);
+    glue_val: if type(tail)=glue_node then
+      begin cur_val:=glue_ptr(tail);
+      if subtype(tail)=mu_glue then cur_val_level:=mu_val;
+      end;
+    last_node_type_code:
+      cur_val := visible_last_node_type(tail);
+    end {there are no other cases}
+  else if (mode=vmode)and(tail=head) then
+    case cur_chr of
+    int_val: cur_val:=last_penalty;
+    dimen_val: cur_val:=last_kern;
+    glue_val: if last_glue<>max_halfword then cur_val:=last_glue;
+    last_node_type_code: cur_val:=last_node_type;
+    end; {there are no other cases}
+  end
+
+@ @<Fetch a font dimension@>=
+get_font_dimen
+
+@ @<Fetch a font integer@>=
+begin scan_font_ident;
+if m=0 then scanned_result(hyphen_char(cur_val))(int_val)
+else if m=1 then scanned_result(skew_char(cur_val))(int_val)
+else if m=no_lig_code then scanned_result(test_no_ligatures(cur_val))(int_val)
+else begin
+    n := cur_val;
+    scan_char_num;
+    k := cur_val;
+    case m of
+    lp_code_base: scanned_result(get_lp_code(n, k))(int_val);
+    rp_code_base: scanned_result(get_rp_code(n, k))(int_val);
+    ef_code_base: scanned_result(get_ef_code(n, k))(int_val);
+    tag_code: scanned_result(get_tag_code(n, k))(int_val);
+    end;
+end;
+end
+
+@ @<Fetch a register@>=
+begin scan_register_num;
+case m of
+int_val:cur_val:=count(cur_val);
+attr_val:cur_val:=attribute(cur_val);
+dimen_val:cur_val:=dimen(cur_val);
+glue_val: cur_val:=skip(cur_val);
+mu_val: cur_val:=mu_skip(cur_val);
+end; {there are no other cases}
+cur_val_level:=m;
+end
+
+@ @<Complain that \.{\\the} can't do this; give zero result@>=
+begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
+@.You can't use x after ...@>
+print("' after "); print_esc("the");
+help1("I'm forgetting what you said and using zero instead.");
+error;
+if level<>tok_val then scanned_result(0)(dimen_val)
+else scanned_result(0)(int_val);
+end
+
+@ @<Complain that |texlib| can't do this; give zero result@>=
+begin print_err("You can't use `"); print_cmd_chr(cmd,m);
+print("' as tex library index");
+help1("I'm forgetting what you said and using zero instead.");
+error;
+if level<>tok_val then scanned_result(0)(dimen_val)
+else scanned_result(0)(int_val);
+end
+
+
+@ When a |glue_val| changes to a |dimen_val|, we use the width component
+of the glue; there is no need to decrease the reference count, since it
+has not yet been increased.  When a |dimen_val| changes to an |int_val|,
+we use scaled points so that the value doesn't actually change. And when a
+|mu_val| changes to a |glue_val|, the value doesn't change either.
+
+@<Convert \(c)|cur_val| to a lower level@>=
+begin if cur_val_level=glue_val then cur_val:=width(cur_val)
+else if cur_val_level=mu_val then mu_error;
+decr(cur_val_level);
+end
+
+@ If |cur_val| points to a glue specification at this point, the reference
+count for the glue does not yet include the reference by |cur_val|.
+If |negative| is |true|, |cur_val_level| is known to be |<=mu_val|.
+
+@<Fix the reference count, if any, ...@>=
+if negative then
+  if cur_val_level>=glue_val then
+    begin cur_val:=new_spec(cur_val);
+    @<Negate all three glue components of |cur_val|@>;
+    end
+  else negate(cur_val)
+else if (cur_val_level>=glue_val)and(cur_val_level<=mu_val) then
+  add_glue_ref(cur_val)
+
+@ @<Negate all three...@>=
+begin negate(width(cur_val));
+negate(stretch(cur_val));
+negate(shrink(cur_val));
+end
+
+@ Our next goal is to write the |scan_int| procedure, which scans anything that
+\TeX\ treats as an integer. But first we might as well look at some simple
+applications of |scan_int| that have already been made inside of
+|scan_something_internal|.
+
+@
+@d dir_T=0
+@d dir_L=1
+@d dir_B=2
+@d dir_R=3
+@d dir_eq_end(#)==(#)
+@d dir_eq(#)==(#)=dir_eq_end
+@d dir_ne_end(#)==(#)
+@d dir_ne(#)==(#)<>dir_ne_end
+@d dir_opposite_end(#)==((#) mod 4)
+@d dir_opposite(#)==(((#)+2) mod 4)=dir_opposite_end
+@d dir_parallel_end(#)==((#) mod 2)
+@d dir_parallel(#)==((#) mod 2)=dir_parallel_end
+@d dir_orthogonal_end(#)==(# mod 2)
+@d dir_orthogonal(#)==((#) mod 2)<>dir_orthogonal_end
+@d dir_next_end(#)==((#) mod 4)
+@d dir_next(#)==(((#)+3) mod 4)=dir_next_end
+@d dir_prev_end(#)==((#) mod 4)
+@d dir_prev(#)==(((#)+1) mod 4)=dir_prev_end
+
+{box directions}
+@d dir_TL_=0
+@d dir_TR_=1
+@d dir_LT_=2
+@d dir_LB_=3
+@d dir_BL_=4
+@d dir_BR_=5
+@d dir_RT_=6
+@d dir_RB_=7
+
+{font directions}
+@d dir__LT= 0
+@d dir__LL= 1
+@d dir__LB= 2
+@d dir__LR= 3
+@d dir__RT= 4
+@d dir__RL= 5
+@d dir__RB= 6
+@d dir__RR= 7
+@d dir__TT= 8
+@d dir__TL= 9
+@d dir__TB=10
+@d dir__TR=11
+@d dir__BT=12
+@d dir__BL=13
+@d dir__BB=14
+@d dir__BR=15
+
+@d is_mirrored(#)==dir_opposite(dir_primary[#])(dir_tertiary[#])
+@d is_rotated(#)==dir_parallel(dir_secondary[#])(dir_tertiary[#])
+@d font_direction(#)==(# mod 16)
+@d box_direction(#)==(# div 4)
+
+@d scan_single_dir(#)==begin
+if scan_keyword("T") then #:=dir_T
+else if scan_keyword("L") then #:=dir_L
+else if scan_keyword("B") then #:=dir_B
+else if scan_keyword("R") then #:=dir_R
+else begin
+  print_err("Bad direction"); cur_val:=0;
+  goto exit;
+  end
+end
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_direction;
+var d1,d2,d3: integer;
+begin
+get_x_token;
+if cur_cmd=assign_dir then begin
+  cur_val:=eqtb[cur_chr].int;
+  goto exit;
+  end
+else back_input;
+scan_single_dir(d1);
+scan_single_dir(d2);
+if dir_parallel(d1)(d2) then begin
+  print_err("Bad direction"); cur_val:=0;
+  goto exit;
+  end;
+scan_single_dir(d3);
+cur_val:=d1*8+dir_rearrange[d2]*4+d3;
+exit:
+end;
+
+@ It is nice to have routines that say what they do, so the original
+|scan_eight_bit_int| is superceded by |scan_register_num| and
+|scan_mark_num|. It may become split up even further in the future.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_reg) then
+  begin print_err("Bad register code");
+@.Bad register code@>
+  help2("A register number must be between 0 and 65535.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+procedure scan_mark_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_mark) then
+  begin print_err("Bad marks code");
+@.Bad marks code@>
+  help2("A marks class must be between 0 and 65535.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_char_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_char) then
+  begin print_err("Bad character code");
+@.Bad character code@>
+  help2("A character number must be between 0 and biggest_char.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+
+@ While we're at it, we might as well deal with similar routines that
+will be needed later.
+
+@<Declare procedures that scan restricted classes of integers@>=
+procedure scan_four_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>15) then
+  begin print_err("Bad number");
+@.Bad number@>
+  help2("Since I expected to read a number between 0 and 15,")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+procedure scan_math_family_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+  begin print_err("Bad number");
+@.Bad number@>
+  help2("Since I expected to read a number between 0 and 255,")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_real_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+  begin print_err("Bad mathchar");
+@.Bad mathchar@>
+  help2("A mathchar number must be between 0 and 32767.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+procedure scan_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'77777) then
+  begin print_err("Bad mathchar");
+@.Bad mathchar@>
+  help2("A mathchar number must be between 0 and 32767.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+           (((cur_val mod @"1000) div @"100) * @"10000) +
+           (cur_val mod @"100);
+end;
+procedure scan_big_fifteen_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@"7FFFFFF) then
+  begin print_err("Bad extended mathchar");
+@.Bad mathchar@>
+  help2("An extended mathchar number must be between 0 and ""7FFFFFF.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+end;
+
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_twenty_seven_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+  begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+  help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+cur_val1 := (((cur_val mod @"1000) div @"100) * @"10000) +
+            (cur_val mod @"100);
+cur_val := cur_val div @"1000;
+cur_val := ((cur_val div @"1000) * @"1000000) +
+           (((cur_val mod @"1000) div @"100) * @"10000) +
+           (cur_val mod @"100);
+end;
+
+procedure scan_fifty_one_bit_int;
+var iiii:integer;
+begin scan_int;
+if (cur_val<0)or(cur_val>@'777777777) then
+  begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+  help2("A numeric delimiter (first part) must be between 0 and 2^{27}-1.")
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+iiii:=cur_val;
+scan_int;
+if (cur_val<0)or(cur_val>@"FFFFFF) then
+  begin print_err("Bad delimiter code");
+@.Bad delimiter code@>
+help2("A numeric delimiter (second part) must be between 0 and 2^{24}-1.")@/
+    ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+  end;
+cur_val1:=cur_val;
+cur_val:=iiii;
+end;
+
+
+procedure scan_string_argument;
+var s:integer;
+begin
+scan_left_brace;
+get_x_token;
+while (cur_cmd<>right_brace) do
+  begin
+  if (cur_cmd=letter) or (cur_cmd=other_char) then begin
+    str_room(1); append_char(cur_chr);
+    end
+  else if (cur_cmd=spacer) then begin
+    str_room(1); append_char(" ");
+    end
+  else begin
+    print("Bad token appearing in string argument");
+    end;
+  get_x_token;
+  end;
+s:=make_string;
+if str_eq_str("mi",s) then s:="mi";
+if str_eq_str("mo",s) then s:="mo";
+if str_eq_str("mn",s) then s:="mn";
+cur_val:=s;
+end;
+
+@ An integer number can be preceded by any number of spaces and `\.+' or
+`\.-' signs. Then comes either a decimal constant (i.e., radix 10), an
+octal constant (i.e., radix 8, preceded by~\.\'), a hexadecimal constant
+(radix 16, preceded by~\."), an alphabetic constant (preceded by~\.\`), or
+an internal variable. After scanning is complete,
+|cur_val| will contain the answer, which must be at most
+$2^{31}-1=2147483647$ in absolute value. The value of |radix| is set to
+10, 8, or 16 in the cases of decimal, octal, or hexadecimal constants,
+otherwise |radix| is set to zero. An optional space follows a constant.
+
+@d octal_token=other_token+"'" {apostrophe, indicates an octal constant}
+@d hex_token=other_token+"""" {double quote, indicates a hex constant}
+@d alpha_token=other_token+"`" {reverse apostrophe, precedes alpha constants}
+@d point_token=other_token+"." {decimal point}
+@d continental_point_token=other_token+"," {decimal point, Eurostyle}
+
+@<Glob...@>=
+@!radix:small_number; {|scan_int| sets this to 8, 10, 16, or zero}
+
+@ We initialize the following global variables just in case |expand|
+comes into action before any of the basic scanning routines has assigned
+them a value.
+
+@<Set init...@>=
+cur_val:=0; cur_val_level:=int_val; radix:=0; cur_order:=0;
+
+@ The |scan_int| routine is used also to scan the integer part of a
+fraction; for example, the `\.3' in `\.{3.14159}' will be found by
+|scan_int|. The |scan_dimen| routine assumes that |cur_tok=point_token|
+after the integer part of such a fraction has been scanned by |scan_int|,
+and that the decimal point has been backed up to be scanned again.
+
+@p procedure scan_int; {sets |cur_val| to an integer}
+label done;
+var negative:boolean; {should the answer be negated?}
+@!m:integer; {|@t$2^{31}$@> div radix|, the threshold of danger}
+@!d:small_number; {the digit just scanned}
+@!vacuous:boolean; {have no digits appeared?}
+@!OK_so_far:boolean; {has an error message been issued?}
+begin radix:=0; OK_so_far:=true;@/
+@<Get the next non-blank non-sign token; set |negative| appropriately@>;
+if cur_tok=alpha_token then @<Scan an alphabetic character code into |cur_val|@>
+else if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+  scan_something_internal(int_val,false)
+else @<Scan a numeric constant@>;
+if negative then negate(cur_val);
+end;
+
+@ @<Get the next non-blank non-sign token...@>=
+negative:=false;
+repeat @<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"-" then
+  begin negative := not negative; cur_tok:=other_token+"+";
+  end;
+until cur_tok<>other_token+"+"
+
+@ A space is ignored after an alphabetic character constant, so that
+such constants behave like numeric ones.
+
+@<Scan an alphabetic character code into |cur_val|@>=
+begin get_token; {suppress macro expansion}
+if cur_tok<cs_token_flag then
+  begin cur_val:=cur_chr;
+  if cur_cmd<=right_brace then
+    if cur_cmd=right_brace then incr(align_state)
+    else decr(align_state);
+  end
+else if cur_tok<cs_token_flag+null_cs then
+  cur_val:=cur_tok-cs_token_flag-active_base
+else begin {the value of a csname in this context is its name}
+  if single_letter(text(cur_tok-cs_token_flag)) then
+    cur_val:=pool_to_unichar(str_start_macro(text(cur_tok-cs_token_flag)))
+  else
+    cur_val:=too_big_char;
+end;
+if cur_val>biggest_char then
+  begin print_err("Improper alphabetic constant");
+@.Improper alphabetic constant@>
+  help2("A one-character control sequence belongs after a ` mark.")@/
+    ("So I'm essentially inserting \0 here.");
+  cur_val:="0"; back_error;
+  end
+else @<Scan an optional space@>;
+end
+
+@ @<Scan an optional space@>=
+begin get_x_token; if cur_cmd<>spacer then back_input;
+end
+
+@ @<Scan a numeric constant@>=
+begin radix:=10; m:=214748364;
+if cur_tok=octal_token then
+  begin radix:=8; m:=@'2000000000; get_x_token;
+  end
+else if cur_tok=hex_token then
+  begin radix:=16; m:=@'1000000000; get_x_token;
+  end;
+vacuous:=true; cur_val:=0;@/
+@<Accumulate the constant until |cur_tok| is not a suitable digit@>;
+if vacuous then @<Express astonishment that no number was here@>
+else if cur_cmd<>spacer then back_input;
+end
+
+@ @d infinity==@'17777777777 {the largest positive value that \TeX\ knows}
+@d zero_token=other_token+"0" {zero, the smallest digit}
+@d A_token=letter_token+"A" {the smallest special hex digit}
+@d other_A_token=other_token+"A" {special hex digit of type |other_char|}
+
+@<Accumulate the constant...@>=
+loop@+  begin if (cur_tok<zero_token+radix)and(cur_tok>=zero_token)and
+    (cur_tok<=zero_token+9) then d:=cur_tok-zero_token
+  else if radix=16 then
+    if (cur_tok<=A_token+5)and(cur_tok>=A_token) then d:=cur_tok-A_token+10
+    else if (cur_tok<=other_A_token+5)and(cur_tok>=other_A_token) then
+      d:=cur_tok-other_A_token+10
+    else goto done
+  else goto done;
+  vacuous:=false;
+  if (cur_val>=m)and((cur_val>m)or(d>7)or(radix<>10)) then
+    begin if OK_so_far then
+      begin print_err("Number too big");
+@.Number too big@>
+      help2("I can only go up to 2147483647='17777777777=""7FFFFFFF,")@/
+        ("so I'm using that number instead of yours.");
+      error; cur_val:=infinity; OK_so_far:=false;
+      end;
+    end
+  else cur_val:=cur_val*radix+d;
+  get_x_token;
+  end;
+done:
+
+@ @<Express astonishment...@>=
+begin print_err("Missing number, treated as zero");
+@.Missing number...@>
+help3("A number should have been here; I inserted `0'.")@/
+  ("(If you can't figure out why I needed to see a number,")@/
+  ("look up `weird error' in the index to The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+back_error;
+end
+
+@ The |scan_dimen| routine is similar to |scan_int|, but it sets |cur_val| to
+a |scaled| value, i.e., an integral number of sp. One of its main tasks
+is therefore to interpret the abbreviations for various kinds of units and
+to convert measurements to scaled points.
+
+There are three parameters: |mu| is |true| if the finite units must be
+`\.{mu}', while |mu| is |false| if `\.{mu}' units are disallowed;
+|inf| is |true| if the infinite units `\.{fil}', `\.{fill}', `\.{filll}'
+are permitted; and |shortcut| is |true| if |cur_val| already contains
+an integer and only the units need to be considered.
+
+The order of infinity that was found in the case of infinite glue is returned
+in the global variable |cur_order|.
+
+@<Glob...@>=
+@!cur_order:glue_ord; {order of infinity found by |scan_dimen|}
+
+@ Constructions like `\.{-\'77 pt}' are legal dimensions, so |scan_dimen|
+may begin with |scan_int|. This explains why it is convenient to use
+|scan_int| also for the integer part of a decimal fraction.
+
+Several branches of |scan_dimen| work with |cur_val| as an integer and
+with an auxiliary fraction |f|, so that the actual quantity of interest is
+$|cur_val|+|f|/2^{16}$. At the end of the routine, this ``unpacked''
+representation is put into the single word |cur_val|, which suddenly
+switches significance from |integer| to |scaled|.
+
+@d attach_fraction=88 {go here to pack |cur_val| and |f| into |cur_val|}
+@d attach_sign=89 {go here when |cur_val| is correct except perhaps for sign}
+@d scan_normal_dimen==scan_dimen(false,false,false)
+
+@p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
+  {sets |cur_val| to a dimension}
+label done, done1, done2, found, not_found, attach_fraction, attach_sign;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@<Local variables for dimension calculations@>@;
+begin f:=0; arith_error:=false; cur_order:=normal; negative:=false;
+if not shortcut then
+  begin @<Get the next non-blank non-sign...@>;
+  if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+    @<Fetch an internal dimension and |goto attach_sign|,
+      or fetch an internal integer@>
+  else  begin back_input;
+    if cur_tok=continental_point_token then cur_tok:=point_token;
+    if cur_tok<>point_token then scan_int
+    else  begin radix:=10; cur_val:=0;
+      end;
+    if cur_tok=continental_point_token then cur_tok:=point_token;
+    if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+    end;
+  end;
+if cur_val<0 then {in this case |f=0|}
+  begin negative := not negative; negate(cur_val);
+  end;
+@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$, where there
+  are |x| sp per unit; |goto attach_sign| if the units are internal@>;
+@<Scan an optional space@>;
+attach_sign: if arith_error or(abs(cur_val)>=@'10000000000) then
+  @<Report that this dimension is out of range@>;
+if negative then negate(cur_val);
+end;
+
+@ @<Fetch an internal dimension and |goto attach_sign|...@>=
+if mu then
+  begin scan_something_internal(mu_val,false);
+  @<Coerce glue to a dimension@>;
+  if cur_val_level=mu_val then goto attach_sign;
+  if cur_val_level<>int_val then mu_error;
+  end
+else  begin scan_something_internal(dimen_val,false);
+  if cur_val_level=dimen_val then goto attach_sign;
+  end
+
+@ @<Local variables for dimension calculations@>=
+@!num,@!denom:1..65536; {conversion ratio for the scanned units}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+@!v:scaled; {an internal dimension}
+@!save_cur_val:integer; {temporary storage of |cur_val|}
+
+@ The following code is executed when |scan_something_internal| was
+called asking for |mu_val|, when we really wanted a ``mudimen'' instead
+of ``muglue.''
+
+@<Coerce glue to a dimension@>=
+if cur_val_level>=glue_val then
+  begin v:=width(cur_val); delete_glue_ref(cur_val); cur_val:=v;
+  end
+
+@ When the following code is executed, we have |cur_tok=point_token|, but this
+token has been backed up using |back_input|; we must first discard it.
+
+It turns out that a decimal point all by itself is equivalent to `\.{0.0}'.
+Let's hope people don't use that fact.
+
+@<Scan decimal fraction@>=
+begin k:=0; p:=null; get_token; {|point_token| is being re-scanned}
+loop@+  begin get_x_token;
+  if (cur_tok>zero_token+9)or(cur_tok<zero_token) then goto done1;
+  if k<17 then {digits for |k>=17| cannot affect the result}
+    begin q:=get_avail; link(q):=p; info(q):=cur_tok-zero_token;
+    p:=q; incr(k);
+    end;
+  end;
+done1: for kk:=k downto 1 do
+  begin dig[kk-1]:=info(p); q:=p; p:=link(p); free_avail(q);
+  end;
+f:=round_decimals(k);
+if cur_cmd<>spacer then back_input;
+end
+
+@ Now comes the harder part: At this point in the program, |cur_val| is a
+nonnegative integer and $f/2^{16}$ is a nonnegative fraction less than 1;
+we want to multiply the sum of these two quantities by the appropriate
+factor, based on the specified units, in order to produce a |scaled|
+result, and we want to do the calculation with fixed point arithmetic that
+does not overflow.
+
+@<Scan units and set |cur_val| to $x\cdot(|cur_val|+f/2^{16})$...@>=
+if inf then @<Scan for \(f)\.{fil} units; |goto attach_fraction| if found@>;
+@<Scan for \(u)units that are internal dimensions;
+  |goto attach_sign| with |cur_val| set if found@>;
+if mu then @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>;
+if scan_keyword("true") then @<Adjust \(f)for the magnification ratio@>;
+@.true@>
+if scan_keyword("pt") then goto attach_fraction; {the easy case}
+@.pt@>
+@<Scan for \(a)all other units and adjust |cur_val| and |f| accordingly;
+  |goto done| in the case of scaled points@>;
+attach_fraction: if cur_val>=@'40000 then arith_error:=true
+else cur_val:=cur_val*unity+f;
+done:
+
+@ In traditional TeX, a specification like `\.{filllll}' or `\.{fill L L
+L}' will lead to two error messages (one for each additional keyword
+\.{"l"}). 
+
+Not so for luatex, it just parses the construct in reverse.
+
+@<Scan for \(f)\.{fil} units...@>=
+if scan_keyword("filll") then begin cur_order:=filll; goto attach_fraction; end
+else if scan_keyword("fill") then begin cur_order:=fill; goto attach_fraction; end
+else if scan_keyword("fil") then begin cur_order:=fil; goto attach_fraction; end
+else if scan_keyword("fi") then begin cur_order:=sfi; goto attach_fraction; end
+
+@ @<Scan for \(u)units that are internal dimensions...@>=
+save_cur_val:=cur_val;
+@<Get the next non-blank non-call...@>;
+if (cur_cmd<min_internal)or(cur_cmd>max_internal) then back_input
+else  begin if mu then
+    begin scan_something_internal(mu_val,false); @<Coerce glue...@>;
+    if cur_val_level<>mu_val then mu_error;
+    end
+  else scan_something_internal(dimen_val,false);
+  v:=cur_val; goto found;
+  end;
+if mu then goto not_found;
+if scan_keyword("em") then v:=(@<The em width for |cur_font|@>)
+@.em@>
+else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>)
+@.ex@>
+else if scan_keyword("px") then v:=pdf_px_dimen
+@.px@>
+else goto not_found;
+@<Scan an optional space@>;
+found:cur_val:=nx_plus_y(save_cur_val,v,xn_over_d(v,f,@'200000));
+goto attach_sign;
+not_found:
+
+@ @<Scan for \(m)\.{mu} units and |goto attach_fraction|@>=
+if scan_keyword("mu") then goto attach_fraction
+@.mu@>
+else  begin print_err("Illegal unit of measure ("); print("mu inserted)");
+@.Illegal unit of measure@>
+  help4("The unit of measurement in math glue must be mu.")@/
+    ("To recover gracefully from this error, it's best to")@/
+    ("delete the erroneous units; e.g., type `2' to delete")@/
+    ("two letters. (See Chapter 27 of The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+  error; goto attach_fraction;
+  end
+
+@ @<Adjust \(f)for the magnification ratio@>=
+begin prepare_mag;
+if mag<>1000 then
+  begin cur_val:=xn_over_d(cur_val,1000,mag);
+  f:=(1000*f+@'200000*remainder) div mag;
+  cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
+  end;
+end
+
+@ The necessary conversion factors can all be specified exactly as
+fractions whose numerator and denominator add to 32768 or less.
+According to the definitions here, $\rm2660\,dd\approx1000.33297\,mm$;
+this agrees well with the value $\rm1000.333\,mm$ cited by Bosshard
+@^Bosshard, Hans Rudolf@>
+in {\sl Technische Grundlagen zur Satzherstellung\/} (Bern, 1980).
+The Didot point has been newly standardized in 1978;
+it's now exactly $\rm 1\,nd=0.375\,mm$.
+Conversion uses the equation $0.375=21681/20320/72.27\cdot25.4$.
+The new Cicero follows the new Didot point; $\rm 1\,nc=12\,nd$.  These
+would lead to the ratios $21681/20320$ and $65043/5080$, respectively.
+The closest approximations supported by the algorithm would be
+$11183/10481$ and $1370/107$.  In order to maintain the
+relation $\rm 1\,nc=12\,nd$, we pick the ratio $685/642$ for $\rm nd$,
+however.
+
+@d set_conversion_end(#)== denom:=#; end
+@d set_conversion(#)==@+begin num:=#; set_conversion_end
+
+@<Scan for \(a)all other units and adjust |cur_val| and |f|...@>=
+if scan_keyword("in") then set_conversion(7227)(100)
+@.in@>
+else if scan_keyword("pc") then set_conversion(12)(1)
+@.pc@>
+else if scan_keyword("cm") then set_conversion(7227)(254)
+@.cm@>
+else if scan_keyword("mm") then set_conversion(7227)(2540)
+@.mm@>
+else if scan_keyword("bp") then set_conversion(7227)(7200)
+@.bp@>
+else if scan_keyword("dd") then set_conversion(1238)(1157)
+@.dd@>
+else if scan_keyword("cc") then set_conversion(14856)(1157)
+@.cc@>
+else if scan_keyword("nd") then set_conversion(685)(642)
+@.nd@>
+else if scan_keyword("nc") then set_conversion(1370)(107)
+@.nc@>
+else if scan_keyword("sp") then goto done
+@.sp@>
+else @<Complain about unknown unit and |goto done2|@>;
+cur_val:=xn_over_d(cur_val,num,denom);
+f:=(num*f+@'200000*remainder) div denom;@/
+cur_val:=cur_val+(f div @'200000); f:=f mod @'200000;
+done2:
+
+@ @<Complain about unknown unit...@>=
+begin print_err("Illegal unit of measure ("); print("pt inserted)");
+@.Illegal unit of measure@>
+help6("Dimensions can be in units of em, ex, in, pt, pc,")@/
+  ("cm, mm, dd, cc, nd, nc, bp, or sp; but yours is a new one!")@/
+  ("I'll assume that you meant to say pt, for printer's points.")@/
+  ("To recover gracefully from this error, it's best to")@/
+  ("delete the erroneous units; e.g., type `2' to delete")@/
+  ("two letters. (See Chapter 27 of The TeXbook.)");
+@:TeXbook}{\sl The \TeX book@>
+error; goto done2;
+end
+
+
+@ @<Report that this dimension is out of range@>=
+begin print_err("Dimension too large");
+@.Dimension too large@>
+help2("I can't work with sizes bigger than about 19 feet.")@/
+  ("Continue and I'll use the largest value I can.");@/
+error; cur_val:=max_dimen; arith_error:=false;
+end
+
+@ The final member of \TeX's value-scanning trio is |scan_glue|, which
+makes |cur_val| point to a glue specification. The reference count of that
+glue spec will take account of the fact that |cur_val| is pointing to~it.
+
+The |level| parameter should be either |glue_val| or |mu_val|.
+
+Since |scan_dimen| was so much more complex than |scan_int|, we might expect
+|scan_glue| to be even worse. But fortunately, it is very simple, since
+most of the work has already been done.
+
+@p procedure scan_glue(@!level:small_number);
+  {sets |cur_val| to a glue spec pointer}
+label exit;
+var negative:boolean; {should the answer be negated?}
+@!q:pointer; {new glue specification}
+@!mu:boolean; {does |level=mu_val|?}
+begin mu:=(level=mu_val); @<Get the next non-blank non-sign...@>;
+if (cur_cmd>=min_internal)and(cur_cmd<=max_internal) then
+  begin scan_something_internal(level,negative);
+  if cur_val_level>=glue_val then
+    begin if cur_val_level<>level then mu_error;
+    return;
+    end;
+  if cur_val_level=int_val then scan_dimen(mu,false,true)
+  else if level=mu_val then mu_error;
+  end
+else  begin back_input; scan_dimen(mu,false,false);
+  if negative then negate(cur_val);
+  end;
+@<Create a new glue specification whose width is |cur_val|; scan for its
+  stretch and shrink components@>;
+exit:end;
+@#
+@<Declare procedures needed for expressions@>@;
+
+@ @<Create a new glue specification whose width is |cur_val|...@>=
+q:=new_spec(zero_glue); width(q):=cur_val;
+if scan_keyword("plus") then
+@.plus@>
+  begin scan_dimen(mu,true,false);
+  stretch(q):=cur_val; stretch_order(q):=cur_order;
+  end;
+if scan_keyword("minus") then
+@.minus@>
+  begin scan_dimen(mu,true,false);
+  shrink(q):=cur_val; shrink_order(q):=cur_order;
+  end;
+cur_val:=q
+
+@ Here's a similar procedure that returns a pointer to a rule node. This
+routine is called just after \TeX\ has seen \.{\\hrule} or \.{\\vrule};
+therefore |cur_cmd| will be either |hrule| or |vrule|. The idea is to store
+the default rule dimensions in the node, then to override them if
+`\.{height}' or `\.{width}' or `\.{depth}' specifications are
+found (in any order).
+
+@d default_rule=26214 {0.4\thinspace pt}
+
+@p function scan_rule_spec:pointer;
+label reswitch;
+var q:pointer; {the rule node being created}
+begin q:=new_rule; {|width|, |depth|, and |height| all equal |null_flag| now}
+if cur_cmd=vrule then begin
+  width(q):=default_rule;
+  rule_dir(q):=body_direction;
+  end
+else begin
+  height(q):=default_rule; depth(q):=0;
+  rule_dir(q):=text_direction;
+end;
+reswitch: if scan_keyword("width") then
+@.width@>
+  begin scan_normal_dimen; width(q):=cur_val; goto reswitch;
+  end;
+if scan_keyword("height") then
+@.height@>
+  begin scan_normal_dimen; height(q):=cur_val; goto reswitch;
+  end;
+if scan_keyword("depth") then
+@.depth@>
+  begin scan_normal_dimen; depth(q):=cur_val; goto reswitch;
+  end;
+scan_rule_spec:=q;
+end;
+
+@* \[27] Building token lists.
+The token lists for macros and for other things like \.{\\mark} and \.{\\output}
+and \.{\\write} are produced by a procedure called |scan_toks|.
+
+Before we get into the details of |scan_toks|, let's consider a much
+simpler task, that of converting the current string into a token list.
+The |str_toks| function does this; it classifies spaces as type |spacer|
+and everything else as type |other_char|.
+
+The token list created by |str_toks| begins at |link(temp_token_head)| and ends
+at the value |p| that is returned. (If |p=temp_token_head|, the list is empty.)
+
+|lua_str_toks| is almost identical, but it also escapes the three
+symbols that |lua| considers special while scanning a literal string
+
+@d unicode_incr(#)==if str_pool[#]>@"F0 then #:=#+4 else if str_pool[#]>@"E0 
+     then #:=#+3 else if str_pool[#]>@"C0 then #:=#+2 else incr(#)
+
+
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function lua_str_toks(@!b:pool_pointer):pointer;
+  {changes the string |str_pool[b..pool_ptr]| to a token list}
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!t:halfword; {token being appended}
+@!k:pool_pointer; {index into |str_pool|}
+begin
+p:=temp_token_head; link(p):=null; k:=b;
+while k<pool_ptr do
+  begin t:=pool_to_unichar(k);
+  if t=" " then t:=space_token
+  else
+    begin
+     if (t="\") or (t="""") or (t="'") or (t=10) or (t=13) then
+          fast_store_new_token(other_token+"\");
+     if (t=10) then
+       t:="n";
+     if (t=13) then
+       t:="r";
+    t:=other_token+t;
+    end;
+  fast_store_new_token(t);
+  unicode_incr(k);
+  end;
+pool_ptr:=b; lua_str_toks:=p;
+end;
+
+function str_toks(@!b:pool_pointer):pointer;
+  {changes the string |str_pool[b..pool_ptr]| to a token list}
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!t:halfword; {token being appended}
+@!k:pool_pointer; {index into |str_pool|}
+begin
+p:=temp_token_head; link(p):=null; k:=b;
+while k<pool_ptr do
+  begin t:=pool_to_unichar(k);
+  if t=" " then t:=space_token
+  else t:=other_token+t;
+  fast_store_new_token(t);
+  unicode_incr(k);
+  end;
+pool_ptr:=b; str_toks:=p;
+end;
+
+@ The main reason for wanting |str_toks| is the next function,
+|the_toks|, which has similar input/output characteristics.
+
+This procedure is supposed to scan something like `\.{\\skip\\count12}',
+i.e., whatever can follow `\.{\\the}', and it constructs a token list
+containing something like `\.{-3.0pt minus 0.5fill}'.
+
+@p function the_toks:pointer;
+label exit;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!p,@!q,@!r:pointer; {used for copying a token list}
+@!b:pool_pointer; {base of temporary string}
+@!c:small_number; {value of |cur_chr|}
+begin @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>;@/
+get_x_token; scan_something_internal(tok_val,false);
+if cur_val_level>=ident_val then begin
+  @<Copy the token list@>;
+  the_toks:=p;
+  end
+else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+  case cur_val_level of
+  int_val:print_int(cur_val);
+  attr_val:print_int(cur_val);
+  dir_val:print_dir(cur_val);
+  dimen_val:begin print_scaled(cur_val); print("pt");
+    end;
+  glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
+    end;
+  mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
+    end;
+  end; {there are no other cases}
+  selector:=old_setting; the_toks:=str_toks(b);
+  end;
+exit:end;
+
+function the_scanned_result:str_number;
+var old_setting:0..max_selector; {holds |selector| setting}
+begin
+old_setting:=selector; selector:=new_string;
+if cur_val_level>=ident_val then begin
+  if cur_val<>null then begin
+    show_token_list(link(cur_val),null,pool_size-pool_ptr);
+    the_scanned_result:=make_string;
+    end
+  else
+    the_scanned_result:="";
+  end
+else begin
+    case cur_val_level of
+    int_val:print_int(cur_val);
+    attr_val:print_int(cur_val);
+    dir_val:print_dir(cur_val);
+    dimen_val:begin print_scaled(cur_val); print("pt");
+      end;
+    glue_val: begin print_spec(cur_val,"pt"); delete_glue_ref(cur_val);
+      end;
+    mu_val: begin print_spec(cur_val,"mu"); delete_glue_ref(cur_val);
+      end;
+    end; {there are no other cases}
+    the_scanned_result:=make_string;
+  end;
+selector:=old_setting;
+end;
+
+@ @<Copy the token list@>=
+begin p:=temp_token_head; link(p):=null;
+if cur_val_level=ident_val then store_new_token(cs_token_flag+cur_val)
+else if cur_val<>null then
+  begin r:=link(cur_val); {do not copy the reference count}
+  while r<>null do
+    begin fast_store_new_token(info(r)); r:=link(r);
+    end;
+  end;
+end
+
+@ Here's part of the |expand| subroutine that we are now ready to complete:
+
+@p procedure ins_the_toks;
+var junk:pointer;
+begin junk:=the_toks; ins_list(link(temp_token_head));
+end;
+
+@ The primitives \.{\\number}, \.{\\romannumeral}, \.{\\string}, \.{\\meaning},
+\.{\\fontname}, and \.{\\jobname} are defined as follows.
+
+\eTeX\ adds \.{\\eTeXrevision} such that |job_name_code| remains last.
+
+\pdfTeX\ adds \.{\\eTeXrevision}, \.{\\pdftexrevision}, \.{\\pdftexbanner},
+\.{\\pdffontname}, \.{\\pdffontobjnum}, \.{\\pdffontsize}, and \.{\\pdfpageref}
+such that |job_name_code| remains last.
+
+@d number_code=0 {command code for \.{\\number}}
+@d roman_numeral_code=1 {command code for \.{\\romannumeral}}
+@d string_code=2 {command code for \.{\\string}}
+@d meaning_code=3 {command code for \.{\\meaning}}
+@d font_name_code=4 {command code for \.{\\fontname}}
+@d etex_code=5 {command code for \.{\\eTeXVersion}}
+@d omega_code=6 {command code for \.{\\OmegaVersion}}
+@d aleph_code=7 {command code for \.{\\AlephVersion}}
+@d format_name_code=8 {command code for \.{\\AlephVersion}}
+@d pdftex_first_expand_code = 9 {base for \pdfTeX's command codes}
+@d pdftex_revision_code     = pdftex_first_expand_code + 0 {command code for \.{\\pdftexrevision}}
+@d pdftex_banner_code       = pdftex_first_expand_code + 1 {command code for \.{\\pdftexbanner}}
+@d pdf_font_name_code       = pdftex_first_expand_code + 2 {command code for \.{\\pdffontname}}
+@d pdf_font_objnum_code     = pdftex_first_expand_code + 3 {command code for \.{\\pdffontobjnum}}
+@d pdf_font_size_code       = pdftex_first_expand_code + 4 {command code for \.{\\pdffontsize}}
+@d pdf_page_ref_code        = pdftex_first_expand_code + 5 {command code for \.{\\pdfpageref}}
+@d pdf_xform_name_code      = pdftex_first_expand_code + 6 {command code for \.{\\pdfxformname}}
+@d left_margin_kern_code    = pdftex_first_expand_code + 7 {command code for \.{\\leftmarginkern}}
+@d right_margin_kern_code   = pdftex_first_expand_code + 8 {command code for \.{\\rightmarginkern}}
+@d pdf_creation_date_code   = pdftex_first_expand_code + 9 {command code for \.{\\pdfcreationdate}}
+@d uniform_deviate_code     = pdftex_first_expand_code + 10 {command code for \.{\\uniformdeviate}}
+@d normal_deviate_code      = pdftex_first_expand_code + 11 {command code for \.{\\normaldeviate}}
+@d pdf_insert_ht_code       = pdftex_first_expand_code + 12 {command code for \.{\\pdfinsertht}}
+@d pdf_ximage_bbox_code     = pdftex_first_expand_code + 13 {command code for \.{\\pdfximagebbox}}
+@d lua_code                 = pdftex_first_expand_code + 14 {command code for \.{\\directlua}}
+@d lua_escape_string_code   = pdftex_first_expand_code + 15 {command code for \.{\\luaescapestring}}
+@d pdf_colorstack_init_code = pdftex_first_expand_code + 16 {command code for \.{\\pdfcolorstackinit}}
+@d luatex_revision_code     = pdftex_first_expand_code + 17 {command code for \.{\\luatexrevision}}
+@d luatex_date_code         = pdftex_first_expand_code + 18 {command code for \.{\\luatexdate}}
+@d pdftex_convert_codes     = pdftex_first_expand_code + 19 {end of \pdfTeX's command codes}
+@d job_name_code=pdftex_convert_codes {command code for \.{\\jobname}}
+
+
+@<Put each...@>=
+primitive("number",convert,number_code);@/
+@!@:number_}{\.{\\number} primitive@>
+primitive("romannumeral",convert,roman_numeral_code);@/
+@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
+primitive("string",convert,string_code);@/
+@!@:string_}{\.{\\string} primitive@>
+primitive("meaning",convert,meaning_code);@/
+@!@:meaning_}{\.{\\meaning} primitive@>
+primitive("eTeXVersion",convert,etex_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("OmegaVersion",convert,omega_code);@/
+@!@:omega_version_}{\.{\\OmegaVersion} primitive@>
+primitive("AlephVersion",convert,aleph_code);@/
+@!@:aleph_version_}{\.{\\AlephVersion} primitive@>
+primitive("fontname",convert,font_name_code);@/
+@!@:font_name_}{\.{\\fontname} primitive@>
+primitive("pdftexrevision",convert,pdftex_revision_code);@/
+@!@:pdftex_revision_}{\.{\\pdftexrevision} primitive@>
+primitive("luatexrevision",convert,luatex_revision_code);@/
+@!@:luatex_revision_}{\.{\\luatexrevision} primitive@>
+primitive("luatexdatestamp",convert,luatex_date_code);@/
+@!@:luatex_date_}{\.{\\luatexdatestamp} primitive@>
+primitive("pdftexbanner",convert,pdftex_banner_code);@/
+@!@:pdftex_banner_}{\.{\\pdftexbanner} primitive@>
+primitive("pdffontname",convert,pdf_font_name_code);@/
+@!@:pdf_font_name_}{\.{\\pdffontname} primitive@>
+primitive("pdffontobjnum",convert,pdf_font_objnum_code);@/
+@!@:pdf_font_objnum_}{\.{\\pdffontobjnum} primitive@>
+primitive("pdffontsize",convert,pdf_font_size_code);@/
+@!@:pdf_font_size_}{\.{\\pdffontsize} primitive@>
+primitive("pdfpageref",convert,pdf_page_ref_code);@/
+@!@:pdf_page_ref_}{\.{\\pdfpageref} primitive@>
+primitive("leftmarginkern",convert,left_margin_kern_code);@/
+@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
+primitive("rightmarginkern",convert,right_margin_kern_code);@/
+@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
+primitive("pdfxformname",convert,pdf_xform_name_code);@/
+@!@:pdf_xform_name_}{\.{\\pdfxformname} primitive@>
+primitive("pdfcreationdate",convert,pdf_creation_date_code);@/
+@!@:pdf_creation_date_}{\.{\\pdfcreationdate} primitive@>
+primitive("pdfuniformdeviate",convert,uniform_deviate_code);@/
+@!@:uniform_deviate_}{\.{\\pdfuniformdeviate} primitive@>
+primitive("pdfcolorstackinit",convert,pdf_colorstack_init_code);@/
+@!@:pdf_colorstack_init_}{\.{\\pdfcolorstackinit} primitive@>
+primitive("pdfnormaldeviate",convert,normal_deviate_code);@/
+@!@:normal_deviate_}{\.{\\pdfnormaldeviate} primitive@>
+primitive("directlua",convert,lua_code);@/
+@!@:lua_}{\.{\\directlua} primitive@>
+primitive("luaescapestring",convert,lua_escape_string_code);@/
+@!@:lua_}{\.{\\luaescapestring} primitive@>
+@#
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+primitive("formatname",convert,format_name_code);@/
+@!@:format_name_}{\.{\\formatname} primitive@>
+primitive("pdfinsertht",convert,pdf_insert_ht_code);@/
+@!@:pdf_insert_ht_}{\.{\\pdfinsertht} primitive@>
+primitive("pdfximagebbox",convert,pdf_ximage_bbox_code);@/
+@!@:pdf_ximage_bbox_}{\.{\\pdfximagebbox} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+convert: case chr_code of
+  number_code: print_esc("number");
+  roman_numeral_code: print_esc("romannumeral");
+  string_code: print_esc("string");
+  meaning_code: print_esc("meaning");
+  etex_code: print_esc("eTeXVersion");
+  omega_code: print_esc("OmegaVersion");
+  aleph_code: print_esc("AlephVersion");
+  font_name_code: print_esc("fontname");
+  pdftex_revision_code: print_esc("pdftexrevision");
+  luatex_revision_code: print_esc("luatexrevision");
+  luatex_date_code:     print_esc("luatexdatestamp");
+  pdftex_banner_code:   print_esc("pdftexbanner");
+  pdf_font_name_code:   print_esc("pdffontname");
+  pdf_font_objnum_code: print_esc("pdffontobjnum");
+  pdf_font_size_code:   print_esc("pdffontsize");
+  pdf_page_ref_code:    print_esc("pdfpageref");
+  left_margin_kern_code:    print_esc("leftmarginkern");
+  right_margin_kern_code:   print_esc("rightmarginkern");
+  pdf_xform_name_code:  print_esc("pdfxformname");
+  pdf_creation_date_code: print_esc("pdfcreationdate");
+  pdf_colorstack_init_code: print_esc("pdfcolorstackinit");
+  uniform_deviate_code:   print_esc("pdfuniformdeviate");
+  normal_deviate_code:    print_esc("pdfnormaldeviate");
+  pdf_insert_ht_code: print_esc("pdfinsertht");
+  pdf_ximage_bbox_code:    print_esc("pdfximagebbox");
+  lua_code:                print_esc("directlua");
+  lua_escape_string_code:  print_esc("luaescapestring");
+  @/@<Cases of |convert| for |print_cmd_chr|@>@/
+  othercases print_esc("jobname")
+  endcases;
+
+@ The procedure |conv_toks| uses |str_toks| to insert the token list
+for |convert| functions into the scanner; `\.{\\outer}' control sequences
+are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
+
+The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
+any pending string in its output. In order to save such a pending string,
+we have to create a temporary string that is destroyed immediately after.
+
+@d save_cur_string==if str_start[str_ptr]<pool_ptr then u:=make_string
+@d restore_cur_string==if u<>0 then begin decr(str_ptr); u:=0; end
+
+@p procedure conv_toks;
+label exit;
+var old_setting:0..max_selector; {holds |selector| setting}
+p, q: pointer;
+@!c:number_code..job_name_code; {desired type of conversion}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_def_ref: pointer; {|def_ref| upon entry, important if inside `\.{\\message}'}
+@!save_warning_index: pointer;
+@!bool: boolean; {temp boolean}
+@!i: integer; {first temp integer}
+@!j: integer; {second temp integer}
+@!b:pool_pointer; {base of temporary string}
+@!s: str_number; {first temp string}
+@!u: str_number; {third temp string}
+@!junk: pointer;
+begin
+c:=cur_chr;
+u:=0; { will become non-nil if a string is already being built}
+j:=0; i:=0;
+@<Scan the argument for command |c|@>;
+old_setting:=selector; selector:=new_string; b:=pool_ptr;
+@<Print the result of command |c|@>;
+selector:=old_setting; junk:=str_toks(b); ins_list(link(temp_token_head));
+exit:
+end;
+
+@ @<Scan the argument for command |c|@>=
+case c of
+number_code,roman_numeral_code: scan_int;
+string_code, meaning_code: begin save_scanner_status:=scanner_status;
+  scanner_status:=normal; get_token; scanner_status:=save_scanner_status;
+  end;
+etex_code: do_nothing;
+omega_code: do_nothing;
+aleph_code: do_nothing;
+font_name_code: scan_font_ident;
+pdftex_revision_code: do_nothing;
+luatex_revision_code: do_nothing;
+luatex_date_code: do_nothing;
+pdftex_banner_code: do_nothing;
+pdf_font_name_code, pdf_font_objnum_code, pdf_font_size_code: begin
+    scan_font_ident;
+    if cur_val = null_font then
+        pdf_error("font", "invalid font identifier");
+    if c <> pdf_font_size_code then begin
+        pdf_check_vf_cur_val;
+        if not font_used(cur_val) then
+            pdf_init_font_cur_val;
+    end;
+end;
+pdf_page_ref_code: begin
+    scan_int;
+    if cur_val <= 0 then
+        pdf_error("pageref", "invalid page number");
+end;
+left_margin_kern_code, right_margin_kern_code: begin
+    scan_int;
+    if (box(cur_val) = null) or (type(box(cur_val)) <> hlist_node) then
+        pdf_error("marginkern", "a non-empty hbox expected")
+end;
+pdf_xform_name_code: begin
+    scan_int;
+    pdf_check_obj(obj_type_xform, cur_val);
+end;
+pdf_creation_date_code:
+  begin
+    b := pool_ptr;
+    getcreationdate;
+    junk := str_toks(b);
+    ins_list(link(temp_token_head));
+    return;
+  end;
+job_name_code: if job_name=0 then open_log_file;
+pdf_colorstack_init_code:
+  begin
+    bool := scan_keyword("page");
+    if scan_keyword("direct") then
+        cur_val := direct_always
+    else
+        if scan_keyword("page") then
+            cur_val := direct_page
+        else
+            cur_val := set_origin;
+    save_scanner_status := scanner_status;
+    save_warning_index := warning_index;
+    save_def_ref := def_ref;
+    save_cur_string;
+    scan_pdf_ext_toks;
+    s := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    def_ref := save_def_ref;
+    warning_index := save_warning_index;
+    scanner_status := save_scanner_status;
+    cur_val := newcolorstack(s, cur_val, bool);
+    flush_str(s);
+    cur_val_level := int_val;
+    if cur_val < 0 then begin
+        print_err("Too many color stacks");
+@.Too many color stacks@>
+        help2("The number of color stacks is limited to 32768.")@/
+        ("I'll use the default color stack 0 here.");
+        error;
+        cur_val := 0;
+       restore_cur_string;
+    end;
+  end;
+uniform_deviate_code:     scan_int;
+normal_deviate_code:      do_nothing;
+lua_escape_string_code:
+  begin
+	u:=0;
+    { check if a string is already being built}
+    if str_start_macro(str_ptr)<pool_ptr then u:=make_string;
+    save_scanner_status := scanner_status;
+    save_def_ref := def_ref;
+    save_warning_index := warning_index;
+    scan_pdf_ext_toks;
+    s := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    def_ref := save_def_ref;
+    warning_index := save_warning_index;
+    scanner_status := save_scanner_status;
+    junk := lua_str_toks(str_start_macro(s));
+	ins_list(link(temp_token_head));
+    flush_str(s);
+	if u<>0 then begin decr(str_ptr); u:=0; end; 
+    return;
+  end;
+lua_code:
+  begin
+	u:=0;
+    { check if a string is already being built}
+    if str_start_macro(str_ptr)<pool_ptr then u:=make_string;
+    save_scanner_status := scanner_status;
+    save_def_ref := def_ref;
+    save_warning_index := warning_index;
+	scan_register_num;
+	i := cur_val;
+    scan_pdf_ext_toks;
+    s := def_ref;
+    warning_index := save_warning_index;
+    def_ref := save_def_ref;
+    scanner_status := save_scanner_status;
+    luacstrings:=0;
+    luatokencall(i,s);
+    delete_token_ref(s);
+	if u<>0 then begin
+      if str_ptr=u+1 then 
+        decr(str_ptr)
+      else begin {copy old string to the top location}
+         i:=0;
+	     str_room(length(u));
+         while i<length(u) do
+           str_pool[pool_ptr+i]:=str_pool[str_start_macro(u)+i];
+        end;
+    end; 
+	if luacstrings>0 then
+	  lua_string_start;
+    return;
+  end;
+pdf_insert_ht_code: scan_register_num;
+pdf_ximage_bbox_code: begin
+    scan_int;
+    pdf_check_obj(obj_type_ximage, cur_val);
+    i := obj_data_ptr(cur_val);
+    scan_int;
+    j := cur_val;
+    if (j < 1) or (j > 4) then
+        pdf_error("pdfximagebbox", "invalid parameter");
+    end;
+@<Cases of `Scan the argument for command |c|'@>
+end {there are no other cases}
+
+@ @<Print the result of command |c|@>=
+case c of
+number_code: print_int(cur_val);
+roman_numeral_code: print_roman_int(cur_val);
+string_code:if cur_cs<>0 then sprint_cs(cur_cs)
+  else print(cur_chr);
+meaning_code: print_meaning;
+etex_code: print(eTeX_version_string);
+omega_code: print(Omega_version_string);
+aleph_code: print(Aleph_version_string);
+font_name_code: begin
+  append_string(font_name(cur_val));
+  if font_size(cur_val)<>font_dsize(cur_val) then
+    begin print(" at "); print_scaled(font_size(cur_val));
+    print("pt");
+    end;
+  end;
+pdftex_revision_code: print(pdftex_revision);
+luatex_revision_code: print(luatex_revision);
+luatex_date_code:   print_int(luatex_date_info);
+pdftex_banner_code: print(pdftex_banner);
+pdf_font_name_code, pdf_font_objnum_code: begin
+    set_ff(cur_val);
+    if c = pdf_font_name_code then
+        print_int(obj_info(pdf_font_num(ff)))
+    else
+        print_int(pdf_font_num(ff));
+end;
+pdf_font_size_code: begin
+    print_scaled(font_size(cur_val));
+    print("pt");
+end;
+pdf_page_ref_code: print_int(get_obj(obj_type_page, cur_val, false));
+left_margin_kern_code: begin
+    p := list_ptr(box(cur_val));
+    if (p <> null) and (not is_char_node(p)) and
+       (type(p) = glue_node) and (subtype(p) = left_skip_code + 1) then
+       p := vlink(p);
+    if (p <> null) and (not is_char_node(p)) and
+       (type(p) = margin_kern_node) and (subtype(p) = left_side) then
+        print_scaled(width(p))
+    else
+        print("0");
+    print("pt");
+end;
+right_margin_kern_code: begin
+    q := list_ptr(box(cur_val));
+    p := null;
+    if q <> null then begin
+        p := prev_rightmost(q, null);
+        if (p <> null) and (not is_char_node(p)) and
+           (type(p) = glue_node) and (subtype(p) = right_skip_code + 1) then
+           p := prev_rightmost(q, p);
+    end;
+    if (p <> null) and (not is_char_node(p)) and
+       (type(p) = margin_kern_node) and (subtype(p) = right_side) then
+        print_scaled(width(p))
+    else
+        print("0");
+    print("pt");
+end;
+pdf_xform_name_code: print_int(obj_info(cur_val));
+pdf_colorstack_init_code: print_int(cur_val);
+uniform_deviate_code:     print_int(unif_rand(cur_val));
+normal_deviate_code:      print_int(norm_rand);
+pdf_insert_ht_code: begin
+    i := qi(cur_val);
+    p := page_ins_head;
+    while i >= subtype(vlink(p)) do
+        p := vlink(p);
+    if subtype(p) = i then
+        print_scaled(height(p))
+    else
+        print("0");
+    print("pt");
+end;
+pdf_ximage_bbox_code: begin
+    case j of
+    1: print_scaled(epdf_orig_x(i));
+    2: print_scaled(epdf_orig_y(i));
+    3: print_scaled(epdf_orig_x(i) + image_width(i));
+    4: print_scaled(epdf_orig_y(i) + image_height(i));
+    endcases;
+    print("pt");
+end;
+format_name_code: print(format_name);
+job_name_code: print(job_name);
+@/@<Cases of `Print the result of command |c|'@>@/
+end {there are no other cases}
+
+@ 
+@p function is_convert(c:halfword):boolean;
+begin
+  is_convert:=(c=convert);
+end;
+
+function the_convert_string (c:halfword):str_number;
+var old_setting:0..max_selector; {saved |selector| setting}
+	is_known:boolean;
+begin
+  old_setting:=selector; 
+  selector:=new_string;
+  is_known:=true;
+  case c of
+  etex_code:            print(eTeX_version_string);
+  omega_code:           print(Omega_version_string);
+  aleph_code:           print(Aleph_version_string);
+  pdftex_revision_code: print(pdftex_revision);
+  luatex_revision_code: print(luatex_revision);
+  luatex_date_code:     print_int(luatex_date_info);
+  pdftex_banner_code:   print(pdftex_banner);
+  normal_deviate_code:  print_int(norm_rand);
+  format_name_code:     print(format_name);
+  job_name_code:        print(job_name);
+@/@<Cases of `Print the result of command |c|'@>@/
+  othercases            is_known:=false
+  end;
+  if is_known then
+    the_convert_string := make_string
+  else
+    the_convert_string := 0;
+  selector:=old_setting;
+end;
+
+@ Now we can't postpone the difficulties any longer; we must bravely tackle
+|scan_toks|. This function returns a pointer to the tail of a new token
+list, and it also makes |def_ref| point to the reference count at the
+head of that list.
+
+There are two boolean parameters, |macro_def| and |xpand|. If |macro_def|
+is true, the goal is to create the token list for a macro definition;
+otherwise the goal is to create the token list for some other \TeX\
+primitive: \.{\\mark}, \.{\\output}, \.{\\everypar}, \.{\\lowercase},
+\.{\\uppercase}, \.{\\message}, \.{\\errmessage}, \.{\\write}, or
+\.{\\special}. In the latter cases a left brace must be scanned next; this
+left brace will not be part of the token list, nor will the matching right
+brace that comes at the end. If |xpand| is false, the token list will
+simply be copied from the input using |get_token|. Otherwise all expandable
+tokens will be expanded until unexpandable tokens are left, except that
+the results of expanding `\.{\\the}' are not expanded further.
+If both |macro_def| and |xpand| are true, the expansion applies
+only to the macro body (i.e., to the material following the first
+|left_brace| character).
+
+The value of |cur_cs| when |scan_toks| begins should be the |eqtb|
+address of the control sequence to display in ``runaway'' error
+messages.
+
+@p function scan_toks(@!macro_def,@!xpand:boolean):pointer;
+label found,done,done1,done2;
+var t:halfword; {token representing the highest parameter number}
+@!s:halfword; {saved token}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+@!hash_brace:halfword; {possible `\.{\#\{}' token}
+begin if macro_def then scanner_status:=defining
+@+else scanner_status:=absorbing;
+warning_index:=cur_cs; p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0;
+p:=def_ref; hash_brace:=0; t:=zero_token;
+if macro_def then @<Scan and build the parameter part of the macro definition@>
+else scan_left_brace; {remove the compulsory left brace}
+@<Scan and build the body of the token list; |goto found| when finished@>;
+found: scanner_status:=normal;
+if hash_brace<>0 then store_new_token(hash_brace);
+scan_toks:=p;
+end;
+
+@ @<Scan and build the parameter part...@>=
+begin loop begin get_token; {set |cur_cmd|, |cur_chr|, |cur_tok|}
+  if cur_tok<right_brace_limit then goto done1;
+  if cur_cmd=mac_param then
+    @<If the next character is a parameter number, make |cur_tok|
+      a |match| token; but if it is a left brace, store
+      `|left_brace|, |end_match|', set |hash_brace|, and |goto done|@>;
+  store_new_token(cur_tok);
+  end;
+done1: store_new_token(end_match_token);
+if cur_cmd=right_brace then
+  @<Express shock at the missing left brace; |goto found|@>;
+done: end
+
+@ @<Express shock...@>=
+begin print_err("Missing { inserted"); incr(align_state);
+@.Missing \{ inserted@>
+help2("Where was the left brace? You said something like `\def\a}',")@/
+  ("which I'm going to interpret as `\def\a{}'."); error; goto found;
+end
+
+@ @<If the next character is a parameter number...@>=
+begin s:=match_token+cur_chr; get_token;
+if cur_cmd=left_brace then
+  begin hash_brace:=cur_tok;
+  store_new_token(cur_tok); store_new_token(end_match_token);
+  goto done;
+  end;
+if t=zero_token+9 then
+  begin print_err("You already have nine parameters");
+@.You already have nine...@>
+  help1("I'm going to ignore the # sign you just used."); error;
+  end
+else  begin incr(t);
+  if cur_tok<>t then
+    begin print_err("Parameters must be numbered consecutively");
+@.Parameters...consecutively@>
+    help2("I've inserted the digit you should have used after the #.")@/
+      ("Type `1' to delete what you did use."); back_error;
+    end;
+  cur_tok:=s;
+  end;
+end
+
+@ @<Scan and build the body of the token list; |goto found| when finished@>=
+unbalance:=1;
+loop@+  begin if xpand then @<Expand the next part of the input@>
+  else get_token;
+  if cur_tok<right_brace_limit then
+    if cur_cmd<right_brace then incr(unbalance)
+    else  begin decr(unbalance);
+      if unbalance=0 then goto found;
+      end
+  else if cur_cmd=mac_param then
+    if macro_def then @<Look for parameter number or \.{\#\#}@>;
+  store_new_token(cur_tok);
+  end
+
+@ Here we insert an entire token list created by |the_toks| without
+expanding it further.
+
+@<Expand the next part of the input@>=
+begin loop begin get_filtered_next;
+  if cur_cmd>=call then
+    if info(link(cur_chr))=protected_token then
+      begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+      end;
+  if cur_cmd<=max_command then goto done2;
+  if cur_cmd<>the then expand
+  else  begin q:=the_toks;
+    if link(temp_token_head)<>null then
+      begin link(p):=link(temp_token_head); p:=q;
+      end;
+    end;
+  end;
+done2: x_token
+end
+
+@ @<Look for parameter number...@>=
+begin s:=cur_tok;
+if xpand then get_x_token else get_token;
+if cur_cmd<>mac_param then
+  if (cur_tok<=zero_token)or(cur_tok>t) then
+    begin print_err("Illegal parameter number in definition of ");
+@.Illegal parameter number...@>
+    sprint_cs(warning_index);
+    help3("You meant to type ## instead of #, right?")@/
+    ("Or maybe a } was forgotten somewhere earlier, and things")@/
+    ("are all screwed up? I'm going to assume that you meant ##.");
+    back_error; cur_tok:=s;
+    end
+  else cur_tok:=out_param_token-"0"+cur_chr;
+end
+
+@ Another way to create a token list is via the \.{\\read} command. The
+sixteen files potentially usable for reading appear in the following
+global variables. The value of |read_open[n]| will be |closed| if
+stream number |n| has not been opened or if it has been fully read;
+|just_open| if an \.{\\openin} but not a \.{\\read} has been done;
+and |normal| if it is open and ready to read the next line.
+
+@d closed=2 {not open, or at end of file}
+@d just_open=1 {newly opened, first line not yet read}
+
+@<Glob...@>=
+@!read_file:array[0..15] of alpha_file; {used for \.{\\read}}
+@!read_open:array[0..16] of normal..closed; {state of |read_file[n]|}
+
+@ @<Set init...@>=
+for k:=0 to 16 do begin 
+    read_open[k]:=closed;
+end;
+
+@ The |read_toks| procedure constructs a token list like that for any
+macro definition, and makes |cur_val| point to it. Parameter |r| points
+to the control sequence that will receive this token list.
+
+@p procedure read_toks(@!n:integer;@!r:pointer;@!j:halfword);
+label done;
+var p:pointer; {tail of the token list}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!s:integer; {saved value of |align_state|}
+@!m:small_number; {stream number}
+begin scanner_status:=defining; warning_index:=r;
+p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0;
+p:=def_ref; {the reference count}
+store_new_token(end_match_token);
+if (n<0)or(n>15) then m:=16@+else m:=n;
+s:=align_state; align_state:=1000000; {disable tab marks, etc.}
+repeat @<Input and store tokens from the next line of the file@>;
+until align_state=1000000;
+cur_val:=def_ref; scanner_status:=normal; align_state:=s;
+end;
+
+@ @<Input and store tokens from the next line of the file@>=
+begin_file_reading; name:=m+1;
+if read_open[m]=closed then @<Input for \.{\\read} from the terminal@>
+else if read_open[m]=just_open then @<Input the first line of |read_file[m]|@>
+else @<Input the next line of |read_file[m]|@>;
+limit:=last;
+if end_line_char_inactive then decr(limit)
+else  buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; state:=new_line;@/
+@<Handle \.{\\readline} and |goto done|@>;@/
+loop@+  begin get_token;
+  if cur_tok=0 then goto done;
+    {|cur_cmd=cur_chr=0| will occur at the end of the line}
+  if align_state<1000000 then {unmatched `\.\}' aborts the line}
+    begin repeat get_token; until cur_tok=0;
+    align_state:=1000000; goto done;
+    end;
+  store_new_token(cur_tok);
+  end;
+done: end_file_reading
+
+@ Here we input on-line into the |buffer| array, prompting the user explicitly
+if |n>=0|.  The value of |n| is set negative so that additional prompts
+will not be given in the case of multi-line input.
+
+@<Input for \.{\\read} from the terminal@>=
+if interaction>nonstop_mode then
+  if n<0 then prompt_input("")
+  else  begin wake_up_terminal;
+    print_ln; sprint_cs(r); prompt_input("="); n:=-1;
+    end
+else fatal_error("*** (cannot \read from terminal in nonstop modes)")
+@.cannot \\read@>
+
+@ The first line of a file must be treated specially, since |lua_input_ln|
+must be told not to start with |get|.
+@^system dependencies@>
+
+@<Input the first line of |read_file[m]|@>=
+begin if lua_input_ln(read_file[m],(m+1),false) then read_open[m]:=normal
+else  begin lua_a_close_in(read_file[m],(m+1)); read_open[m]:=closed;
+  end;
+end
+
+@ An empty line is appended at the end of a |read_file|.
+@^empty line at end of file@>
+
+@<Input the next line of |read_file[m]|@>=
+begin if not lua_input_ln(read_file[m],(m+1),true) then
+  begin lua_a_close_in(read_file[m],(m+1)); read_open[m]:=closed;
+  if align_state<>1000000 then
+    begin runaway;
+    print_err("File ended within "); print_esc("read");
+@.File ended within \\read@>
+    help1("This \read has unbalanced braces.");
+    align_state:=1000000; error;
+    end;
+  end;
+end
+
+@* \[28] Conditional processing.
+We consider now the way \TeX\ handles various kinds of \.{\\if} commands.
+
+@d unless_code=32 {amount added for `\.{\\unless}' prefix}
+@#
+@d if_char_code=0 { `\.{\\if}' }
+@d if_cat_code=1 { `\.{\\ifcat}' }
+@d if_int_code=2 { `\.{\\ifnum}' }
+@d if_dim_code=3 { `\.{\\ifdim}' }
+@d if_odd_code=4 { `\.{\\ifodd}' }
+@d if_vmode_code=5 { `\.{\\ifvmode}' }
+@d if_hmode_code=6 { `\.{\\ifhmode}' }
+@d if_mmode_code=7 { `\.{\\ifmmode}' }
+@d if_inner_code=8 { `\.{\\ifinner}' }
+@d if_void_code=9 { `\.{\\ifvoid}' }
+@d if_hbox_code=10 { `\.{\\ifhbox}' }
+@d if_vbox_code=11 { `\.{\\ifvbox}' }
+@d ifx_code=12 { `\.{\\ifx}' }
+@d if_eof_code=13 { `\.{\\ifeof}' }
+@d if_true_code=14 { `\.{\\iftrue}' }
+@d if_false_code=15 { `\.{\\iffalse}' }
+@d if_case_code=16 { `\.{\\ifcase}' }
+@d if_primitive_code=21 { `\.{\\ifprimitive}' }
+
+@<Put each...@>=
+primitive("if",if_test,if_char_code);
+@!@:if_char_}{\.{\\if} primitive@>
+primitive("ifcat",if_test,if_cat_code);
+@!@:if_cat_code_}{\.{\\ifcat} primitive@>
+primitive("ifnum",if_test,if_int_code);
+@!@:if_int_}{\.{\\ifnum} primitive@>
+primitive("ifdim",if_test,if_dim_code);
+@!@:if_dim_}{\.{\\ifdim} primitive@>
+primitive("ifodd",if_test,if_odd_code);
+@!@:if_odd_}{\.{\\ifodd} primitive@>
+primitive("ifvmode",if_test,if_vmode_code);
+@!@:if_vmode_}{\.{\\ifvmode} primitive@>
+primitive("ifhmode",if_test,if_hmode_code);
+@!@:if_hmode_}{\.{\\ifhmode} primitive@>
+primitive("ifmmode",if_test,if_mmode_code);
+@!@:if_mmode_}{\.{\\ifmmode} primitive@>
+primitive("ifinner",if_test,if_inner_code);
+@!@:if_inner_}{\.{\\ifinner} primitive@>
+primitive("ifvoid",if_test,if_void_code);
+@!@:if_void_}{\.{\\ifvoid} primitive@>
+primitive("ifhbox",if_test,if_hbox_code);
+@!@:if_hbox_}{\.{\\ifhbox} primitive@>
+primitive("ifvbox",if_test,if_vbox_code);
+@!@:if_vbox_}{\.{\\ifvbox} primitive@>
+primitive("ifx",if_test,ifx_code);
+@!@:ifx_}{\.{\\ifx} primitive@>
+primitive("ifeof",if_test,if_eof_code);
+@!@:if_eof_}{\.{\\ifeof} primitive@>
+primitive("iftrue",if_test,if_true_code);
+@!@:if_true_}{\.{\\iftrue} primitive@>
+primitive("iffalse",if_test,if_false_code);
+@!@:if_false_}{\.{\\iffalse} primitive@>
+primitive("ifcase",if_test,if_case_code);
+@!@:if_case_}{\.{\\ifcase} primitive@>
+primitive("ifprimitive",if_test,if_primitive_code);
+@!@:if_primitive_}{\.{\\ifprimitive} primitive@>
+primitive("ifpdfprimitive",if_test,if_primitive_code);
+@!@:if_primitive_}{\.{\\ifpdfprimitive} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+if_test: begin if chr_code>=unless_code then print_esc("unless");
+case chr_code mod unless_code of
+  if_cat_code:print_esc("ifcat");
+  if_int_code:print_esc("ifnum");
+  if_dim_code:print_esc("ifdim");
+  if_odd_code:print_esc("ifodd");
+  if_vmode_code:print_esc("ifvmode");
+  if_hmode_code:print_esc("ifhmode");
+  if_mmode_code:print_esc("ifmmode");
+  if_inner_code:print_esc("ifinner");
+  if_void_code:print_esc("ifvoid");
+  if_hbox_code:print_esc("ifhbox");
+  if_vbox_code:print_esc("ifvbox");
+  ifx_code:print_esc("ifx");
+  if_eof_code:print_esc("ifeof");
+  if_true_code:print_esc("iftrue");
+  if_false_code:print_esc("iffalse");
+  if_case_code:print_esc("ifcase");
+  if_primitive_code:print_esc("ifprimitive");
+  @/@<Cases of |if_test| for |print_cmd_chr|@>@/
+  othercases print_esc("if")
+  endcases;
+end;
+
+@ Conditions can be inside conditions, and this nesting has a stack
+that is independent of the |save_stack|.
+
+Four global variables represent the top of the condition stack:
+|cond_ptr| points to pushed-down entries, if any; |if_limit| specifies
+the largest code of a |fi_or_else| command that is syntactically legal;
+|cur_if| is the name of the current type of conditional; and |if_line|
+is the line number at which it began.
+
+If no conditions are currently in progress, the condition stack has the
+special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|.
+Otherwise |cond_ptr| points to a two-word node; the |type|, |subtype|, and
+|link| fields of the first word contain |if_limit|, |cur_if|, and
+|cond_ptr| at the next level, and the second word contains the
+corresponding |if_line|.
+
+@d if_node==49
+@d if_node_size=2 {number of words in stack entry for conditionals}
+@d if_limit_subtype(#)==subtype(#+1)
+@d if_limit_type(#)==type(#+1)
+@d if_line_field(#)==vlink(#+1)
+@d if_code=1 {code for \.{\\if...} being evaluated}
+@d fi_code=2 {code for \.{\\fi}}
+@d else_code=3 {code for \.{\\else}}
+@d or_code=4 {code for \.{\\or}}
+
+@<Glob...@>=
+@!cond_ptr:pointer; {top of the condition stack}
+@!if_limit:normal..or_code; {upper bound on |fi_or_else| codes}
+@!cur_if:small_number; {type of conditional being worked on}
+@!if_line:integer; {line where that conditional began}
+
+@ @<Set init...@>=
+cond_ptr:=null; if_limit:=normal; cur_if:=0; if_line:=0;
+
+@ @<Put each...@>=
+primitive("fi",fi_or_else,fi_code);
+@!@:fi_}{\.{\\fi} primitive@>
+text(frozen_fi):="fi"; eqtb[frozen_fi]:=eqtb[cur_val];
+primitive("or",fi_or_else,or_code);
+@!@:or_}{\.{\\or} primitive@>
+primitive("else",fi_or_else,else_code);
+@!@:else_}{\.{\\else} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+fi_or_else: if chr_code=fi_code then print_esc("fi")
+  else if chr_code=or_code then print_esc("or")
+  else print_esc("else");
+
+@ When we skip conditional text, we keep track of the line number
+where skipping began, for use in error messages.
+
+@<Glob...@>=
+@!skip_line:integer; {skipping began here}
+
+@ Here is a procedure that ignores text until coming to an \.{\\or},
+\.{\\else}, or \.{\\fi} at level zero of $\.{\\if}\ldots\.{\\fi}$
+nesting. After it has acted, |cur_chr| will indicate the token that
+was found, but |cur_tok| will not be set (because this makes the
+procedure run faster).
+
+@p procedure pass_text;
+label done;
+var l:integer; {level of $\.{\\if}\ldots\.{\\fi}$ nesting}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+begin save_scanner_status:=scanner_status; scanner_status:=skipping; l:=0;
+skip_line:=line;
+loop@+  begin get_filtered_next;
+  if cur_cmd=fi_or_else then
+    begin if l=0 then goto done;
+    if cur_chr=fi_code then decr(l);
+    end
+  else if cur_cmd=if_test then incr(l);
+  end;
+done: scanner_status:=save_scanner_status;
+if tracing_ifs>0 then show_cur_cmd_chr;
+end;
+
+@ When we begin to process a new \.{\\if}, we set |if_limit:=if_code|; then
+if\/ \.{\\or} or \.{\\else} or \.{\\fi} occurs before the current \.{\\if}
+condition has been evaluated, \.{\\relax} will be inserted.
+For example, a sequence of commands like `\.{\\ifvoid1\\else...\\fi}'
+would otherwise require something after the `\.1'.
+
+@<Push the condition stack@>=
+begin p:=new_node(if_node,0); vlink(p):=cond_ptr; 
+if_limit_type(p):=if_limit;
+if_limit_subtype(p):=cur_if; 
+if_line_field(p):=if_line;
+cond_ptr:=p; cur_if:=cur_chr; if_limit:=if_code; if_line:=line;
+end
+
+@ @<Pop the condition stack@>=
+begin if if_stack[in_open]=cond_ptr then if_warning;
+  {conditionals possibly not properly nested with files}
+p:=cond_ptr;
+if_line:=if_line_field(p);
+cur_if:=if_limit_subtype(p); 
+if_limit:=if_limit_type(p); 
+cond_ptr:=vlink(p);
+flush_node(p);
+end
+
+@ Here's a procedure that changes the |if_limit| code corresponding to
+a given value of |cond_ptr|.
+
+@p procedure change_if_limit(@!l:small_number;@!p:pointer);
+label exit;
+var q:pointer;
+begin if p=cond_ptr then if_limit:=l {that's the easy case}
+else  begin q:=cond_ptr;
+  loop@+  begin if q=null then confusion("if");
+@:this can't happen if}{\quad if@>
+    if vlink(q)=p then
+      begin if_limit_type(q):=l; return;
+      end;
+    q:=vlink(q);
+    end;
+  end;
+exit:end;
+
+@ A condition is started when the |expand| procedure encounters
+an |if_test| command; in that case |expand| reduces to |conditional|,
+which is a recursive procedure.
+@^recursion@>
+
+@p procedure conditional;
+label exit,common_ending;
+var b:boolean; {is the condition true?}
+@!r:"<"..">"; {relation to be evaluated}
+@!m,@!n,@!s:integer; {to be tested against the second operand}
+@!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!save_cond_ptr:pointer; {|cond_ptr| corresponding to this conditional}
+@!this_if:small_number; {type of this conditional}
+@!is_unless:boolean; {was this if preceded by `\.{\\unless}' ?}
+begin b:= false; {default is false, just in case}
+if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+@<Push the condition stack@>;@+save_cond_ptr:=cond_ptr;
+is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/
+@<Either process \.{\\ifcase} or set |b| to the value of a boolean condition@>;
+if is_unless then b:=not b;
+if tracing_commands>1 then @<Display the value of |b|@>;
+if b then
+  begin change_if_limit(else_code,save_cond_ptr);
+  return; {wait for \.{\\else} or \.{\\fi}}
+  end;
+@<Skip to \.{\\else} or \.{\\fi}, then |goto common_ending|@>;
+common_ending: if cur_chr=fi_code then @<Pop the condition stack@>
+else if_limit:=fi_code; {wait for \.{\\fi}}
+exit:end;
+
+@ In a construction like `\.{\\if\\iftrue abc\\else d\\fi}', the first
+\.{\\else} that we come to after learning that the \.{\\if} is false is
+not the \.{\\else} we're looking for. Hence the following curious
+logic is needed.
+
+@ @<Skip to \.{\\else} or \.{\\fi}...@>=
+loop@+  begin pass_text;
+  if cond_ptr=save_cond_ptr then
+    begin if cur_chr<>or_code then goto common_ending;
+    print_err("Extra "); print_esc("or");
+@.Extra \\or@>
+    help1("I'm ignoring this; it doesn't match any \if.");
+    error;
+    end
+  else if cur_chr=fi_code then @<Pop the condition stack@>;
+  end
+
+@ @<Either process \.{\\ifcase} or set |b|...@>=
+case this_if of
+if_char_code, if_cat_code: @<Test if two characters match@>;
+if_int_code, if_dim_code: @<Test relation between integers or dimensions@>;
+if_odd_code: @<Test if an integer is odd@>;
+if_vmode_code: b:=(abs(mode)=vmode);
+if_hmode_code: b:=(abs(mode)=hmode);
+if_mmode_code: b:=(abs(mode)=mmode);
+if_inner_code: b:=(mode<0);
+if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>;
+ifx_code: @<Test if two tokens match@>;
+if_eof_code: begin scan_four_bit_int; b:=(read_open[cur_val]=closed);
+  end;
+if_true_code: b:=true;
+if_false_code: b:=false;
+@/@<Cases for |conditional|@>@/
+if_case_code: @<Select the appropriate case
+  and |return| or |goto common_ending|@>;
+if_primitive_code: begin
+  save_scanner_status:=scanner_status;
+  scanner_status:=normal;
+  get_filtered_next;
+  scanner_status:=save_scanner_status;
+  m := prim_lookup(text(cur_cs));
+  b :=((cur_cmd<>undefined_cs) and
+       (m<>undefined_primitive) and
+       (cur_cmd=get_prim_eq_type(m)) and
+       (cur_chr=get_prim_equiv(m)));
+  end;
+{there are no other cases, but for -Wall: }
+othercases
+  b:=false;
+endcases
+
+@ @<Display the value of |b|@>=
+begin begin_diagnostic;
+if b then print("{true}")@+else print("{false}");
+end_diagnostic(false);
+end
+
+@ Here we use the fact that |"<"|, |"="|, and |">"| are consecutive ASCII
+codes.
+@^ASCII code@>
+
+@<Test relation between integers or dimensions@>=
+begin if this_if=if_int_code then scan_int@+else scan_normal_dimen;
+n:=cur_val; @<Get the next non-blank non-call...@>;
+if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
+  r:=cur_tok-other_token
+else  begin print_err("Missing = inserted for ");
+@.Missing = inserted@>
+  print_cmd_chr(if_test,this_if);
+  help1("I was expecting to see `<', `=', or `>'. Didn't.");
+  back_error; r:="=";
+  end;
+if this_if=if_int_code then scan_int@+else scan_normal_dimen;
+case r of
+"<": b:=(n<cur_val);
+"=": b:=(n=cur_val);
+">": b:=(n>cur_val);
+othercases b:=false; {can't happen}
+end;
+end
+
+@ @<Test if an integer is odd@>=
+begin scan_int; b:=odd(cur_val);
+end
+
+@ @<Test box register status@>=
+begin scan_register_num; p:=box(cur_val);
+if this_if=if_void_code then b:=(p=null)
+else if p=null then b:=false
+else if this_if=if_hbox_code then b:=(type(p)=hlist_node)
+else b:=(type(p)=vlist_node);
+end
+
+@ An active character will be treated as category 13 following
+\.{\\if\\noexpand} or following \.{\\ifcat\\noexpand}. We use the fact that
+active characters have the smallest tokens, among all control sequences.
+
+The |(biggest_char-number_active_chars)| part is needed because only the
+bottom two planes are present as active characters in |eqtb|.
+
+@d get_x_token_or_active_char==@t@>@;
+  begin get_x_token;
+  if cur_cmd=relax then if cur_chr=no_expand_flag then
+    begin cur_cmd:=active_char;
+    cur_chr:=cur_tok-cs_token_flag-active_base+(biggest_char-number_active_chars);
+    end;
+  end
+
+@<Test if two characters match@>=
+begin get_x_token_or_active_char;
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then {not a character}
+  begin m:=relax; n:=too_big_char;
+  end
+else  begin m:=cur_cmd; n:=cur_chr;
+  end;
+get_x_token_or_active_char;
+if (cur_cmd>active_char)or(cur_chr>biggest_char) then
+  begin cur_cmd:=relax; cur_chr:=too_big_char;
+  end;
+if this_if=if_char_code then b:=(n=cur_chr)@+else b:=(m=cur_cmd);
+end
+
+@ Note that `\.{\\ifx}' will declare two macros different if one is \\{long}
+or \\{outer} and the other isn't, even though the texts of the macros are
+the same.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Test if two tokens match@>=
+begin save_scanner_status:=scanner_status; scanner_status:=normal;
+get_filtered_next; n:=cur_cs; p:=cur_cmd; q:=cur_chr;
+get_filtered_next; if cur_cmd<>p then b:=false
+else if cur_cmd<call then b:=(cur_chr=q)
+else @<Test if two macro texts match@>;
+scanner_status:=save_scanner_status;
+end
+
+@ Note also that `\.{\\ifx}' decides that macros \.{\\a} and \.{\\b} are
+different in examples like this:
+$$\vbox{\halign{\.{#}\hfil&\qquad\.{#}\hfil\cr
+  {}\\def\\a\{\\c\}&
+  {}\\def\\c\{\}\cr
+  {}\\def\\b\{\\d\}&
+  {}\\def\\d\{\}\cr}}$$
+
+@<Test if two macro texts match@>=
+begin p:=link(cur_chr); q:=link(equiv(n)); {omit reference counts}
+if p=q then b:=true
+else begin while (p<>null)and(q<>null) do
+    if info(p)<>info(q) then p:=null
+    else  begin p:=link(p); q:=link(q);
+      end;
+  b:=((p=null)and(q=null));
+  end;
+end
+
+@ @<Select the appropriate case and |return| or |goto common_ending|@>=
+begin scan_int; n:=cur_val; {|n| is the number of cases to pass}
+if tracing_commands>1 then
+  begin begin_diagnostic; print("{case "); print_int(n); print_char("}");
+  end_diagnostic(false);
+  end;
+while n<>0 do
+  begin pass_text;
+  if cond_ptr=save_cond_ptr then
+    if cur_chr=or_code then decr(n)
+    else goto common_ending
+  else if cur_chr=fi_code then @<Pop the condition stack@>;
+  end;
+change_if_limit(or_code,save_cond_ptr);
+return; {wait for \.{\\or}, \.{\\else}, or \.{\\fi}}
+end
+
+@ The processing of conditionals is complete except for the following
+code, which is actually part of |expand|. It comes into play when
+\.{\\or}, \.{\\else}, or \.{\\fi} is scanned.
+
+@<Terminate the current conditional and skip to \.{\\fi}@>=
+begin if tracing_ifs>0 then if tracing_commands<=1 then show_cur_cmd_chr;
+if cur_chr>if_limit then
+  if if_limit=if_code then insert_relax {condition not yet evaluated}
+  else  begin print_err("Extra "); print_cmd_chr(fi_or_else,cur_chr);
+@.Extra \\or@>
+@.Extra \\else@>
+@.Extra \\fi@>
+    help1("I'm ignoring this; it doesn't match any \if.");
+    error;
+    end
+else  begin while cur_chr<>fi_code do pass_text; {skip to \.{\\fi}}
+  @<Pop the condition stack@>;
+  end;
+end
+
+@* \[29] File names.
+It's time now to fret about file names.  Besides the fact that different
+operating systems treat files in different ways, we must cope with the
+fact that completely different naming conventions are used by different
+groups of people. The following programs show what is required for one
+particular operating system; similar routines for other systems are not
+difficult to devise.
+@^fingers@>
+@^system dependencies@>
+
+\TeX\ assumes that a file name has three parts: the name proper; its
+``extension''; and a ``file area'' where it is found in an external file
+system.  The extension of an input file or a write file is assumed to be
+`\.{.tex}' unless otherwise specified; it is `\.{.log}' on the
+transcript file that records each run of \TeX; it is `\.{.tfm}' on the font
+metric files that describe characters in the fonts \TeX\ uses; it is
+`\.{.dvi}' on the output files that specify typesetting information; and it
+is `\.{.fmt}' on the format files written by \.{INITEX} to initialize \TeX.
+The file area can be arbitrary on input files, but files are usually
+output to the user's current area.  If an input file cannot be
+found on the specified area, \TeX\ will look for it on a special system
+area; this special area is intended for commonly used input files like
+\.{webmac.tex}.
+
+Simple uses of \TeX\ refer only to file names that have no explicit
+extension or area. For example, a person usually says `\.{\\input} \.{paper}'
+or `\.{\\font\\tenrm} \.= \.{helvetica}' instead of `\.{\\input}
+\.{paper.new}' or `\.{\\font\\tenrm} \.= \.{<csd.knuth>test}'. Simple file
+names are best, because they make the \TeX\ source files portable;
+whenever a file name consists entirely of letters and digits, it should be
+treated in the same way by all implementations of \TeX. However, users
+need the ability to refer to other files in their environment, especially
+when responding to error messages concerning unopenable files; therefore
+we want to let them use the syntax that appears in their favorite
+operating system.
+
+The following procedures don't allow spaces to be part of
+file names; but some users seem to like names that are spaced-out.
+System-dependent changes to allow such things should probably
+be made with reluctance, and only when an entire file name that
+includes spaces is ``quoted'' somehow.
+
+@ In order to isolate the system-dependent aspects of file names, the
+@^system dependencies@>
+system-independent parts of \TeX\ are expressed in terms
+of three system-dependent
+procedures called |begin_name|, |more_name|, and |end_name|. In
+essence, if the user-specified characters of the file name are $c_1\ldots c_n$,
+the system-independent driver program does the operations
+$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;|more_name|(c_n);
+\,|end_name|.$$
+These three procedures communicate with each other via global variables.
+Afterwards the file name will appear in the string pool as three strings
+called |cur_name|\penalty10000\hskip-.05em,
+|cur_area|, and |cur_ext|; the latter two are null (i.e.,
+|""|), unless they were explicitly specified by the user.
+
+Actually the situation is slightly more complicated, because \TeX\ needs
+to know when the file name ends. The |more_name| routine is a function
+(with side effects) that returns |true| on the calls |more_name|$(c_1)$,
+\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$
+returns |false|; or, it returns |true| and the token following $c_n$ is
+something like `\.{\\hbox}' (i.e., not a character). In other words,
+|more_name| is supposed to return |true| unless it is sure that the
+file name has been completely scanned; and |end_name| is supposed to be able
+to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of
+whether $|more_name|(c_n)$ returned |true| or |false|.
+
+@<Glob...@>=
+@!cur_name:str_number; {name of file just scanned}
+@!cur_area:str_number; {file area just scanned, or \.{""}}
+@!cur_ext:str_number; {file extension just scanned, or \.{""}}
+
+@ The file names we shall deal with for illustrative purposes have the
+following structure:  If the name contains `\.>' or `\.:', the file area
+consists of all characters up to and including the final such character;
+otherwise the file area is null.  If the remaining file name contains
+`\..', the file extension consists of all such characters from the first
+remaining `\..' to the end, otherwise the file extension is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+
+@ Input files that can't be found in the user's area may appear in a standard
+system area called |TEX_area|. Font metric files whose areas are not given
+explicitly are assumed to appear in a standard system area called
+|TEX_font_area|.  $\Omega$'s compiled translation process files whose areas
+are not given explicitly are assumed to appear in a standard system area
+called |OMEGA_ocp_area|.  These system area names will, of course, vary
+from place to place.
+@^system dependencies@>
+
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@d OMEGA_ocp_area=="OmegaOCPs:"
+@.OmegaOCPs@>
+
+@ Here now is the first of the system-dependent routines for file name scanning.
+@^system dependencies@>
+
+@p procedure begin_name;
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+
+@ And here's the second. The string pool might change as the file name is
+being scanned, since a new \.{\\csname} might be entered; therefore we keep
+|area_delimiter| and |ext_delimiter| relative to the beginning of the current
+string, instead of assigning an absolute address like |pool_ptr| to them.
+@^system dependencies@>
+
+@p function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else  begin str_room(1); append_char(c); {contribute |c| to the current string}
+  if (c=">")or(c=":") then
+    begin area_delimiter:=cur_length; ext_delimiter:=0;
+    end
+  else if (c=".")and(ext_delimiter=0) then ext_delimiter:=cur_length;
+  more_name:=true;
+  end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>(max_strings+string_offset) then
+  overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if area_delimiter=0 then cur_area:=""
+else  begin cur_area:=str_ptr;
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr);
+  end;
+if ext_delimiter=0 then
+  begin cur_ext:=""; cur_name:=make_string;
+  end
+else  begin cur_name:=str_ptr;
+  str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1;
+  incr(str_ptr); cur_ext:=make_string;
+  end;
+end;
+
+@ Conversely, here is a routine that takes three strings and prints a file
+name that might have produced them. (The routine is system dependent, because
+some operating systems put the file area last instead of first.)
+@^system dependencies@>
+
+@<Basic printing...@>=
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin slow_print(a); slow_print(n); slow_print(e);
+end;
+
+@ Another system-dependent routine is needed to convert three internal
+\TeX\ strings
+into the |nameoffile| value that is used to open files. The present code
+allows both lowercase and uppercase letters in the file name.
+@^system dependencies@>
+
+@d append_to_name(#)==begin c:=#; incr(k);
+  if k<=file_name_size then nameoffile[k]:=xchr[c];
+  end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |nameoffile|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j]));
+for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j]));
+if k<=file_name_size then namelength:=k@+else namelength:=file_name_size;
+for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
+end;
+
+@ A messier routine is also needed, since format file names must be scanned
+before \TeX's string mechanism has been initialized. We shall use the
+global variable |TEX_format_default| to supply the text for default system areas
+and extensions related to format files.
+@^system dependencies@>
+
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@d format_extension=".fmt" {the extension, as a \.{WEB} constant}
+
+@<Glob...@>=
+@!TEX_format_default:packed array[1..format_default_length] of char;
+
+@ @<Set init...@>=
+TEX_format_default:='TeXformats:plain.fmt';
+@.TeXformats@>
+@.plain@>
+@^system dependencies@>
+
+@ @<Check the ``constant'' values for consistency@>=
+if format_default_length>file_name_size then bad:=31;
+
+@ Here is the messy routine that was just mentioned. It sets |nameoffile|
+from the first |n| characters of |TEX_format_default|, followed by
+|buffer[a..b]|, followed by the last |format_ext_length| characters of
+|TEX_format_default|.
+
+We dare not give error messages here, since \TeX\ calls this routine before
+the |error| routine is ready to roll. Instead, we simply drop excess characters,
+since the error will be detected in another way when a strange file name
+isn't found.
+@^system dependencies@>
+
+@p procedure pack_buffered_name(@!n:integer;@!a,@!b:integer);
+var k:integer; {number of positions filled in |nameoffile|}
+@!c: ASCII_code; {character being packed}
+@!j:integer; {index into |buffer| or |TEX_format_default|}
+begin if n+b-a+1+format_ext_length>file_name_size then
+  b:=a+file_name_size-n-1-format_ext_length;
+k:=0;
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+for j:=a to b do append_to_name(buffer[j]);
+for j:=format_default_length-format_ext_length+1 to format_default_length do
+  append_to_name(TEX_format_default[j]);
+if k<=file_name_size then namelength:=k@+else namelength:=file_name_size;
+for k:=namelength+1 to file_name_size do nameoffile[k]:=' ';
+end;
+
+@ Here is the only place we use |pack_buffered_name|. This part of the program
+becomes active when a ``virgin'' \TeX\ is trying to get going, just after
+the preliminary initialization, or when the user is substituting another
+format file by typing `\.\&' after the initial `\.{**}' prompt.  The buffer
+contains the first line of input in |buffer[loc..(last-1)]|, where
+|loc<last| and |buffer[loc]<>" "|.
+
+@<Declare the function called |open_fmt_file|@>=
+function open_fmt_file:boolean;
+label found,exit;
+var j:0..buf_size; {the first space after the format file name}
+begin j:=loc;
+if buffer[loc]="&" then
+  begin incr(loc); j:=loc; buffer[last]:=" ";
+  while buffer[j]<>" " do incr(j);
+  pack_buffered_name(0,loc,j-1); {try first without the system file area}
+  if w_open_in(fmt_file) then goto found;
+  pack_buffered_name(format_area_length,loc,j-1);
+    {now try the system format file area}
+  if w_open_in(fmt_file) then goto found;
+  wake_up_terminal;
+  wterm_ln('Sorry, I can''t find that format;',' will try PLAIN.');
+@.Sorry, I can't find...@>
+  update_terminal;
+  end;
+  {now pull out all the stops: try for the system \.{plain} file}
+pack_buffered_name(format_default_length-format_ext_length,1,0);
+if not w_open_in(fmt_file) then
+  begin wake_up_terminal;
+  wterm_ln('I can''t find the PLAIN format file!');
+@.I can't find PLAIN...@>
+@.plain@>
+  open_fmt_file:=false; return;
+  end;
+found:loc:=j; open_fmt_file:=true;
+exit:end;
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \TeX\ string from the value of |nameoffile|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@d a_make_name_string(#)==make_name_string
+@d b_make_name_string(#)==make_name_string
+@d w_make_name_string(#)==make_name_string
+
+@p function make_name_string:str_number;
+var k:1..file_name_size; {index into |nameoffile|}
+begin if (pool_ptr+namelength>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+  make_name_string:="?"
+else  begin for k:=1 to namelength do append_char(nameoffile[k]);
+  make_name_string:=make_string;
+  end;
+end;
+
+@ Now let's consider the ``driver''
+routines by which \TeX\ deals with file names
+in a system-independent manner.  First comes a procedure that looks for a
+file name in the input by calling |get_x_token| for the information.
+
+@p procedure scan_file_name;
+label done;
+begin name_in_progress:=true; begin_name;
+@<Get the next non-blank non-call...@>;
+loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then {not a character}
+    begin back_input; goto done;
+    end;
+  if not more_name(cur_chr) then goto done;
+  get_x_token;
+  end;
+done: end_name; name_in_progress:=false;
+end;
+
+@ The global variable |name_in_progress| is used to prevent recursive
+use of |scan_file_name|, since the |begin_name| and other procedures
+communicate via global variables. Recursion would arise only by
+devious tricks like `\.{\\input\\input f}'; such attempts at sabotage
+must be thwarted. Furthermore, |name_in_progress| prevents \.{\\input}
+@^recursion@>
+from being initiated when a font size specification is being scanned.
+
+Another global variable, |job_name|, contains the file name that was first
+\.{\\input} by the user. This name is extended by `\.{.log}' and `\.{.dvi}'
+and `\.{.fmt}' in the names of \TeX's output files.
+
+@<Glob...@>=
+@!name_in_progress:boolean; {is a file name being scanned?}
+@!job_name:str_number; {principal file name}
+@!log_opened:boolean; {has the transcript file been opened?}
+
+@ Initially |job_name=0|; it becomes nonzero as soon as the true name is known.
+We have |job_name=0| if and only if the `\.{log}' file has not been opened,
+except of course for a short time just after |job_name| has become nonzero.
+
+@<Initialize the output...@>=
+job_name:=0; name_in_progress:=false; log_opened:=false;
+
+@ Here is a routine that manufactures the output file names, assuming that
+|job_name<>0|. It ignores and changes the current settings of |cur_area|
+and |cur_ext|.
+
+@d pack_cur_name==pack_file_name(cur_name,cur_area,cur_ext)
+
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
+  |format_extension|}
+begin cur_area:=""; cur_ext:=s;
+cur_name:=job_name; pack_cur_name;
+end;
+
+@ If some trouble arises when \TeX\ tries to open a file, the following
+routine calls upon the user to supply another file name. Parameter~|s|
+is used in the error message to identify the type of file; parameter~|e|
+is the default extension if none is given. Upon exit from the routine,
+variables |cur_name|, |cur_area|, |cur_ext|, and |nameoffile| are
+ready for another attempt at file opening.
+
+@p procedure prompt_file_name(@!s,@!e:str_number);
+label done;
+var k:0..buf_size; {index into |buffer|}
+begin if interaction=scroll_mode then wake_up_terminal;
+if s="input file name" then print_err("I can't find file `")
+@.I can't find file x@>
+else print_err("I can't write on file `");
+@.I can't write on file x@>
+print_file_name(cur_name,cur_area,cur_ext); print("'.");
+if e=".tex" then show_context;
+print_nl("Please type another "); print(s);
+@.Please type...@>
+if interaction<scroll_mode then
+  fatal_error("*** (job aborted, file error in nonstop mode)");
+@.job aborted, file error...@>
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+pack_cur_name;
+end;
+
+@ @<Scan file name in the buffer@>=
+begin begin_name; k:=first;
+while (buffer[k]=" ")and(k<last) do incr(k);
+loop@+  begin if k=last then goto done;
+  if not more_name(buffer[k]) then goto done;
+  incr(k);
+  end;
+done:end_name;
+end
+
+@ Here's an example of how these conventions are used. Whenever it is time to
+ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
+
+@d ensure_dvi_open==if output_file_name=0 then
+  begin if job_name=0 then open_log_file;
+  pack_job_name(".dvi");
+  while not lua_b_open_out(dvi_file) do
+    prompt_file_name("file name for output",".dvi");
+  dvi_file:=name_file_pointer	;
+  output_file_name:=b_make_name_string(dvi_file);
+  end
+
+@<Glob...@>=
+@!dvi_file: byte_file; {the device-independent output goes here}
+@!output_file_name: str_number; {full name of the output file}
+@!log_name:str_number; {full name of the log file}
+
+@ @<Initialize the output...@>=output_file_name:=0;
+
+@ The |open_log_file| routine is used to open the transcript file and to help
+it catch up to what has previously been printed on the terminal.
+
+@p procedure open_log_file;
+var old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@.texput@>
+pack_job_name(".log");
+while not lua_a_open_out(addressof(log_file),0) do @<Try to get a different log file name@>;
+log_file := name_file_pointer;
+log_name:=a_make_name_string(log_file);
+selector:=log_only; log_opened:=true;
+if not callback_defined(start_run_callback) then begin
+  @<Print the banner line, including the date and time@>;
+  input_stack[input_ptr]:=cur_input; {make sure bottom level is in memory}
+  print_nl("**");
+@.**@>
+  l:=input_stack[0].limit_field; {last position of first line}
+  if buffer[l]=end_line_char then decr(l); { TODO: multichar endlinechar}
+  for k:=1 to l do print(buffer[k]);
+  print_ln; {now the transcript file contains the first line of input}
+  end
+else begin
+  flush_loggable_info;
+end;
+selector:=old_setting+2; {|log_only| or |term_and_log|}
+end;
+
+@ Sometimes |open_log_file| is called at awkward moments when \TeX\ is
+unable to print error messages or even to |show_context|.
+The |prompt_file_name| routine can result in a |fatal_error|, but the |error|
+routine will not be invoked because |log_opened| will be false.
+
+The normal idea of |batch_mode| is that nothing at all should be written
+on the terminal. However, in the unusual case that
+no log file could be opened, we make an exception and allow
+an explanatory message to be seen.
+
+Incidentally, the program always refers to the log file as a `\.{transcript
+file}', because some systems cannot use the extension `\.{.log}' for
+this file.
+
+@<Try to get a different log file name@>=
+begin selector:=term_only;
+prompt_file_name("transcript file name",".log");
+end
+
+@ @<Print the banner...@>=
+begin wlog(banner);
+slow_print(format_ident); print("  ");
+print_int(day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*month-2 to 3*month do wlog(months[k]);
+print_char(" "); print_int(year); print_char(" ");
+print_two(time div 60); print_char(":"); print_two(time mod 60);
+end
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{\\input}' command is being processed.
+
+@p procedure start_input; {\TeX\ will \.{\\input} something}
+label done;
+var temp_str:str_number;
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+  begin begin_file_reading; {set up |cur_file| and new level of input}
+  if lua_a_open_in(cur_file,0) then goto done;
+  end_file_reading; {remove the level that didn't work}
+  prompt_file_name("input file name",".tex");
+  end;
+done: 
+cur_file := name_file_pointer;
+name:=a_make_name_string(cur_file);
+if job_name=0 then
+  begin job_name:=cur_name; open_log_file;
+  end; {|open_log_file| doesn't |show_context|, so |limit|
+    and |loc| needn't be set to meaningful values yet}
+if tracefilenames then begin
+  if term_offset+length(name)>max_print_line-2 then print_ln
+  else if (term_offset>0)or(file_offset>0) then print_char(" ");
+  print_char("("); 
+  slow_print(name); 
+end;
+incr(open_parens); 
+update_terminal;
+state:=new_line;
+if name=str_ptr-1 then {we can conserve string pool space now}
+  begin flush_string; name:=cur_name;
+  end;
+@<Read the first line of the new file@>;
+end;
+
+@ Here we have to remember to tell the |lua_input_ln| routine not to
+start with a |get|. If the file is empty, it is considered to
+contain a single blank line.
+@^system dependencies@>
+@^empty line at end of file@>
+
+@<Read the first line...@>=
+begin line:=1;
+if lua_input_ln(cur_file,0,false) then do_nothing;
+firm_up_the_line;
+if end_line_char_inactive then decr(limit)
+else  buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start;
+end
+
+@* \[30] Font metric data and OCPS.
+\TeX\ gets its knowledge about fonts from font metric files, also called
+\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX,
+but other programs know about them too.
+@:TFM files}{\.{TFM} files@>
+@^font metric files@>
+
+@ When the user defines \.{\\font\\f}, say, \TeX\ assigns an internal number
+to the user's font~\.{\\f}. Adding this number to |font_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the font.
+
+@<Types...@>=
+@!internal_font_number=integer; {|font| in a |char_node|}
+@!font_index=integer; {index into |font_info|}
+
+@ @<Glob...@>=
+@!font_bytes:integer;
+
+@ \TeX\ always knows at least one font, namely the null font. It has no
+characters, and its seven parameters are all equal to zero.
+
+@<Initialize table...@>=
+create_null_font;
+font_bytes:=0;
+
+@ @<Put each...@>=
+primitive("nullfont",set_font,null_font);
+@!@:null_font_}{\.{\\nullfont} primitive@>
+text(frozen_null_font):="nullfont"; eqtb[frozen_null_font]:=eqtb[cur_val];
+
+@ @<The em width for |cur_font|@>=quad(cur_font)
+
+@ @<The x-height for |cur_font|@>=x_height(cur_font)
+
+@ Before we forget about the format of these tables, let's deal with two
+of \TeX's basic scanning routines related to font information.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure scan_font_ident;
+var f:internal_font_number;
+@!m:halfword;
+begin @<Get the next non-blank non-call...@>;
+if (cur_cmd=def_font) or (cur_cmd=letterspace_font) then f:=cur_font
+else if cur_cmd=set_font then begin 
+  f:=cur_chr; 
+  set_font_touched(f,1);
+  end
+else if cur_cmd=def_family then begin 
+  m:=cur_chr; scan_math_family_int; f:=equiv(m+cur_val);
+  set_font_touched(f,1);
+  end
+else  begin print_err("Missing font identifier");
+@.Missing font identifier@>
+  help2("I was looking for a control sequence whose")@/
+  ("current meaning has been defined by \font.");
+  back_error; f:=null_font;
+  end;
+cur_val:=f;
+end;
+
+@ The following routine is used to implement `\.{\\fontdimen} |n| |f|'.
+The boolean parameter |writing| is set |true| if the calling program
+intends to change the parameter value.
+
+@<Declare procedures that scan font-related stuff@>=
+procedure set_font_dimen;forward;
+procedure get_font_dimen;forward;
+
+@ @p
+procedure set_font_dimen;
+label exit;
+var f:internal_font_number;
+@!n:integer; {the parameter number}
+begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
+  if n<=0 then
+    @<Issue a font parameter error message, and return@>
+  else begin
+    if n>font_params(f) then
+      if font_touched(f) then @<Issue a font parameter error message, and return@>
+      else @<Increase the number of parameters in the font@>;
+    end;
+  scan_optional_equals; scan_normal_dimen;
+  set_font_param(f,n,cur_val);
+exit:
+end;
+@#
+procedure get_font_dimen;
+label exit;
+var f:internal_font_number;
+@!n:integer; {the parameter number}
+begin scan_int; n:=cur_val; scan_font_ident; f:=cur_val;
+  cur_val:=0; { initialize return value }
+  if n<=0 then 
+    @<Issue a font parameter error message, and return@>
+  else begin
+    if n>font_params(f) then
+      if font_touched(f) then @<Issue a font parameter error message, and return@>
+      else @<Increase the number of parameters in the font@>;
+    end;
+  cur_val:=font_param(f,n);
+exit:
+  scanned_result(cur_val)(dimen_val);
+end;
+
+@ @<Issue a font parameter error message, and return@>=
+begin print_err("Font "); print_esc(font_id_text(f));
+  print(" has only "); print_int(font_params(f));
+  print(" fontdimen parameters");
+@.Font x has only...@>
+  help2("To increase the number of font parameters, you must")@/
+    ("use \fontdimen immediately after the \font is loaded.");
+  error;
+  return;
+end
+
+@ @<Increase the number of parameters...@>=
+begin repeat
+  set_font_param(f,(font_params(f)+1),0);
+until n=font_params(f);
+end
+
+
+@ When \TeX\ wants to typeset a character that doesn't exist, the
+character node is not created; thus the output routine can assume
+that characters exist when it sees them. The following procedure
+prints a warning message unless the user has suppressed it.
+
+@p procedure char_warning(@!f:internal_font_number;@!c:integer);
+var old_setting: integer; {saved value of |tracing_online|}
+begin if tracing_lost_chars>0 then
+ begin old_setting:=tracing_online;
+ if tracing_lost_chars>1 then tracing_online:=1;
+  begin begin_diagnostic;
+  print_nl("Missing character: There is no ");
+@.Missing character@>
+  print(c); print(" (");
+  print_int(c); print(") in font "); 
+  print_font_name(f);
+  print_char("!"); end_diagnostic(false);
+  end;
+ tracing_online:=old_setting;
+ end;
+end;
+
+@
+@<Types...@>=
+@!active_index=0..active_mem_size;
+
+@
+@d active_ocp(#)==active_info[#].hh.b0
+@d active_counter(#)==active_info[#].hh.b1
+@d active_lstack_no(#)==active_info[#+1].sc
+
+@<Glob...@>=
+@!active_info:array[active_index] of memory_word;
+@!active_min_ptr:active_index; {first unused word of |active_info|}
+@!active_max_ptr:active_index; {last unused word of |active_info|}
+@!active_real:active_index;
+@!holding:array[active_index] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+active_min_ptr:=0;
+active_real:=0;
+
+@
+@p
+function is_last_ocp(llstack_no:scaled; counter:integer):integer;
+begin
+active_min_ptr:=equiv(ocp_active_min_ptr_base);
+active_max_ptr:=equiv(ocp_active_max_ptr_base);
+active_real:=active_min_ptr;
+while (active_real < active_max_ptr) and
+      (active_lstack_no(active_real) < llstack_no) do begin
+  active_real:=active_real+2;
+  end;
+while (active_real < active_max_ptr) and
+      (active_lstack_no(active_real) = llstack_no) and
+      (active_counter(active_real) <= counter) do begin
+  active_real:=active_real+2;
+  end;
+is_last_ocp := (active_real=active_max_ptr);
+end;
+
+procedure print_active_ocps;
+var i:integer;
+begin
+print_nl("Active ocps: [");
+i:=active_min_ptr;
+while i<active_max_ptr do begin
+  print("(");
+  print_scaled(active_lstack_no(i));
+  print(",");
+  print_int(active_counter(i));
+  print(",");
+  print_esc(ocp_id_text(active_ocp(i)));
+  print(")");
+  if i<>(active_max_ptr-2) then print(",");
+  i:=i+2;
+  end;
+print("]");
+end;
+
+procedure add_ocp_stack(min_index:integer; min_value:scaled);
+var p:ocp_lstack_index;
+    llstack_no:scaled;
+    counter:integer;
+	m:scaled;
+begin
+m:=min_value; { TH: whatever this is ..}
+p:=ocp_list_lstack(holding[min_index]);
+llstack_no:=ocp_list_lstack_no(holding[min_index]);
+counter:=0;
+while not (is_null_ocp_lstack(p)) do begin
+  active_ocp(active_max_ptr):=ocp_lstack_ocp(p);
+  active_counter(active_max_ptr):=counter;
+  active_lstack_no(active_max_ptr):=llstack_no;
+  p:=ocp_lstack_lnext(p);
+  active_max_ptr:=active_max_ptr+2;
+  incr(counter);  {no overflow problem}
+  end;
+end;
+
+procedure active_compile;
+var i:integer;
+    min_index:integer;
+    min_stack_ocp:scaled;
+    old_min:scaled;
+    max_active:integer;
+    stack_value:scaled;
+begin
+active_min_ptr:=active_max_ptr;
+min_stack_ocp:=ocp_maxint;
+max_active:=equiv(ocp_active_number_base)-1;
+min_index:=max_active; {TH I hope ... }
+for i:=max_active downto 0 do begin
+  holding[i]:=ocp_list_list[equiv(ocp_active_base+i)];
+  stack_value:=ocp_list_lstack_no(holding[i]);
+  if stack_value<min_stack_ocp then begin
+    min_index:=i;
+    min_stack_ocp:=stack_value;
+    end;
+  end;
+while min_stack_ocp<ocp_maxint do begin
+  add_ocp_stack(min_index, min_stack_ocp);
+  old_min:=min_stack_ocp;
+  min_stack_ocp:=ocp_maxint;
+  for i:=max_active downto 0 do begin
+    stack_value:=ocp_list_lstack_no(holding[i]);
+    while old_min=stack_value do begin
+      holding[i]:=ocp_list_lnext(holding[i]);
+      stack_value:=ocp_list_lstack_no(holding[i]);
+      end;
+    if stack_value<min_stack_ocp then begin
+      min_index:=i;
+      min_stack_ocp:=stack_value;
+      end;
+    end;
+  end;
+end;
+
+@ Here we begin the \.{OCP} file handling.
+
+@<Glob...@>=
+@!ocp_file:byte_file;
+
+@ So that is what \.{OCP} files hold.
+
+When the user defines \.{\\ocp\\f}, say, \TeX\ assigns an internal number
+to the user's ocp~\.{\\f}. Adding this number to |ocp_id_base| gives the
+|eqtb| location of a ``frozen'' control sequence that will always select
+the ocp.
+
+@<Types...@>=
+@!internal_ocp_number=ocp_base..ocp_biggest;
+@!ocp_index=integer;
+
+@ Here now is the array of ocp arrays.
+
+@<Glob...@>=
+@!ocp_ptr:internal_ocp_number; {largest internal ocp number in use}
+@!ocp_buffer:^real_eight_bits; {byte buffer for ocp files}
+@!ocp_size:integer; {total size of the ocp file}
+@!ocp_cur:integer; {index into |ocp_buffer|}
+
+@ @<Set init...@>=
+ocp_buffer:=0; ocp_size:=0; ocp_cur:=0;
+
+@ Besides the arrays just enumerated, we have two directory arrays that
+make it easy to get at the individual entries in |ocp_info|.
+The beginning of the info for the |j|-th state in the |i|-th ocp is at
+location |ocp_info[ocp_state_base[i]+j]| and the |k|-th entry is in
+location |ocp_info[ocp_info[ocp_state_base[i]+j]+k]|.
+(These formulas assume that |min_quarterword| has already been 
+added to |i|, |j| and |k|, since $\Omega$ stores its quarterwords that way.)
+
+@d ocp_info_end(#)==#]
+@d ocp_info(#)==ocp_tables[#,ocp_info_end
+@d offset_ocp_file_size=0
+@d offset_ocp_name=1
+@d offset_ocp_area=offset_ocp_name+1
+@d offset_ocp_external=offset_ocp_area+1
+@d offset_ocp_external_arg=offset_ocp_external+1
+@d offset_ocp_input=offset_ocp_external_arg+1
+@d offset_ocp_output=offset_ocp_input+1
+@d offset_ocp_no_tables=offset_ocp_output+1
+@d offset_ocp_no_states=offset_ocp_no_tables+1
+@d offset_ocp_table_base=offset_ocp_no_states+1
+@d offset_ocp_state_base=offset_ocp_table_base+1
+@d offset_ocp_info=offset_ocp_state_base+1
+@d ocp_file_size(#)==ocp_info(#)(offset_ocp_file_size)
+@d ocp_name(#)==ocp_info(#)(offset_ocp_name)
+@d ocp_area(#)==ocp_info(#)(offset_ocp_area)
+@d ocp_external(#)==ocp_info(#)(offset_ocp_external)
+@d ocp_external_arg(#)==ocp_info(#)(offset_ocp_external_arg)
+@d ocp_input(#)==ocp_info(#)(offset_ocp_input)
+@d ocp_output(#)==ocp_info(#)(offset_ocp_output)
+@d ocp_no_tables(#)==ocp_info(#)(offset_ocp_no_tables)
+@d ocp_no_states(#)==ocp_info(#)(offset_ocp_no_states)
+@d ocp_table_base(#)==ocp_info(#)(offset_ocp_table_base)
+@d ocp_state_base(#)==ocp_info(#)(offset_ocp_state_base)
+
+@ $\Omega$ always knows at least one ocp, namely the null ocp.
+It does nothing.
+
+@<Initialize table...@>=
+ocp_ptr:=null_ocp; 
+allocate_ocp_table(null_ocp,17);
+ocp_file_size(null_ocp):=17;
+ocp_name(null_ocp):="nullocp"; ocp_area(null_ocp):="";
+ocp_external(null_ocp):=0; ocp_external_arg(null_ocp):=0;
+ocp_input(null_ocp):=1; ocp_output(null_ocp):=1;
+ocp_no_tables(null_ocp):=0;
+ocp_no_states(null_ocp):=1;
+ocp_table_base(f):=offset_ocp_info;
+ocp_state_base(f):=offset_ocp_info;
+ocp_info(null_ocp)(offset_ocp_info) := offset_ocp_info+2;  {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+1) := offset_ocp_info+5;  {number of entries}
+ocp_info(null_ocp)(offset_ocp_info+2) := 23;  {|OTP_LEFT_START|}
+ocp_info(null_ocp)(offset_ocp_info+3) := 3;  {|OTP_RIGHT_CHAR|}
+ocp_info(null_ocp)(offset_ocp_info+4) := 36;  {|OTP_STOP|}
+
+
+@ @<Put each...@>=
+primitive("nullocp", set_ocp, null_ocp);
+text(frozen_null_ocp) := "nullocp";
+eqtb[frozen_null_ocp] := eqtb[cur_val];
+geq_define(ocp_active_number_base, data, 0);
+geq_define(ocp_active_min_ptr_base, data, 0);
+geq_define(ocp_active_max_ptr_base, data, 0);
+
+@ Of course we want to define macros that suppress the detail of how ocp
+information is actually packed, so that we don't have to write things like
+$$\hbox{|ocp_info[k+ocp_info[j+ocp_state_base[i]]]|}$$
+too often. The \.{WEB} definitions here make |ocp_state_entry(i)(j)(k)| 
+(|ocp_table_entry(i)(j)(k)|) the |k|-th word in the |j|-th state (table)
+of the |i|-th ocp.
+@^inner loop@>
+
+@d ocp_state_end(#)==#]
+@d ocp_state_one(#)==#*2]+ocp_state_end
+@d ocp_state_entry(#)==ocp_tables[#,ocp_tables[#,ocp_state_base(#)+ocp_state_one
+
+@d ocp_state_no_end(#)==#*2+1]
+@d ocp_state_no(#)==ocp_tables[#,ocp_state_base(#)+ocp_state_no_end
+
+@d ocp_table_end(#)==#]
+@d ocp_table_one(#)==#*2]+ocp_table_end
+@d ocp_table_entry(#)==ocp_tables[#,ocp_tables[#,ocp_table_base(#)+ocp_table_one
+
+@d ocp_table_no_end(#)==#*2+1]
+@d ocp_table_no(#)==ocp_tables[#,ocp_table_base(#)+ocp_table_no_end
+
+@ $\Omega$ checks the information of a \.{OCP} file for validity as the
+file is being read in, so that no further checks will be needed when
+typesetting is going on. The somewhat tedious subroutine that does this
+is called |read_ocp_info|. It has three parameters: the user ocp
+identifier~|u|, and the file name and area strings |nom| and |aire|.
+
+The subroutine opens and closes a global file variable called |ocp_file|.
+It returns the value of the internal ocp number that was just loaded.
+If an error is detected, an error message is issued and no ocp
+information is stored; |null_ocp| is returned in this case.
+
+@d bad_ocp=11 {label for |read_ocp_info|}
+@d ocp_abort(#)==begin print("OCP file error (");
+ print(#); print(")"); print_ln; goto bad_ocp end
+ {do this when the \.{OCP} data is wrong}
+
+@p function read_ocp_info(@!u:pointer;@!nom,@!aire,@!ext:str_number;
+                          @!external_ocp:boolean)
+  :internal_ocp_number; {input a \.{OCP} file}
+label done,bad_ocp,not_found;
+var 
+@!file_opened:boolean; {was |ocp_file| successfully opened?}
+@!k:integer;
+@!res:boolean;
+@!callback_id:integer;
+@!fnam:str_number;
+@!f:internal_ocp_number; {the new ocp's number}
+@!g:internal_ocp_number; {the number to return}
+@!ocpword:integer;
+@!ocpmem_run_ptr:ocp_index;
+@!ocp_length,real_ocp_length:integer; {length of ocp file}
+@!previous_address:ocp_index;
+@!temp_ocp_input:integer;
+@!temp_ocp_output:integer;
+@!temp_ocp_no_tables:integer;
+@!temp_ocp_no_states:integer;
+@!i,new_offset,room_for_tables,room_for_states:integer;
+begin g:=null_ocp; f:=null_ocp;@/ 
+@<Read and check the ocp data; |ocp_abort| if the \.{OCP} file is
+  malformed; if there's no room for this ocp, say so and |goto
+  done|; otherwise |incr(ocp_ptr)| and |goto done|@>;
+bad_ocp: @<Report that the ocp won't be loaded@>;
+done: 
+ocp_name(f):=nom; ocp_area(f):=aire;
+read_ocp_info:=g;
+end;
+
+@ $\Omega$ does not give precise details about why it
+rejects a particular \.{OCP} file.
+
+@d start_ocp_error_message==print_err("Translation process "); 
+   sprint_cs(u); print_char("="); print_file_name(nom,aire,"");
+
+@<Report that the ocp won't be loaded@>=
+start_ocp_error_message;
+@.Translation process x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad ocp file")
+else print(" not loadable: ocp file not found");
+help2("I wasn't able to read the data for this ocp,")@/
+("so I will ignore the ocp specification.");
+error
+
+@ @<Read and check the ocp data...@>=
+if external_ocp then 
+  @<Check |ocp_file| exists@>
+else begin
+  @<Open |ocp_file| for input@>;
+  @<Read the {\.{OCP}} file@>;
+  end;
+
+@ @<Check |ocp_file| exists@>=
+begin
+file_opened:=false;
+pack_file_name(nom,aire,ext);
+b_test_in;
+if namelength=0 then ocp_abort("opening file");
+f :=ocp_ptr+1;
+allocate_ocp_table(f,13);
+ocp_file_size(f):=13;
+for i:=1 to namelength do begin
+  append_char(nameoffile[i]);
+  end;
+ocp_external(f):=make_string;
+scan_string_argument;
+ocp_external_arg(f):=cur_val;
+ocp_name(f):=""; ocp_area(f):="";
+ocp_state_base(f):=0; ocp_table_base(f):=0;
+ocp_input(f):=1; ocp_output(f):=1;
+ocp_info(f)(offset_ocp_info):=0;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ @<Open |ocp_file| for input@>=
+file_opened:=false;
+pack_file_name(nom,aire,".ocp");
+if ocp_buffer<>0 then libcfree(ocp_buffer);
+ocp_cur:=0; ocp_buffer:=0; ocp_size:=0;
+callback_id:=callback_defined(find_ocp_file_callback);
+if callback_id>0 then begin
+  res := run_callback(callback_id,'S->s',stringcast(nameoffile+1), addressof(fnam));
+  if (res)and(fnam<>0)and(length(fnam)>0) then begin
+    @<Fixup |nameoffile| after callback@>;
+    end;
+  end;
+callback_id:=callback_defined(read_ocp_file_callback);
+if callback_id>0 then begin
+  res := run_callback(callback_id,'S->bSd',stringcast(nameoffile+1),
+          addressof(file_opened), addressof(ocp_buffer),addressof(ocp_size));
+  if not res         then ocp_abort("callback error");
+  if not file_opened then ocp_abort("opening file");
+  if not ocp_size    then ocp_abort("checking size");
+  end
+else begin
+  if not ocp_open_in(ocp_file) then ocp_abort("opening file");
+  file_opened:=true;
+  res := read_ocp_file(ocp_file,addressof(ocp_buffer),addressof(ocp_size));
+  b_close(ocp_file);
+  if not ocp_size then ocp_abort("checking size");
+  if not res      then ocp_abort("reading file");
+end
+
+
+@ Note: A malformed \.{OCP} file might be shorter than it claims to be;
+thus |eof(ocp_file)| might be true when |read_ocp_info| refers to
+|ocp_file^| or when it says |get(ocp_file)|. If such circumstances
+cause system error messages, you will have to defeat them somehow,
+for example by defining |ocpget| to be `\ignorespaces|begin get(ocp_file);|
+|if eof(ocp_file) then ocp_abort; end|\unskip'.
+@^system dependencies@>
+
+@d add_to_ocp_info(#)==begin ocp_tables[f,ocpmem_run_ptr]:=#;
+  incr(ocpmem_run_ptr);
+  end
+@d ocpget==incr(ocp_cur)
+@d ocpbyte==ocp_buffer[ocp_cur]
+@d ocp_read(#)==begin ocpword:=ocpbyte;
+  if ocpword>127 then ocp_abort("checking first octet");
+  ocpget; ocpword:=ocpword*@'400+ocpbyte;
+  ocpget; ocpword:=ocpword*@'400+ocpbyte;
+  ocpget; ocpword:=ocpword*@'400+ocpbyte;
+  #:=ocpword;
+  end
+@d ocp_read_all(#)==begin ocpget; ocp_read(#); end
+@d ocp_read_info==begin ocp_read_all(ocpword);
+  add_to_ocp_info(ocpword);
+  end
+
+@ @<Read the {\.{OCP}} file@>=
+begin
+f :=ocp_ptr+1;
+ocpmem_run_ptr:=offset_ocp_info;
+ocp_read(ocp_length);
+real_ocp_length:=ocp_length-7;
+ocp_read_all(temp_ocp_input);
+ocp_read_all(temp_ocp_output);
+ocp_read_all(temp_ocp_no_tables);
+ocp_read_all(room_for_tables);
+ocp_read_all(temp_ocp_no_states);
+ocp_read_all(room_for_states);
+if real_ocp_length <>
+   (temp_ocp_no_tables + room_for_tables +
+    temp_ocp_no_states + room_for_states) then
+  ocp_abort("checking size");
+real_ocp_length:=real_ocp_length+12+
+   temp_ocp_no_states+temp_ocp_no_tables;
+allocate_ocp_table(f,real_ocp_length);
+ocp_external(f):=0;
+ocp_external_arg(f):=0;
+ocp_file_size(f):=real_ocp_length;
+ocp_input(f):=temp_ocp_input;
+ocp_output(f):=temp_ocp_output;
+ocp_no_tables(f):=temp_ocp_no_tables;
+ocp_no_states(f):=temp_ocp_no_states;
+ocp_table_base(f):=ocpmem_run_ptr;
+if ocp_no_tables(f) <> 0 then begin
+  previous_address:=ocpmem_run_ptr+2*(ocp_no_tables(f));
+  for i:=1 to ocp_no_tables(f) do begin
+    add_to_ocp_info(previous_address);
+    ocp_read_all(new_offset);
+    add_to_ocp_info(new_offset);
+    previous_address:=previous_address+new_offset;
+    end
+  end;
+if room_for_tables <> 0 then begin
+  for i:=1 to room_for_tables do begin
+    ocp_read_info;
+    end
+  end;
+ocp_state_base(f):=ocpmem_run_ptr;
+if ocp_no_states(f) <> 0 then begin
+  previous_address:=ocpmem_run_ptr+2*(ocp_no_states(f));
+  for i:=1 to ocp_no_states(f) do begin
+    add_to_ocp_info(previous_address);
+    ocp_read_all(new_offset);
+    add_to_ocp_info(new_offset);
+    previous_address:=previous_address+new_offset;
+    end;
+  end;
+if room_for_states <> 0 then begin
+  for i:=1 to room_for_states do begin
+    ocp_read_info;
+    end
+  end;
+ocp_ptr:=f; g:=f;
+goto done;
+end
+
+@ Before we forget about the format of these tables, let's deal with 
+$\Omega$'s basic scanning routine related to ocp information.
+
+@<Declare procedures that scan ocp-related stuff@>=
+procedure scan_ocp_ident;
+var f:internal_ocp_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp then f:=cur_chr
+else  begin print_err("Missing ocp identifier");
+@.Missing ocp identifier@>
+  help2("I was looking for a control sequence whose")@/
+  ("current meaning has been defined by \ocp.");
+  back_error; f:=null_ocp;
+  end;
+cur_val:=f;
+end;
+
+
+@ Here we begin the \.{OCP} list handling.
+
+
+@<Types...@>=
+@!internal_ocp_list_number=ocp_list_base..ocp_list_biggest;
+@!ocp_list_index=integer; {index into |ocp_list_info|}
+@!ocp_lstack_index=integer; {index into |ocp_lstack_info|}
+
+@ Here now is the array of ocp arrays.
+@d ocp_list_lnext(#)==ocp_list_info[#].hh.b0
+@d ocp_list_lstack(#)==ocp_list_info[#].hh.b1
+@d ocp_list_lstack_no(#)==ocp_list_info[#+1].sc
+@d ocp_lstack_lnext(#)==ocp_lstack_info[#].hh.b0
+@d ocp_lstack_ocp(#)==ocp_lstack_info[#].hh.b1
+@d make_null_ocp_list==make_ocp_list_node(0,ocp_maxint,0)
+@d is_null_ocp_list(#)==ocp_list_lstack_no(#)=ocp_maxint
+@d make_null_ocp_lstack==0
+@d is_null_ocp_lstack(#)==#=0
+@d add_before_op=1
+@d add_after_op=2
+@d remove_before_op=3
+@d remove_after_op=4
+
+@<Glob...@>=
+@!ocp_list_info:array[ocp_list_index] of memory_word;
+  {the big collection of ocp list data}
+@!ocp_listmem_ptr:ocp_list_index; {first unused word of |ocp_list_info|}
+@!ocp_listmem_run_ptr:ocp_list_index; {temp unused word of |ocp_list_info|}
+@!ocp_lstack_info:array[ocp_lstack_index] of memory_word;
+  {the big collection of ocp lstack data}
+@!ocp_lstackmem_ptr:ocp_lstack_index; {first unused word of |ocp_lstack_info|}
+@!ocp_lstackmem_run_ptr:ocp_lstack_index; {temp unused word of |ocp_lstack_info|}
+@!ocp_list_ptr:internal_ocp_list_number; {largest internal ocp list number in use}
+@!ocp_list_list:array[internal_ocp_list_number] of ocp_list_index;
+
+@
+@<Initialize table...@>=
+ocp_listmem_ptr:=2;
+ocp_list_lstack(0):=0;
+ocp_list_lstack_no(0):=ocp_maxint;
+ocp_list_lnext(0):=0;
+ocp_list_ptr:=null_ocp_list;
+ocp_list_list[null_ocp_list]:=0;
+ocp_lstackmem_ptr:=1;
+
+@ $\Omega$ always knows at least one ocp list, namely the null ocp list.
+
+@ @<Put each...@>=
+primitive("nullocplist", set_ocp_list, null_ocp_list);
+text(frozen_null_ocp_list) := "nullocplist"; 
+eqtb[frozen_null_ocp_list] := eqtb[cur_val];
+
+@ @p function make_ocp_list_node(llstack:ocp_lstack_index; 
+                                 llstack_no:scaled; 
+                                 llnext:ocp_list_index):ocp_list_index;
+var p:ocp_list_index;
+begin 
+p:=ocp_listmem_run_ptr;
+ocp_list_lstack(p):=llstack;
+ocp_list_lstack_no(p):=llstack_no;
+ocp_list_lnext(p):=llnext;
+ocp_listmem_run_ptr:=ocp_listmem_run_ptr+2;
+if ocp_listmem_run_ptr>=ocp_list_size then
+  overflow("ocp_list_size",ocp_list_size);
+make_ocp_list_node:=p;
+end;
+
+function make_ocp_lstack_node(locp:internal_ocp_number;
+                              llnext:ocp_lstack_index) : ocp_lstack_index;
+var p:ocp_lstack_index;
+begin 
+p:=ocp_lstackmem_run_ptr;
+ocp_lstack_ocp(p):=locp;
+ocp_lstack_lnext(p):=llnext;
+incr(ocp_lstackmem_run_ptr);
+if ocp_lstackmem_run_ptr>=ocp_stack_size then
+  overflow("ocp_stack_size",ocp_stack_size);
+make_ocp_lstack_node:=p;
+end;
+
+function copy_ocp_lstack(llstack:ocp_lstack_index):ocp_lstack_index;
+var result:ocp_lstack_index;
+begin
+if is_null_ocp_lstack(llstack) then
+  result:=make_null_ocp_lstack
+else
+  result:=make_ocp_lstack_node(ocp_lstack_ocp(llstack),
+                               copy_ocp_lstack(ocp_lstack_lnext(llstack)));
+copy_ocp_lstack:=result;
+end;
+
+function copy_ocp_list(list:ocp_list_index):ocp_list_index;
+var result:ocp_list_index;
+begin
+if is_null_ocp_list(list) then
+  result:=make_null_ocp_list
+else
+  result:=make_ocp_list_node(copy_ocp_lstack(ocp_list_lstack(list)),
+                             ocp_list_lstack_no(list),
+                             copy_ocp_list(ocp_list_lnext(list)));
+copy_ocp_list:=result;
+end;
+
+function ocp_ensure_lstack(list:ocp_list_index; llstack_no:scaled):
+   ocp_list_index;
+var p:ocp_list_index;
+    q:ocp_list_index;
+begin
+p:=list;
+if is_null_ocp_list(p) then begin
+  ocp_list_lstack_no(p) := llstack_no;
+  ocp_list_lnext(p) := make_null_ocp_list;
+  end
+else if ocp_list_lstack_no(p) > llstack_no then begin
+  ocp_list_lnext(p):= 
+    make_ocp_list_node(ocp_list_lstack(p),
+                       ocp_list_lstack_no(p),
+                       ocp_list_lnext(p));
+  ocp_list_lstack(p):=0;
+  ocp_list_lstack_no(p):=llstack_no;
+  end
+else begin
+  q:=ocp_list_lnext(p);
+  while (not (is_null_ocp_list(q))) and 
+         ocp_list_lstack_no(q) <= llstack_no do begin
+    p:=q; q:=ocp_list_lnext(q);
+    end;
+  if ocp_list_lstack_no(p) < llstack_no then begin
+    ocp_list_lnext(p) := make_ocp_list_node(0, llstack_no, q);
+    p := ocp_list_lnext(p);
+    end;
+  end;
+ocp_ensure_lstack := p;
+end;
+
+procedure ocp_apply_add(list_entry:ocp_list_index;
+                        lbefore:boolean;
+                        locp:internal_ocp_number);
+var p:ocp_lstack_index;
+    q:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if lbefore or (p=0) then begin
+  ocp_list_lstack(list_entry) := make_ocp_lstack_node(locp, p);
+  end
+else begin
+  q:=ocp_lstack_lnext(p);
+  while q<>0 do begin
+    p:=q; q:=ocp_lstack_lnext(q);
+    end;
+  ocp_lstack_lnext(p):=make_ocp_lstack_node(locp,0);
+  end;
+end;
+
+procedure ocp_apply_remove(list_entry:ocp_list_index;
+                           lbefore:boolean);
+var p:ocp_lstack_index;
+    q:ocp_lstack_index;
+    r:ocp_lstack_index;
+begin
+p := ocp_list_lstack(list_entry);
+if p=0 then begin
+  print_err("warning: stack entry already empty"); print_ln
+  end
+else begin
+  q := ocp_lstack_lnext(p);
+  if lbefore or (q=0) then
+    ocp_list_lstack(list_entry) := q
+  else begin
+    r:=ocp_lstack_lnext(q);
+    while r <> 0 do begin
+      p:=q; q:=r; r:=ocp_lstack_lnext(r);
+      end;
+    ocp_lstack_lnext(p) := 0; 
+    end
+  end;
+end;
+
+procedure scan_scaled; {sets |cur_val| to a scaled value}
+label done, done1, done2, found, not_found, attach_fraction;
+var negative:boolean; {should the answer be negated?}
+@!f:integer; {numerator of a fraction whose denominator is $2^{16}$}
+@!k,@!kk:small_number; {number of digits in a decimal fraction}
+@!p,@!q:pointer; {top of decimal digit stack}
+begin f:=0; arith_error:=false; negative:=false;
+@<Get the next non-blank non-sign...@>;
+back_input;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if cur_tok<>point_token then scan_int
+else  begin radix:=10; cur_val:=0;
+  end;
+if cur_tok=continental_point_token then cur_tok:=point_token;
+if (radix=10)and(cur_tok=point_token) then @<Scan decimal fraction@>;
+if cur_val<0 then {in this case |f=0|}
+  begin negative := not negative; negate(cur_val);
+  end;
+if cur_val>@'40000 then arith_error:=true
+else cur_val := cur_val*unity +f;
+if arith_error or(abs(cur_val)>=@'10000000000) then
+begin print_err("Stack number too large"); error;
+end;
+if negative then negate(cur_val);
+end;
+
+procedure print_ocp_lstack(lstack_entry:ocp_lstack_index);
+var p:ocp_lstack_index;
+begin
+p:=lstack_entry;
+while (p<>0) do begin
+  print_esc(ocp_id_text(ocp_lstack_ocp(p)));
+  p:=ocp_lstack_lnext(p);
+  if (p<>0) then print(",");
+  end;
+end;
+
+procedure print_ocp_list(list_entry:ocp_list_index);
+var p:ocp_list_index;
+begin
+print("["); p:=list_entry;
+while not (is_null_ocp_list(p)) do begin
+  print("(");
+  print_scaled(ocp_list_lstack_no(p));
+  print(" : ");
+  print_ocp_lstack(ocp_list_lstack(p));
+  print(")");
+  p:=ocp_list_lnext(p);
+  if not (is_null_ocp_list(p)) then print(", ");
+  end;
+print("]");
+end;
+
+function scan_ocp_list: ocp_list_index;
+var llstack_no:scaled; 
+    lop:quarterword;
+    lstack_entry:ocp_list_index;
+    other_list:ocp_list_index;
+    ocp_ident:internal_ocp_number;
+    result:ocp_list_index;
+begin
+get_r_token; 
+if cur_cmd = set_ocp_list then
+  result := copy_ocp_list(ocp_list_list[cur_chr])
+else if cur_cmd <> ocp_list_op then begin
+  print_err("Bad ocp list specification");
+@.Bad ocp list specification@>
+  help1("I was looking for a ocp list specification.");
+  error;
+  result := make_null_ocp_list;
+  end
+else begin
+  lop:=cur_chr;
+  scan_scaled; llstack_no:=cur_val;
+  if (llstack_no<=0) or (llstack_no>=ocp_maxint) then begin
+    print_err("Stack numbers must be between 0 and 4096 (exclusive)");
+    error;
+    result := make_null_ocp_list;
+    end
+  else begin
+    if lop <= add_after_op then begin
+      scan_ocp_ident; ocp_ident:=cur_val;
+      end;
+    other_list:=scan_ocp_list;
+    lstack_entry:=ocp_ensure_lstack(other_list, llstack_no);
+    if lop <= add_after_op then
+      ocp_apply_add(lstack_entry, (lop=add_before_op), ocp_ident)
+    else
+      ocp_apply_remove(lstack_entry, (lop=remove_before_op));
+    result:=other_list;
+    end;
+  end;
+scan_ocp_list:=result;
+end;
+
+function read_ocp_list: internal_ocp_list_number;
+var f:internal_ocp_list_number;
+    g:internal_ocp_list_number;
+begin
+g:=null_ocp_list;
+f:=ocp_list_ptr+1;
+ocp_listmem_run_ptr:=ocp_listmem_ptr;
+ocp_lstackmem_run_ptr:=ocp_lstackmem_ptr;
+ocp_list_list[f]:=scan_ocp_list;
+ocp_list_ptr:=f;
+ocp_listmem_ptr:=ocp_listmem_run_ptr;
+ocp_lstackmem_ptr:=ocp_lstackmem_run_ptr;
+g:=f;
+read_ocp_list:=g;
+end;
+
+procedure scan_ocp_list_ident;
+var f:internal_ocp_list_number;
+begin @<Get the next non-blank non-call...@>;
+if cur_cmd=set_ocp_list then f:=cur_chr
+else  begin print_err("Missing ocp list identifier");
+@.Missing ocp list identifier@>
+  help2("I was looking for a control sequence whose")@/
+  ("current meaning has been defined by \ocplist.");
+  back_error; f:=null_ocp_list;
+  end;
+cur_val:=f;
+end;
+
+
+@* \[31] Device-independent file format.
+The most important output produced by a run of \TeX\ is the ``device
+independent'' (\.{DVI}) file that specifies where characters and rules
+are to appear on printed pages. The form of these files was designed by
+David R. Fuchs in 1979. Almost any reasonable typesetting device can be
+@^Fuchs, David Raymond@>
+@:DVI_files}{\.{DVI} files@>
+driven by a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of \TeX\ on many different kinds of equipment, using \TeX\
+as a device-independent ``front end.''
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$. As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order.
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first.  Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that \TeX\ generated them. If we ignore |nop| commands
+and \\{fnt\_def} commands (which are allowed between any two commands in
+the file), each |eop| command is immediately followed by a |bop| command,
+or by a |post| command; in the latter case, there are no more pages in the
+file, and the remaining bytes form the postamble.  Further details about
+the postamble will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one starting in byte 100, has a pointer of~$-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|.  (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below; \TeX\ sets things up so that
+its \.{DVI} output is in sp units, i.e., scaled points, in agreement with
+all the |scaled| dimensions in \TeX's data structures.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long.
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang\\{set\_char\_1} through \\{set\_char\_127} (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|@!set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, but it should come in handy for extensions of \TeX\ that deal
+with oriental languages.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|@!set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$. Not even the Chinese
+language has this many characters, but this command might prove useful
+in some yet unforeseen extension.
+
+\yskip\hang|@!set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height~|a| and width~|b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+See below for details about how to typeset rules so that consistency with
+\MF\ is guaranteed.
+
+\yskip\hang|@!put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|@!put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|@!put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|@!put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value.  The ten $c_i$ parameters hold
+the values of \.{\\count0} $\ldots$ \.{\\count9} in \TeX\ at the time
+\.{\\shipout} was invoked for this page; they can be used to identify
+pages, if a user wants to print only part of a \.{DVI} file. The parameter
+|p| points to the previous |bop| in the file; the first
+|bop| has $p=-1$.
+
+\yskip\hang|eop| 140.  End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them respectively to |(h,v,w,x,y,z)|. The number of pops should never
+exceed the number of pushes, since it would be highly embarrassing if the
+stack were empty at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|@!w2| 149 |b[2]|. Same as |w1|, but |b| is two bytes long,
+|-32768<=b<32768|.
+
+\yskip\hang|@!w3| 150 |b[3]|. Same as |w1|, but |b| is three bytes long,
+|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|@!w4| 151 |b[4]|. Same as |w1|, but |b| is four bytes long,
+|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|@!x2| 154 |b[2]|. Same as |x1|, but |b| is two bytes long,
+|-32768<=b<32768|.
+
+\yskip\hang|@!x3| 155 |b[3]|. Same as |x1|, but |b| is three bytes long,
+|@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|@!x4| 156 |b[4]|. Same as |x1|, but |b| is four bytes long,
+|@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point moves up.
+
+\yskip\hang|@!down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|@!down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|@!y2| 163 |a[2]|. Same as |y1|, but |a| is two bytes long,
+|-32768<=a<32768|.
+
+\yskip\hang|@!y3| 164 |a[3]|. Same as |y1|, but |a| is three bytes long,
+|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!y4| 165 |a[4]|. Same as |y1|, but |a| is four bytes long,
+|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|@!z2| 168 |a[2]|. Same as |z1|, but |a| is two bytes long,
+|-32768<=a<32768|.
+
+\yskip\hang|@!z3| 169 |a[3]|. Same as |z1|, but |a| is three bytes long,
+|@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|@!z4| 170 |a[4]|. Same as |z1|, but |a| is four bytes long,
+|@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang\\{fnt\_num\_1} through \\{fnt\_num\_63} (opcodes 172 to 234). Set
+|f:=1|, \dots, \hbox{|f:=63|}, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|@!fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|@!fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|@!fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|@!xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when sending a string of length 256 or more.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1==133 {typeset a character without moving}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1==143 {move right}
+@d right4==146 {move right, 4 bytes}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d down4=160 {move down, 4 bytes}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (The value |i=3| is currently used for an extended format that
+allows a mixture of right-to-left and left-to-right typesetting.
+Some day we will set |i=4|, when \.{DVI} format makes another
+incompatible change---perhaps in the year 2048.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. Since $\rm 7227{pt} =
+254{cm}$, and since \TeX\ works with scaled points where there are $2^{16}$
+sp in a point, \TeX\ sets
+$|num|/|den|=(254\cdot10^5)/(7227\cdot2^{16})=25400000/473628672$.
+@^sp@>
+
+The |mag| parameter is what \TeX\ calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $|mag|\cdot|num|/1000|den|$. Note that if a \TeX\
+source document does not call for any `\.{true}' dimensions, and if you
+change it only by specifying a different \.{\\mag} setting, the \.{DVI}
+file that \TeX\ creates will be completely unchanged except for the value
+of |mag| in the preamble and postamble. (Fancy \.{DVI}-reading programs allow
+users to override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ found in the \.{TFM}
+file for this font; |c| should match the check sum of the font found by
+programs that read this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to
+the character widths in font |k|; font dimensions in \.{TFM} files and
+other font files are relative to this quantity, which is called the
+``at size'' elsewhere in this documentation. The value of |s| is
+always positive and less than $2^{27}$. It is given in the same units
+as the other \.{DVI} dimensions, i.e., in sp when \TeX82 has made the
+file.  Parameter |d| is similar to |s|; it is the ``design size,'' and
+(like~|s|) it is given in \.{DVI} units. Thus, font |k| is to be used
+at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ Sometimes it is desirable to make horizontal or vertical rules line up
+precisely with certain features in characters of a font. It is possible to
+guarantee the correct matching between \.{DVI} output and the characters
+generated by \MF\ by adhering to the following principles: (1)~The \MF\
+characters should be positioned so that a bottom edge or left edge that is
+supposed to line up with the bottom or left edge of a rule appears at the
+reference point, i.e., in row~0 and column~0 of the \MF\ raster. This
+ensures that the position of the rule will not be rounded differently when
+the pixel size is not a perfect multiple of the units of measurement in
+the \.{DVI} file. (2)~A typeset rule of height $a>0$ and width $b>0$
+should be equivalent to a \MF-generated character having black pixels in
+precisely those raster positions whose \MF\ coordinates satisfy
+|0<=x<@t$\alpha$@>b| and |0<=y<@t$\alpha$@>a|, where $\alpha$ is the number
+of pixels per \.{DVI} unit.
+@:METAFONT}{\MF@>
+@^alignment of rules with characters@>
+@^rules aligning with characters@>
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+  |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+  $\langle\,$font definitions$\,\rangle$\cr
+  |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper; however,
+the standard convention for output on normal size paper is to position each
+page so that the upper left-hand corner is exactly one inch from the left
+and the top. Experience has shown that it is unwise to design \.{DVI}-to-printer
+software that attempts cleverly to center the output; a fixed position of
+the upper left corner is easiest for users to understand and to work with.
+Therefore |l| and~|u| are often ignored.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble.  An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader can discover all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{DVI} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back, since the necessary
+header information is present in the preamble and in the font definitions.
+(The |l| and |u| and |s| and |t| parameters, which appear only in the
+postamble, are ``frills'' that are handy but not absolutely necessary.)
+
+@* \[32] Shipping pages out.
+After considering \TeX's eyes and stomach, we come now to the bowels.
+@^bowels@>
+
+The |ship_out| procedure is given a pointer to a box; its mission is
+to describe that box in \.{DVI} form, outputting a ``page'' to |dvi_file|.
+The \.{DVI} coordinates $(h,v)=(0,0)$ should correspond to the upper left
+corner of the box being shipped.
+
+Since boxes can be inside of boxes inside of boxes, the main work of
+|ship_out| is done by two mutually recursive routines, |hlist_out|
+and |vlist_out|, which traverse the hlists and vlists inside of horizontal
+and vertical boxes.
+
+As individual pages are being processed, we need to accumulate
+information about the entire set of pages, since such statistics must be
+reported in the postamble. The global variables |total_pages|, |max_v|,
+|max_h|, |max_push|, and |last_bop| are used to record this information.
+
+The variable |doing_leaders| is |true| while leaders are being output.
+The variable |dead_cycles| contains the number of times an output routine
+has been initiated since the last |ship_out|.
+
+A few additional global variables are also defined here for use in
+|vlist_out| and |hlist_out|. They could have been local variables, but
+that would waste stack space when boxes are deeply nested, since the
+values of these variables are not needed during recursive calls.
+@^recursion@>
+
+@<Glob...@>=
+@!total_pages:integer; {the number of pages that have been shipped out}
+@!max_v:scaled; {maximum height-plus-depth of pages shipped so far}
+@!max_h:scaled; {maximum width of pages shipped so far}
+@!max_push:integer; {deepest nesting of |push| commands encountered so far}
+@!last_bop:integer; {location of previous |bop| in the \.{DVI} output}
+@!dead_cycles:integer; {recent outputs that didn't ship anything out}
+@!doing_leaders:boolean; {are we inside a leader box?}
+@#
+@!c,@!f:integer; {character and font in current |char_node|}
+@!oval,@!ocmd:integer; {used by |out_cmd| for generating
+  |set|, |fnt| and |fnt_def| commands}
+@!rule_ht,@!rule_dp,@!rule_wd:scaled; {size of current rule being output}
+@!g:pointer; {current glue specification}
+@!lq,@!lr:integer; {quantities used in calculations for leaders}
+
+@ @<Set init...@>=
+total_pages:=0; max_v:=0; max_h:=0; max_push:=0; last_bop:=-1;
+doing_leaders:=false; dead_cycles:=0; cur_s:=-1;
+
+@ The \.{DVI} bytes are output to a buffer instead of being written directly
+to the output file. This makes it possible to reduce the overhead of
+subroutine calls, thereby measurably speeding up the computation, since
+output of \.{DVI} bytes is part of \TeX's inner loop. And it has another
+advantage as well, since we can change instructions in the buffer in order to
+make the output more compact. For example, a `|down2|' command can be
+changed to a `|y2|', thereby making a subsequent `|y0|' command possible,
+saving two bytes.
+
+The output buffer is divided into two parts of equal size; the bytes found
+in |dvi_buf[0..half_buf-1]| constitute the first half, and those in
+|dvi_buf[half_buf..dvi_buf_size-1]| constitute the second. The global
+variable |dvi_ptr| points to the position that will receive the next
+output byte. When |dvi_ptr| reaches |dvi_limit|, which is always equal
+to one of the two values |half_buf| or |dvi_buf_size|, the half buffer that
+is about to be invaded next is sent to the output and |dvi_limit| is
+changed to its other value. Thus, there is always at least a half buffer's
+worth of information present, except at the very beginning of the job.
+
+Bytes of the \.{DVI} file are numbered sequentially starting with 0;
+the next byte to be generated will be number |dvi_offset+dvi_ptr|.
+A byte is present in the buffer only if its number is |>=dvi_gone|.
+
+@<Types...@>=
+@!dvi_index=0..dvi_buf_size; {an index into the output buffer}
+
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!dvi_buf:array[dvi_index] of real_eight_bits; {buffer for \.{DVI} output}
+@!half_buf:dvi_index; {half of |dvi_buf_size|}
+@!dvi_limit:dvi_index; {end of the current half buffer}
+@!dvi_ptr:dvi_index; {the next available buffer address}
+@!dvi_offset:integer; {|dvi_buf_size| times the number of times the
+  output buffer has been fully emptied}
+@!dvi_gone:integer; {the number of bytes already output to |dvi_file|}
+
+@ Initially the buffer is all in one piece; we will output half of it only
+after it first fills up.
+
+@<Set init...@>=
+half_buf:=dvi_buf_size div 2; dvi_limit:=dvi_buf_size; dvi_ptr:=0;
+dvi_offset:=0; dvi_gone:=0;
+
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. For best results, this procedure should be optimized to
+run as fast as possible on each particular system, since it is part of
+\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(a,b)| is called; therefore it is possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+@^system dependencies@>
+@^inner loop@>
+@^defecation@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+
+@ To put a byte in the buffer without paying the cost of invoking a procedure
+each time, we use the macro |dvi_out|.
+
+@d dvi_out(#)==@+begin dvi_buf[dvi_ptr]:=#; incr(dvi_ptr);
+  if dvi_ptr=dvi_limit then dvi_swap;
+  end
+
+@p procedure dvi_swap; {outputs half of the buffer}
+begin if dvi_limit=dvi_buf_size then
+  begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+  dvi_offset:=dvi_offset+dvi_buf_size; dvi_ptr:=0;
+  end
+else  begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+  end;
+dvi_gone:=dvi_gone+half_buf;
+end;
+
+@ Here is how we clean out the buffer when \TeX\ is all through; |dvi_ptr|
+will be a multiple of~4.
+
+@<Empty the last bytes out of |dvi_buf|@>=
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+
+@ The |dvi_four| procedure outputs four bytes in two's complement notation,
+without risking arithmetic overflow.
+
+@p procedure dvi_four(@!x:integer);
+begin if x>=0 then dvi_out(x div @'100000000)
+else  begin x:=x+@'10000000000;
+  x:=x+@'10000000000;
+  dvi_out((x div @'100000000) + 128);
+  end;
+x:=x mod @'100000000; dvi_out(x div @'200000);
+x:=x mod @'200000; dvi_out(x div @'400);
+dvi_out(x mod @'400);
+end;
+
+@ A mild optimization of the output is performed by the |dvi_pop|
+routine, which issues a |pop| unless it is possible to cancel a
+`|push| |pop|' pair. The parameter to |dvi_pop| is the byte address
+following the old |push| that matches the new |pop|.
+
+@p procedure dvi_pop(@!l:integer);
+begin if (l=dvi_offset+dvi_ptr)and(dvi_ptr>0) then decr(dvi_ptr)
+else dvi_out(pop);
+end;
+
+@ Here's a procedure that outputs a font definition. $\Omega$ allows
+more than 256 different fonts per job, so the right font definition 
+command must be selected.
+
+@d Incr_Decr(#) == #
+@d Incr(#) == #:=#+Incr_Decr {increase a variable}
+@d Decr(#) == #:=#-Incr_Decr {decrease a variable}
+
+@d dvi_debug_out(#)==begin
+dvi_out(#);
+end
+
+@d out_cmd ==
+begin
+if (oval<@"100)and(oval>=0) then begin
+  if (ocmd<>set1)or(oval>127) then
+  if (ocmd=fnt1)and(oval<64) then Incr(oval)(fnt_num_0) @+ else dvi_debug_out(ocmd);
+  end
+else
+  begin if (oval<@"10000)and(oval>=0) then dvi_debug_out(ocmd+1) @+ else @;
+    begin if (oval<@"1000000)and(oval>=0) then dvi_debug_out(ocmd+2) @+ else @;
+      begin dvi_debug_out(ocmd+3);
+      if oval>=0 then dvi_debug_out(oval div @"1000000)
+      else  begin Incr(oval)(@"40000000); Incr(oval)(@"40000000);
+        dvi_debug_out((oval div @"1000000) + 128); oval:=oval mod @"1000000;
+        end;
+      dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+      end;
+    dvi_debug_out(oval div @"10000); oval:=oval mod @"10000;
+    end;
+  dvi_debug_out(oval div @"100); oval:=oval mod @"100;
+  end;
+dvi_debug_out(oval)
+end
+
+@p procedure dvi_font_def(@!f:internal_font_number);
+var k:pool_pointer; {index into |str_pool|}
+fa:^packed_ASCII_code;
+begin
+oval:=f-font_base-1; ocmd:= fnt_def1; out_cmd;@/
+dvi_out(font_check_0(f));
+dvi_out(font_check_1(f));
+dvi_out(font_check_2(f));
+dvi_out(font_check_3(f));@/
+dvi_four(font_size(f));
+dvi_four(font_dsize(f));@/
+dvi_out(strlen(font_area(f)));
+dvi_out(strlen(font_name(f)));
+@<Output the font name whose internal number is |f|@>;
+end;
+
+@ @<Output the font name whose internal number is |f|@>=
+fa := get_font_name(f); k := 0;
+while fa[k]<>0 do begin dvi_out(fa[k]); incr(k); end;
+fa := get_font_area(f); k := 0;
+while fa[k]<>0 do begin dvi_out(fa[k]); incr(k); end
+
+@ Versions of \TeX\ intended for small computers might well choose to omit
+the ideas in the next few parts of this program, since it is not really
+necessary to optimize the \.{DVI} code by making use of the |w0|, |x0|,
+|y0|, and |z0| commands. Furthermore, the algorithm that we are about to
+describe does not pretend to give an optimum reduction in the length
+of the \.{DVI} code; after all, speed is more important than compactness.
+But the method is surprisingly effective, and it takes comparatively little
+time.
+
+We can best understand the basic idea by first considering a simpler problem
+that has the same essential characteristics. Given a sequence of digits,
+say $3\,1\,4\,1\,5\,9\,2\,6\,5\,3\,5\,8\,9$, we want to assign subscripts
+$d$, $y$, or $z$ to each digit so as to maximize the number of ``$y$-hits''
+and ``$z$-hits''; a $y$-hit is an instance of two appearances of the same
+digit with the subscript $y$, where no $y$'s intervene between the two
+appearances, and a $z$-hit is defined similarly. For example, the sequence
+above could be decorated with subscripts as follows:
+$$3_z\,1_y\,4_d\,1_y\,5_y\,9_d\,2_d\,6_d\,5_y\,3_z\,5_y\,8_d\,9_d.$$
+There are three $y$-hits ($1_y\ldots1_y$ and $5_y\ldots5_y\ldots5_y$) and
+one $z$-hit ($3_z\ldots3_z$); there are no $d$-hits, since the two appearances
+of $9_d$ have $d$'s between them, but we don't count $d$-hits so it doesn't
+matter how many there are. These subscripts are analogous to the \.{DVI}
+commands called \\{down}, $y$, and $z$, and the digits are analogous to
+different amounts of vertical motion; a $y$-hit or $z$-hit corresponds to
+the opportunity to use the one-byte commands |y0| or |z0| in a \.{DVI} file.
+
+\TeX's method of assigning subscripts works like this: Append a new digit,
+say $\delta$, to the right of the sequence. Now look back through the
+sequence until one of the following things happens: (a)~You see
+$\delta_y$ or $\delta_z$, and this was the first time you encountered a
+$y$ or $z$ subscript, respectively.  Then assign $y$ or $z$ to the new
+$\delta$; you have scored a hit. (b)~You see $\delta_d$, and no $y$
+subscripts have been encountered so far during this search.  Then change
+the previous $\delta_d$ to $\delta_y$ (this corresponds to changing a
+command in the output buffer), and assign $y$ to the new $\delta$; it's
+another hit.  (c)~You see $\delta_d$, and a $y$ subscript has been seen
+but not a $z$.  Change the previous $\delta_d$ to $\delta_z$ and assign
+$z$ to the new $\delta$. (d)~You encounter both $y$ and $z$ subscripts
+before encountering a suitable $\delta$, or you scan all the way to the
+front of the sequence. Assign $d$ to the new $\delta$; this assignment may
+be changed later.
+
+The subscripts $3_z\,1_y\,4_d\ldots\,$ in the example above were, in fact,
+produced by this procedure, as the reader can verify. (Go ahead and try it.)
+
+@ In order to implement such an idea, \TeX\ maintains a stack of pointers
+to the \\{down}, $y$, and $z$ commands that have been generated for the
+current page. And there is a similar stack for \\{right}, |w|, and |x|
+commands. These stacks are called the down stack and right stack, and their
+top elements are maintained in the variables |down_ptr| and |right_ptr|.
+
+Each entry in these stacks contains four fields: The |width| field is
+the amount of motion down or to the right; the |location| field is the
+byte number of the \.{DVI} command in question (including the appropriate
+|dvi_offset|); the |vlink| field points to the next item below this one
+on the stack; and the |vinfo| field encodes the options for possible change
+in the \.{DVI} command.
+
+@d movement_node=48
+@d movement_node_size=3 {number of words per entry in the down and right stacks}
+@d location(#)==vmem(#+1).int {\.{DVI} byte number for a movement command}
+
+@<Glob...@>=
+@!down_ptr,@!right_ptr:pointer; {heads of the down and right stacks}
+
+@ @<Set init...@>=
+down_ptr:=null; right_ptr:=null;
+
+@ Here is a subroutine that produces a \.{DVI} command for some specified
+downward or rightward motion. It has two parameters: |w| is the amount
+of motion, and |o| is either |down1| or |right1|. We use the fact that
+the command codes have convenient arithmetic properties: |y1-down1=w1-right1|
+and |z1-down1=x1-right1|.
+
+@d dvi_set(#)==oval:=#; ocmd:=set1; out_cmd
+@d dvi_put(#)==oval:=#; ocmd:=put1; out_cmd
+@d dvi_set_rule_end(#)==dvi_four(#)
+@d dvi_set_rule(#)==dvi_out(set_rule); dvi_four(#); dvi_set_rule_end
+@d dvi_put_rule_end(#)==dvi_four(#)
+@d dvi_put_rule(#)==dvi_out(put_rule); dvi_four(#); dvi_put_rule_end
+@d dvi_right(#)==dvi_out(right4); dvi_four(#);
+@d dvi_left(#)==dvi_out(right4); dvi_four(-#);
+@d dvi_down(#)==dvi_out(down4); dvi_four(#);
+@d dvi_up(#)==dvi_out(down4); dvi_four(-#);
+
+@p procedure movement(@!w:scaled;@!o:eight_bits);
+label exit,found,not_found,2,1;
+var mstate:small_number; {have we seen a |y| or |z|?}
+@!p,@!q:pointer; {current and top nodes on the stack}
+@!k:integer; {index into |dvi_buf|, modulo |dvi_buf_size|}
+begin
+case box_direction(dvi_direction) of
+  dir_TL_: begin
+    end;
+  dir_TR_: begin
+    if o=right1 then negate(w);
+    end;
+  dir_LT_: begin
+    if o=right1 then o:=down1
+    else o:=right1;
+    end;
+  dir_LB_: begin
+    if o=right1 then begin
+      o:=down1; negate(w);
+      end
+    else o:=right1;
+    end;
+  dir_BL_: begin
+    if o=down1 then negate(w);
+    end;
+  dir_BR_: begin
+    negate(w);
+    end;
+  dir_RT_: begin
+    if o=right1 then o:=down1
+    else begin o:=right1; negate(w);
+      end;
+    end;
+  dir_RB_: begin
+    if o=right1 then o:=down1 else o:=right1;
+    negate(w);
+    end;
+  end;
+if false then begin
+q:=new_node(movement_node,0); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+  begin vlink(q):=down_ptr; down_ptr:=q;
+  end
+else  begin vlink(q):=right_ptr; right_ptr:=q;
+  end;
+@<Look at the other stack entries until deciding what sort of \.{DVI} command
+  to generate; |goto found| if node |p| is a ``hit''@>;
+end;
+@<Generate a |down| or |right| command for |w| and |return|@>;
+found: @<Generate a |y0| or |z0| command in order to reuse a previous
+  appearance of~|w|@>;
+exit:end;
+
+@ The |vinfo| fields in the entries of the down stack or the right stack
+have six possible settings: |y_here| or |z_here| mean that the \.{DVI}
+command refers to |y| or |z|, respectively (or to |w| or |x|, in the
+case of horizontal motion); |yz_OK| means that the \.{DVI} command is
+\\{down} (or \\{right}) but can be changed to either |y| or |z| (or
+to either |w| or |x|); |y_OK| means that it is \\{down} and can be changed
+to |y| but not |z|; |z_OK| is similar; and |d_fixed| means it must stay
+\\{down}.
+
+The four settings |yz_OK|, |y_OK|, |z_OK|, |d_fixed| would not need to
+be distinguished from each other if we were simply solving the
+digit-subscripting problem mentioned above. But in \TeX's case there is
+a complication because of the nested structure of |push| and |pop|
+commands. Suppose we add parentheses to the digit-subscripting problem,
+redefining hits so that $\delta_y\ldots \delta_y$ is a hit if all $y$'s between
+the $\delta$'s are enclosed in properly nested parentheses, and if the
+parenthesis level of the right-hand $\delta_y$ is deeper than or equal to
+that of the left-hand one. Thus, `(' and `)' correspond to `|push|'
+and `|pop|'. Now if we want to assign a subscript to the final 1 in the
+sequence
+$$2_y\,7_d\,1_d\,(\,8_z\,2_y\,8_z\,)\,1$$
+we cannot change the previous $1_d$ to $1_y$, since that would invalidate
+the $2_y\ldots2_y$ hit. But we can change it to $1_z$, scoring a hit
+since the intervening $8_z$'s are enclosed in parentheses.
+
+The program below removes movement nodes that are introduced after a |push|,
+before it outputs the corresponding |pop|.
+
+@d y_here=1 {|vinfo| when the movement entry points to a |y| command}
+@d z_here=2 {|vinfo| when the movement entry points to a |z| command}
+@d yz_OK=3 {|vinfo| corresponding to an unconstrained \\{down} command}
+@d y_OK=4 {|vinfo| corresponding to a \\{down} that can't become a |z|}
+@d z_OK=5 {|vinfo| corresponding to a \\{down} that can't become a |y|}
+@d d_fixed=6 {|vinfo| corresponding to a \\{down} that can't change}
+
+@ When the |movement| procedure gets to the label |found|, the value of
+|vinfo(p)| will be either |y_here| or |z_here|. If it is, say, |y_here|,
+the procedure generates a |y0| command (or a |w0| command), and marks
+all |vinfo| fields between |q| and |p| so that |y| is not OK in that range.
+
+@<Generate a |y0| or |z0| command...@>=
+vinfo(q):=vinfo(p);
+if vinfo(q)=y_here then
+  begin dvi_out(o+y0-down1); {|y0| or |w0|}
+  while vlink(q)<>p do
+    begin q:=vlink(q);
+    case vinfo(q) of
+    yz_OK: vinfo(q):=z_OK;
+    y_OK: vinfo(q):=d_fixed;
+    othercases do_nothing
+    endcases;
+    end;
+  end
+else  begin dvi_out(o+z0-down1); {|z0| or |x0|}
+  while vlink(q)<>p do
+    begin q:=vlink(q);
+    case vinfo(q) of
+    yz_OK: vinfo(q):=y_OK;
+    z_OK: vinfo(q):=d_fixed;
+    othercases do_nothing
+    endcases;
+    end;
+  end
+
+@ @<Generate a |down| or |right|...@>=
+if abs(w)>=@'40000000 then
+  begin dvi_out(o+3); {|down4| or |right4|}
+  dvi_four(w); return;
+  end;
+if abs(w)>=@'100000 then
+  begin dvi_out(o+2); {|down3| or |right3|}
+  if w<0 then w:=w+@'100000000;
+  dvi_out(w div @'200000); w:=w mod @'200000; goto 2;
+  end;
+if abs(w)>=@'200 then
+  begin dvi_out(o+1); {|down2| or |right2|}
+  if w<0 then w:=w+@'200000;
+  goto 2;
+  end;
+dvi_out(o); {|down1| or |right1|}
+if w<0 then w:=w+@'400;
+goto 1;
+2: dvi_out(w div @'400);
+1: dvi_out(w mod @'400); return
+
+@ As we search through the stack, we are in one of three states,
+|y_seen|, |z_seen|, or |none_seen|, depending on whether we have
+encountered |y_here| or |z_here| nodes. These states are encoded as
+multiples of 6, so that they can be added to the |info| fields for quick
+decision-making.
+@^inner loop@>
+
+@d none_seen=0 {no |y_here| or |z_here| nodes have been encountered yet}
+@d y_seen=6 {we have seen |y_here| but not |z_here|}
+@d z_seen=12 {we have seen |z_here| but not |y_here|}
+
+@<Look at the other stack entries until deciding...@>=
+p:=vlink(q); mstate:=none_seen;
+while p<>null do
+  begin if width(p)=w then @<Consider a node with matching width;
+    |goto found| if it's a hit@>
+  else  case mstate+vinfo(p) of
+    none_seen+y_here: mstate:=y_seen;
+    none_seen+z_here: mstate:=z_seen;
+    y_seen+z_here,z_seen+y_here: goto not_found;
+    othercases do_nothing
+    endcases;
+  p:=vlink(p);
+  end;
+not_found:
+
+@ We might find a valid hit in a |y| or |z| byte that is already gone
+from the buffer. But we can't change bytes that are gone forever; ``the
+moving finger writes, $\ldots\,\,$.''
+
+@<Consider a node with matching width...@>=
+case mstate+vinfo(p) of
+none_seen+yz_OK,none_seen+y_OK,z_seen+yz_OK,z_seen+y_OK:@t@>@;@/
+  if location(p)<dvi_gone then goto not_found
+  else @<Change buffered instruction to |y| or |w| and |goto found|@>;
+none_seen+z_OK,y_seen+yz_OK,y_seen+z_OK:@t@>@;@/
+  if location(p)<dvi_gone then goto not_found
+  else @<Change buffered instruction to |z| or |x| and |goto found|@>;
+none_seen+y_here,none_seen+z_here,y_seen+z_here,z_seen+y_here: goto found;
+othercases do_nothing
+endcases
+
+@ @<Change buffered instruction to |y| or |w| and |goto found|@>=
+begin k:=location(p)-dvi_offset;
+if k<0 then k:=k+dvi_buf_size;
+dvi_buf[k]:=dvi_buf[k]+y1-down1;
+vinfo(p):=y_here; goto found;
+end
+
+@ @<Change buffered instruction to |z| or |x| and |goto found|@>=
+begin k:=location(p)-dvi_offset;
+if k<0 then k:=k+dvi_buf_size;
+dvi_buf[k]:=dvi_buf[k]+z1-down1;
+vinfo(p):=z_here; goto found;
+end
+
+@ In case you are wondering when all the movement nodes are removed from
+\TeX's memory, the answer is that they are recycled just before
+|hlist_out| and |vlist_out| finish outputting a box. This restores the
+down and right stacks to the state they were in before the box was output,
+except that some |vinfo|'s may have become more restrictive.
+
+@p procedure prune_movements(@!l:integer);
+  {delete movement nodes with |location>=l|}
+label done,exit;
+var p:pointer; {node being deleted}
+begin while down_ptr<>null do
+  begin if location(down_ptr)<l then goto done;
+  p:=down_ptr; down_ptr:=vlink(p); flush_node(p);
+  end;
+done: while right_ptr<>null do
+  begin if location(right_ptr)<l then return;
+  p:=right_ptr; right_ptr:=vlink(p); flush_node(p);
+  end;
+exit:end;
+
+@ The actual distances by which we want to move might be computed as the
+sum of several separate movements. For example, there might be several
+glue nodes in succession, or we might want to move right by the width of
+some box plus some amount of glue. More importantly, the baselineskip
+distances are computed in terms of glue together with the depth and
+height of adjacent boxes, and we want the \.{DVI} file to lump these
+three quantities together into a single motion.
+
+Therefore, \TeX\ maintains two pairs of global variables: |dvi_h| and |dvi_v|
+are the |h| and |v| coordinates corresponding to the commands actually
+output to the \.{DVI} file, while |cur_h| and |cur_v| are the coordinates
+corresponding to the current state of the output routines. Coordinate
+changes will accumulate in |cur_h| and |cur_v| without being reflected
+in the output, until such a change becomes necessary or desirable; we
+can call the |movement| procedure whenever we want to make |dvi_h=cur_h|
+or |dvi_v=cur_v|.
+
+The current font reflected in the \.{DVI} output is called |dvi_f|;
+there is no need for a `\\{cur\_f}' variable.
+
+The depth of nesting of |hlist_out| and |vlist_out| is called |cur_s|;
+this is essentially the depth of |push| commands in the \.{DVI} output.
+
+@d synch_h==if cur_h<>dvi_h then
+    begin movement(cur_h-dvi_h,right1); dvi_h:=cur_h;
+    end
+@d synch_v==if cur_v<>dvi_v then
+    begin movement(cur_v-dvi_v,down1); dvi_v:=cur_v;
+    end
+
+@<Glob...@>=
+@!dvi_h,@!dvi_v:scaled; {a \.{DVI} reader program thinks we are here}
+@!cur_h,@!cur_v:scaled; {\TeX\ thinks we are here}
+@!dvi_f:internal_font_number; {the current font}
+@!cur_s:integer; {current depth of output box nesting, initially $-1$}
+
+@ @<Calculate DVI page dimensions and margins@>=
+if page_width > 0 then
+    cur_page_width := page_width
+else
+    cur_page_width := width(p) + 2*(h_offset + one_inch);
+if page_height > 0 then
+    cur_page_height := page_height
+else
+    cur_page_height := height(p) + depth(p) + 2*(v_offset + one_inch);
+if page_bottom_offset <> 0 then
+    cur_bottom_offset := page_bottom_offset
+else
+    cur_bottom_offset := 2*one_inch;
+if page_right_offset <> 0 then
+    cur_right_offset := page_right_offset
+else
+    cur_right_offset :=  2*one_inch
+
+
+@ @<Initialize variables as |ship_out| begins@>=
+dvi_h:=0; dvi_v:=0; cur_h:=0; cur_v:=0; dvi_f:=null_font;
+@<Calculate DVI page dimensions and margins@>;
+ensure_dvi_open;
+if total_pages=0 then
+  begin dvi_out(pre); dvi_out(id_byte); {output the preamble}
+@^preamble of \.{DVI} file@>
+  dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+  prepare_mag; dvi_four(mag); {magnification factor is frozen}
+  old_setting:=selector; selector:=new_string;
+  print(" LuaTeX output "); print_int(year); print_char(".");
+  print_two(month); print_char("."); print_two(day);
+  print_char(":"); print_two(time div 60);
+  print_two(time mod 60);
+  selector:=old_setting; dvi_out(cur_length);
+  for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
+  pool_ptr:=str_start_macro(str_ptr); {flush the current string}
+  end
+
+@ When |hlist_out| is called, its duty is to output the box represented
+by the |hlist_node| pointed to by |temp_ptr|. The reference point of that
+box has coordinates |(cur_h,cur_v)|.
+
+Similarly, when |vlist_out| is called, its duty is to output the box represented
+by the |vlist_node| pointed to by |temp_ptr|. The reference point of that
+box has coordinates |(cur_h,cur_v)|.
+@^recursion@>
+
+@p procedure@?vlist_out; forward; {|hlist_out| and |vlist_out| are mutually
+  recursive}
+
+@ The recursive procedures |hlist_out| and |vlist_out| each have local variables
+|save_h| and |save_v| to hold the values of |dvi_h| and |dvi_v| just before
+entering a new level of recursion.  In effect, the values of |save_h| and
+|save_v| on \TeX's run-time stack correspond to the values of |h| and |v|
+that a \.{DVI}-reading program will push onto its coordinate stack.
+
+@d move_past=13 {go to this label when advancing past glue or a rule}
+@d fin_rule=14 {go to this label to finish processing a rule}
+@d next_p=15 {go to this label when finished with node |p|}
+
+@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
+procedure hlist_out; {output an |hlist_node| box}
+label move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+c_wd,c_ht,c_dp: scaled;
+  {the real width, height and depth of the character}
+edge_v: scaled;
+edge_h: scaled;
+effective_horizontal: scaled;
+basepoint_horizontal: scaled;
+basepoint_vertical: scaled;
+saving_h: scaled;
+saving_v: scaled;
+save_direction: integer;
+dir_ptr,dir_tmp:pointer;
+dvi_dir_h,dvi_dir_ptr,dvi_temp_ptr:integer;
+@!left_edge: scaled; {the left coordinate for this box}
+@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p,q:pointer; {current position in the hlist}
+@!save_loc:integer; {\.{DVI} byte location upon entry}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_wd:scaled; {width of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {right edge of sub-box or leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+@<DIR: Initialize |dir_ptr| for |ship_out|@>;
+saving_h:=dvi_h; saving_v:=dvi_v;
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; base_line:=cur_v; left_edge:=cur_h;
+while p<>null do @<Output node |p| for |hlist_out| and move to the next node,
+  maintaining the condition |cur_v=base_line|@>;
+cur_h:=saving_h; cur_v:=saving_v;
+synch_h; synch_v;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+@<DIR: Reset |dir_ptr|@>;
+end;
+
+@ This is a cacheing attempt
+
+@d charinfo_width(#)==#.ci_wd
+@d charinfo_height(#)==#.ci_ht
+@d charinfo_depth(#)==#.ci_dp
+
+@<Types...@>=
+charinfo_short = packed record@;@/
+  @!ci_wd:scaled;
+  @!ci_ht:scaled;
+  @!ci_dp:scaled;
+  end;
+
+@ @<Glob...@>=
+ci:charinfo_short;
+
+@ We ought to give special care to the efficiency of one part of |hlist_out|,
+since it belongs to \TeX's inner loop. When a |char_node| is encountered,
+we save a little time by processing several nodes in succession until
+reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
+@^inner loop@>
+
+@<Output node |p| for |hlist_out|...@>=
+if is_char_node(p) then
+  begin synch_h; synch_v;
+  repeat f:=font(p); c:=character(p);
+  ci := char_info_short(f,c);
+  if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+  if is_rotated(dvi_direction) then begin
+    c_ht:=charinfo_width(ci) div 2;
+    c_wd:=charinfo_height(ci)+charinfo_depth(ci);
+    c_dp:=0;
+    end
+  else begin
+    c_ht:=charinfo_height(ci);
+    c_dp:=charinfo_depth(ci);
+    c_wd:=charinfo_width(ci);
+    end;
+  cur_h:=cur_h+c_wd;
+  if (font_natural_dir(f)<>-1) then begin
+    case font_direction(dvi_direction) of
+    dir__LT,dir__LB: begin
+      dvi_set(c);
+      end;
+    dir__RT,dir__RB: begin
+      dvi_put(c);
+      dvi_left(c_wd);
+      end;
+    dir__TL,dir__TR: begin
+      dvi_put(c);
+      dvi_down(c_wd);
+      end;
+    dir__BL,dir__BR: begin
+      dvi_put(c);
+      dvi_up(c_wd);
+      end;
+    dir__LL,dir__LR: begin
+      dvi_put(c);
+      dvi_right(c_wd);
+      end;
+    dir__RL,dir__RR: begin
+      dvi_put(c);
+      dvi_left(c_wd);
+      end;
+    dir__TT,dir__TB: begin
+      dvi_put(c);
+      dvi_down(c_wd);
+      end;
+    dir__BT,dir__BB: begin
+      dvi_put(c);
+      dvi_up(c_wd);
+      end;
+    end;
+  end else begin
+    case font_direction(dvi_direction) of
+    dir__LT: begin
+      dvi_set(c);
+      end;
+    dir__LB: begin
+      dvi_down(c_ht);
+      dvi_set(c);
+      dvi_up(c_ht);
+      end;
+    dir__RT: begin
+      dvi_left(c_wd);
+      dvi_put(c);
+      end;
+    dir__RB: begin
+      dvi_left(c_wd);
+      dvi_down(c_ht);
+      dvi_put(c);
+      dvi_up(c_ht);
+      end;
+    dir__TL: begin
+      dvi_down(c_wd);
+      dvi_left(c_ht);
+      dvi_put(c);
+      dvi_right(c_ht);
+      end;
+    dir__TR: begin
+      dvi_down(c_wd);
+      dvi_left(c_dp);
+      dvi_put(c);
+      dvi_right(c_dp);
+      end;
+    dir__BL: begin
+      dvi_left(c_ht);
+      dvi_put(c);
+      dvi_right(c_ht);
+      dvi_up(c_wd);
+      end;
+    dir__BR: begin
+      dvi_left(c_dp);
+      dvi_put(c);
+      dvi_right(c_dp);
+      dvi_up(c_wd);
+      end;
+    dir__LL,dir__LR: begin
+      dvi_down(c_ht);
+      dvi_put(c);
+      dvi_up(c_ht);
+      dvi_right(c_wd);
+      end;
+    dir__RL,dir__RR: begin
+      dvi_left(c_wd);
+      dvi_down(c_ht);
+      dvi_put(c);
+      dvi_up(c_ht);
+      end;
+    dir__TT,dir__TB: begin
+      dvi_down(c_wd);
+      dvi_left(c_ht);
+      dvi_put(c);
+      dvi_right(c_ht);
+      end;
+    dir__BT,dir__BB: begin
+      dvi_left(c_ht);
+      dvi_put(c);
+      dvi_right(c_ht);
+      dvi_up(c_wd);
+      end;
+     end;
+    end;
+  p:=vlink(p);
+  until not is_char_node(p);
+  dvi_h:=cur_h;
+  end
+else @<Output the non-|char_node| |p| for |hlist_out|
+    and move to the next node@>
+
+@ @<Change font |dvi_f| to |f|@>=
+begin if not font_used(f) then
+  begin dvi_font_def(f); set_font_used(f,true);
+  end;
+oval:=f-font_base-1; ocmd:=fnt1; out_cmd;@/
+dvi_f:=f;
+end
+
+@ @<Output the non-|char_node| |p| for |hlist_out|...@>=
+begin case type(p) of
+hlist_node,vlist_node:@<Output a box in an hlist@>;
+rule_node: begin
+  if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+    then begin
+    rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+    end
+  else begin
+    rule_ht:=width(p) div 2;
+    rule_dp:=width(p) div 2;
+    rule_wd:=height(p)+depth(p);
+    end;
+  goto fin_rule;
+  end;
+whatsit_node: @<Output the whatsit node |p| in an hlist@>;
+glue_node: @<Move right or output leaders@>;
+disc_node: if vlink(no_break(p))<>null then begin
+  vlink(tlink(no_break(p))):=vlink(p);
+  q:=vlink(no_break(p)); 
+  vlink(no_break(p)):=null;
+  vlink(p):=q; 
+  end;
+margin_kern_node,kern_node:cur_h:=cur_h+width(p);
+math_node:cur_h:=cur_h+surround(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in an hlist@>;
+move_past: cur_h:=cur_h+rule_wd;
+next_p:p:=vlink(p);
+end
+
+@ @<Output a box in an hlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+  then begin
+  effective_horizontal:=width(p);
+  basepoint_vertical:=0;
+  if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+    basepoint_horizontal:=width(p)
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  effective_horizontal:=height(p)+depth(p);
+  if not (is_mirrored(box_dir(p))) then
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(p)
+    else
+      basepoint_horizontal:=depth(p)
+  else
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(p)
+    else
+      basepoint_horizontal:=height(p);
+  if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:= -(width(p) div 2)
+  else
+    basepoint_vertical:= (width(p) div 2);
+  end;
+if not (is_mirrored(dvi_direction)) then
+  basepoint_vertical := basepoint_vertical + shift_amount(p)
+    {shift the box `down'}
+else
+  basepoint_vertical := basepoint_vertical - shift_amount(p);
+    {shift the box `up'}
+if list_ptr(p)=null then cur_h:=cur_h + effective_horizontal
+else begin
+  temp_ptr:=p; edge:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+  edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+  synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+  if type(p)=vlist_node then vlist_out@+else hlist_out;
+  dvi_h:=save_h; dvi_v:=save_v;
+  cur_h:=edge+effective_horizontal; cur_v:=base_line;
+  end
+end
+
+@ @<Output a rule in an hlist@>=
+if is_running(rule_ht) then rule_ht:=height(this_box);
+if is_running(rule_dp) then rule_dp:=depth(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+  begin synch_h; cur_v:=base_line+rule_dp; synch_v;
+  case font_direction(dvi_direction) of
+  dir__LT: begin
+    dvi_set_rule(rule_ht)(rule_wd);
+    end;
+  dir__LB: begin
+    dvi_down(rule_ht);
+    dvi_set_rule(rule_ht)(rule_wd);
+    dvi_up(rule_ht);
+    end;
+  dir__RT: begin
+    dvi_left(rule_wd);
+    dvi_put_rule(rule_ht)(rule_wd);
+    end;
+  dir__RB: begin
+    dvi_left(rule_wd);
+    dvi_down(rule_ht);
+    dvi_put_rule(rule_ht)(rule_wd);
+    dvi_up(rule_ht);
+    end;
+  dir__TL: begin
+    dvi_down(rule_wd);
+    dvi_left(rule_ht);
+    dvi_set_rule(rule_wd)(rule_ht);
+    end;
+  dir__TR: begin
+    dvi_down(rule_wd);
+    dvi_put_rule(rule_wd)(rule_ht);
+    end;
+  dir__BL: begin
+    dvi_left(rule_ht);
+    dvi_set_rule(rule_wd)(rule_ht);
+    dvi_up(rule_wd);
+    end;
+  dir__BR: begin
+    dvi_put_rule(rule_wd)(rule_ht);
+    dvi_up(rule_wd);
+    end;
+  end;
+  cur_v:=base_line; dvi_h:=dvi_h+rule_wd;
+  end
+
+@ @d billion==float_constant(1000000000)
+@d vet_glue(#)== glue_temp:=#;
+  if glue_temp>billion then
+           glue_temp:=billion
+  else if glue_temp<-billion then
+           glue_temp:=-billion
+
+@<Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+if g_sign<>normal then
+  begin if g_sign=stretching then
+    begin if stretch_order(g)=g_order then
+      begin cur_glue:=cur_glue+stretch(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+      cur_g:=round(glue_temp);
+      end;
+    end
+  else if shrink_order(g)=g_order then
+      begin cur_glue:=cur_glue-shrink(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+      cur_g:=round(glue_temp);
+      end;
+  end;
+rule_wd:=rule_wd+cur_g;
+
+if subtype(p)>=a_leaders then
+  @<Output leaders in an hlist, |goto fin_rule| if a rule
+    or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<Output leaders in an hlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+  begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
+  goto fin_rule;
+  end;
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then leader_wd:=width(leader_box)
+else
+  leader_wd:=height(leader_box)+depth(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+  begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
+  edge:=cur_h+rule_wd; lx:=0;
+  @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
+    to the spacing between corresponding parts of boxes@>;
+  while cur_h+leader_wd<=edge do
+    @<Output a leader box at |cur_h|,
+      then advance |cur_h| by |leader_wd+lx|@>;
+  cur_h:=edge-10; goto next_p;
+  end;
+end
+
+@ The calculations related to leaders require a bit of care. First, in the
+case of |a_leaders| (aligned leaders), we want to move |cur_h| to
+|left_edge| plus the smallest multiple of |leader_wd| for which the result
+is not less than the current value of |cur_h|; i.e., |cur_h| should become
+$|left_edge|+|leader_wd|\times\lceil
+(|cur_h|-|left_edge|)/|leader_wd|\rceil$.  The program here should work in
+all cases even though some implementations of \PASCAL\ give nonstandard
+results for the |div| operation when |cur_h| is less than |left_edge|.
+
+In the case of |c_leaders| (centered leaders), we want to increase |cur_h|
+by half of the excess space not occupied by the leaders; and in the
+case of |x_leaders| (expanded leaders) we increase |cur_h|
+by $1/(q+1)$ of this excess space, where $q$ is the number of times the
+leader box will be replicated. Slight inaccuracies in the division might
+accumulate; half of this rounding error is placed at each end of the leaders.
+
+@<Let |cur_h| be the position of the first box, ...@>=
+if subtype(p)=a_leaders then
+  begin save_h:=cur_h;
+  cur_h:=left_edge+leader_wd*((cur_h-left_edge)@!div leader_wd);
+  if cur_h<save_h then cur_h:=cur_h+leader_wd;
+  end
+else  begin lq:=rule_wd div leader_wd; {the number of box copies}
+  lr:=rule_wd mod leader_wd; {the remaining space}
+  if subtype(p)=c_leaders then cur_h:=cur_h+(lr div 2)
+  else  begin lx:=lr div (lq+1);
+    cur_h:=cur_h+((lr-(lq-1)*lx) div 2);
+    end;
+  end
+
+@ The `\\{synch}' operations here are intended to decrease the number of
+bytes needed to specify horizontal and vertical motion in the \.{DVI} output.
+
+@<Output a leader box at |cur_h|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then begin
+  basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+    basepoint_horizontal:=width(leader_box)
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  if not (is_mirrored(box_dir(leader_box))) then
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(leader_box)
+    else
+      basepoint_horizontal:=depth(leader_box)
+  else
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(leader_box)
+    else
+      basepoint_horizontal:=height(leader_box);
+  if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:= -(width(leader_box) div 2)
+  else
+    basepoint_vertical:= (width(leader_box) div 2);
+  end;
+if not (is_mirrored(dvi_direction)) then
+  basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
+    {shift the box `down'}
+else
+  basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
+    {shift the box `up'}
+temp_ptr:=leader_box;
+edge_h:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=edge_h+leader_wd+lx; cur_v:=base_line;
+end
+
+@ The |vlist_out| routine is similar to |hlist_out|, but a bit simpler.
+
+@p procedure vlist_out; {output a |vlist_node| box}
+label move_past, fin_rule, next_p;
+var left_edge: scaled; {the left coordinate for this box}
+@!top_edge: scaled; {the top coordinate for this box}
+@!save_h,@!save_v: scaled; {what |dvi_h| and |dvi_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the vlist}
+@!save_loc:integer; {\.{DVI} byte location upon entry}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_ht:scaled; {height of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {bottom boundary of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_direction: integer;
+@!effective_vertical: scaled;
+@!basepoint_horizontal: scaled;
+@!basepoint_vertical: scaled;
+@!edge_v: scaled;
+@!saving_v: scaled;
+@!saving_h: scaled;
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+{pdfassert(p<>0);}
+saving_v:=dvi_v; saving_h:=dvi_h;
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+incr(cur_s);
+if cur_s>0 then dvi_out(push);
+if cur_s>max_push then max_push:=cur_s;
+save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box);
+top_edge:=cur_v;
+while p<>null do @<Output node |p| for |vlist_out| and move to the next node,
+  maintaining the condition |cur_h=left_edge|@>;
+cur_v:=saving_v; cur_h:=saving_h;
+synch_v; synch_h;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+dvi_direction:=save_direction;
+end;
+
+@ @<Output node |p| for |vlist_out|...@>=
+begin if is_char_node(p) then begin print_font_and_char(p); confusion("vlistout"); end
+@:this can't happen vlistout}{\quad vlistout@>
+else @<Output the non-|char_node| |p| for |vlist_out|@>;
+next_p:p:=vlink(p);
+end
+
+@ @<Output the non-|char_node| |p| for |vlist_out|@>=
+begin case type(p) of
+hlist_node,vlist_node:@<Output a box in a vlist@>;
+rule_node: begin
+  if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+    then begin
+    rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+    end
+  else begin
+    rule_ht:=width(p) div 2;
+    rule_dp:=width(p) div 2;
+    rule_wd:=height(p)+depth(p);
+    end;
+  goto fin_rule;
+  end;
+whatsit_node: @<Output the whatsit node |p| in a vlist@>;
+glue_node: @<Move down or output leaders@>;
+kern_node:cur_v:=cur_v+width(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<Output a rule in a vlist, |goto next_p|@>;
+move_past: cur_v:=cur_v+rule_ht;
+end
+
+@ The |synch_v| here allows the \.{DVI} output to use one-byte commands
+for adjusting |v| in most cases, since the baselineskip distance will
+usually be constant.
+
+@<Output a box in a vlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+  then begin
+  effective_vertical:=height(p)+depth(p);
+  if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then
+    basepoint_vertical:=depth(p)
+  else
+    basepoint_vertical:=height(p);
+  if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+    basepoint_horizontal:=width(p)
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  effective_vertical:=width(p);
+  if not (is_mirrored(box_dir(p))) then
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(p)
+    else
+      basepoint_horizontal:=depth(p)
+  else
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(p)
+    else
+      basepoint_horizontal:=height(p);
+  if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:=0
+  else
+    basepoint_vertical:=width(p);
+  end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+  {shift the box `right'}
+if list_ptr(p)=null then begin
+  cur_v:=cur_v+effective_vertical;
+  end
+else  begin
+  synch_h; synch_v; edge_v:=cur_v;
+  cur_h:=left_edge + basepoint_horizontal;
+  cur_v:=cur_v + basepoint_vertical;
+  synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+  temp_ptr:=p;
+  if type(p)=vlist_node then vlist_out@+else hlist_out;
+  dvi_h:=save_h; dvi_v:=save_v;
+  cur_h:=left_edge; cur_v:=edge_v + effective_vertical;
+  end
+end
+
+@ @<Output a rule in a vlist...@>=
+if is_running(rule_wd) then rule_wd:=width(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+  begin synch_h; synch_v;
+  case font_direction(dvi_direction) of
+  dir__LT: begin
+    dvi_put_rule(rule_ht)(rule_wd);
+    end;
+  dir__LB: begin
+    dvi_down(rule_ht);
+    dvi_put_rule(rule_ht)(rule_wd);
+    dvi_up(rule_ht);
+    end;
+  dir__RT: begin
+    dvi_left(rule_wd);
+    dvi_set_rule(rule_ht)(rule_wd);
+    end;
+  dir__RB: begin
+    dvi_down(rule_ht);
+    dvi_left(rule_wd);
+    dvi_set_rule(rule_ht)(rule_wd);
+    dvi_up(rule_ht);
+    end;
+  dir__TL: begin
+    dvi_down(rule_wd);
+    dvi_left(rule_ht);
+    dvi_set_rule(rule_wd)(rule_ht);
+    dvi_up(rule_wd);
+    end;
+  dir__TR: begin
+    dvi_down(rule_wd);
+    dvi_put_rule(rule_wd)(rule_ht);
+    dvi_up(rule_wd);
+    end;
+  dir__BL: begin
+    dvi_left(rule_ht);
+    dvi_set_rule(rule_wd)(rule_ht);
+    end;
+  dir__BR: begin
+    dvi_put_rule(rule_wd)(rule_ht);
+    end;
+  end;
+  end;
+goto next_p
+
+@ @<Move down or output leaders@>=
+begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
+if g_sign<>normal then
+  begin if g_sign=stretching then
+    begin if stretch_order(g)=g_order then
+      begin cur_glue:=cur_glue+stretch(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+      cur_g:=round(glue_temp);
+      end;
+    end
+  else if shrink_order(g)=g_order then
+      begin cur_glue:=cur_glue-shrink(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+      cur_g:=round(glue_temp);
+      end;
+  end;
+rule_ht:=rule_ht+cur_g;
+if subtype(p)>=a_leaders then
+  @<Output leaders in a vlist, |goto fin_rule| if a rule
+    or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<Output leaders in a vlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+  begin rule_wd:=width(leader_box); rule_dp:=0;
+  goto fin_rule;
+  end;
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then leader_ht:=height(leader_box)+depth(leader_box)
+else
+  leader_ht:=width(leader_box);
+if (leader_ht>0)and(rule_ht>0) then
+  begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
+  edge:=cur_v+rule_ht; lx:=0;
+  @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
+    to the spacing between corresponding parts of boxes@>;
+  while cur_v+leader_ht<=edge do
+    @<Output a leader box at |cur_v|,
+      then advance |cur_v| by |leader_ht+lx|@>;
+  cur_v:=edge-10; goto next_p;
+  end;
+end
+
+@ @<Let |cur_v| be the position of the first box, ...@>=
+if subtype(p)=a_leaders then
+  begin save_v:=cur_v;
+  cur_v:=top_edge+leader_ht*((cur_v-top_edge)@!div leader_ht);
+  if cur_v<save_v then cur_v:=cur_v+leader_ht;
+  end
+else  begin lq:=rule_ht div leader_ht; {the number of box copies}
+  lr:=rule_ht mod leader_ht; {the remaining space}
+  if subtype(p)=c_leaders then cur_v:=cur_v+(lr div 2)
+  else  begin lx:=lr div (lq+1);
+    cur_v:=cur_v+((lr-(lq-1)*lx) div 2);
+    end;
+  end
+
+@ When we reach this part of the program, |cur_v| indicates the top of a
+leader box, not its baseline.
+
+@<Output a leader box at |cur_v|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then begin
+  effective_vertical:=height(leader_box)+depth(leader_box);
+  if (type(leader_box)=hlist_node) and (is_mirrored(box_dir(leader_box))) then
+    basepoint_vertical:=depth(leader_box)
+  else
+    basepoint_vertical:=height(leader_box);
+  if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+    basepoint_horizontal:=width(leader_box)
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  effective_vertical:=width(leader_box);
+  if not (is_mirrored(box_dir(leader_box))) then
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(leader_box)
+    else
+      basepoint_horizontal:=depth(leader_box)
+  else
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(leader_box)
+    else
+      basepoint_horizontal:=height(leader_box);
+  if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:= width(leader_box)
+  else
+    basepoint_vertical:= 0;
+  end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(leader_box);
+  {shift the box `right'}
+temp_ptr:=leader_box;
+cur_h:=left_edge + basepoint_horizontal;
+edge_v:=cur_v ;
+cur_v:=cur_v + basepoint_vertical;
+synch_h; synch_v; save_h:=dvi_h; save_v:=dvi_v;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then vlist_out@+else hlist_out;
+doing_leaders:=outer_doing_leaders;
+dvi_h:=save_h; dvi_v:=save_v;
+cur_h:=left_edge; cur_v:=edge_v+leader_ht+lx;
+end
+
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |dvi_ship_out| routine that gets them started in the first place.
+
+@p procedure dvi_ship_out(@!p:pointer); {output the box |p|}
+label done;
+var page_loc:integer; {location of the current |bop|}
+@!j,@!k:0..9; {indices to first ten count registers}
+@!s:pool_pointer; {index into |str_pool|}
+@!old_setting:0..max_selector; {saved |selector| setting}
+pre_callback_id:integer;
+post_callback_id:integer;
+ret:boolean;
+begin 
+pre_callback_id:=callback_defined(start_page_number_callback);	
+post_callback_id:=callback_defined(stop_page_number_callback);	
+if (tracing_output>0)and(pre_callback_id=0) then
+  begin print_nl(""); print_ln;
+  print("Completed box being shipped out");
+@.Completed box...@>
+  end;
+if pre_callback_id>0 then
+  ret:=run_callback(pre_callback_id,'->')
+else begin
+  if term_offset>max_print_line-9 then print_ln
+  else if (term_offset>0)or(file_offset>0) then print_char(" ");
+  print_char("["); j:=9;
+  while (count(j)=0)and(j>0) do decr(j);
+  for k:=0 to j do
+    begin print_int(count(k));
+    if k<j then print_char(".");
+    end;
+  end;
+update_terminal;
+if (tracing_output>0)and(post_callback_id=0) then 
+  begin print_char("]");
+  begin_diagnostic; show_box(p); end_diagnostic(true);
+  end;
+@<Ship box |p| out@>;
+if (tracing_output<=0)and(post_callback_id=0) then 
+  print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+if post_callback_id>0 then 
+  ret:=run_callback(post_callback_id,'->');
+end;
+
+@ @<Flush the box from memory, showing statistics if requested@>=
+@!stat if (tracing_stats>1)and(pre_callback_id=0) then
+  begin print_nl("Memory usage before: ");
+@.Memory usage...@>
+  print_int(var_used); print_char("&");
+  print_int(dyn_used); print_char(";");
+  end;
+tats@/
+flush_node_list(p);
+@!stat if (tracing_stats>1)and(post_callback_id=0) then
+  begin print(" after: ");
+  print_int(var_used); print_char("&");
+  print_int(dyn_used); print_ln;
+  end;
+tats
+
+@ @<Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+  |goto done|@>;
+@<Initialize variables as |ship_out| begins@>;
+page_loc:=dvi_offset+dvi_ptr;
+dvi_out(bop);
+for k:=0 to 9 do dvi_four(count(k));
+dvi_four(last_bop); last_bop:=page_loc;
+dvi_direction:=page_direction;
+case box_direction(dvi_direction) of
+dir_TL_,dir_LT_: begin
+  end;
+dir_TR_,dir_RT_: begin
+  dvi_right(cur_page_width-cur_right_offset);
+  dvi_h:=-cur_right_offset;
+  end;
+dir_RB_,dir_BR_: begin
+  dvi_right(cur_page_width-cur_right_offset);
+  dvi_down(cur_page_height-cur_bottom_offset);
+  dvi_h:=-cur_right_offset;
+  dvi_v:=-cur_bottom_offset;
+  end;
+dir_BL_,dir_LB_: begin
+  dvi_down(cur_page_height-cur_bottom_offset);
+  dvi_v:=-cur_bottom_offset;
+  end;
+end;
+cur_h:=h_offset;
+cur_v:=height(p)+v_offset;
+case box_direction(dvi_direction) of
+dir_TL_: begin
+  dvi_down(cur_v);
+  dvi_right(cur_h);
+  end;
+dir_TR_: begin
+  dvi_down(cur_v);
+  dvi_right(-cur_h);
+  end;
+dir_LT_: begin
+  dvi_right(cur_v);
+  dvi_down(cur_h);
+  end;
+dir_LB_: begin
+  dvi_right(cur_v);
+  dvi_down(-cur_h);
+  end;
+dir_BL_: begin
+  dvi_down(-cur_v);
+  dvi_right(cur_h);
+  end;
+dir_BR_: begin
+  dvi_down(-cur_v);
+  dvi_right(-cur_h);
+  end;
+dir_RT_: begin
+  dvi_right(-cur_v);
+  dvi_down(cur_h);
+  end;
+dir_RB_: begin
+  dvi_right(-cur_v);
+  dvi_down(-cur_h);
+  end;
+end;
+dvi_h:=cur_h;
+dvi_v:=cur_v;
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+done:
+
+@ Sometimes the user will generate a huge page because other error messages
+are being ignored. Such pages are not output to the \.{dvi} file, since they
+may confuse the printing software.
+
+@<Update the values of |max_h| and |max_v|; but if the page is too large...@>=
+if (height(p)>max_dimen)or@|(depth(p)>max_dimen)or@|
+   (height(p)+depth(p)+v_offset>max_dimen)or@|
+   (width(p)+h_offset>max_dimen) then
+  begin print_err("Huge page cannot be shipped out");
+@.Huge page...@>
+  help2("The page just created is more than 18 feet tall or")@/
+   ("more than 18 feet wide, so I suspect something went wrong.");
+  error;
+  if tracing_output<=0 then
+    begin begin_diagnostic;
+    print_nl("The following box has been deleted:");
+@.The following...deleted@>
+    show_box(p);
+    end_diagnostic(true);
+    end;
+  goto done;
+  end;
+if height(p)+depth(p)+v_offset>max_v then max_v:=height(p)+depth(p)+v_offset;
+if width(p)+h_offset>max_h then max_h:=width(p)+h_offset
+
+@ At the end of the program, we must finish things off by writing the
+post\-amble. If |total_pages=0|, the \.{DVI} file was never opened.
+If |total_pages>=65536|, the \.{DVI} file will lie.
+
+An integer variable |k| will be declared for use by this routine.
+
+@<Finish the \.{DVI} file@>=
+while cur_s>-1 do
+  begin if cur_s>0 then dvi_out(pop)
+  else  begin dvi_out(eop); incr(total_pages);
+    end;
+  decr(cur_s);
+  end;
+if total_pages=0 then begin 
+  if callback_id=0 then
+    print_nl("No pages of output.")
+  else
+    res:=run_callback(callback_id,'->');
+  end
+@.No pages of output@>
+else  begin dvi_out(post); {beginning of the postamble}
+  dvi_four(last_bop); last_bop:=dvi_offset+dvi_ptr-5; {|post| location}
+  dvi_four(25400000); dvi_four(473628672); {conversion ratio for sp}
+  prepare_mag; dvi_four(mag); {magnification factor}
+  dvi_four(max_v); dvi_four(max_h);@/
+  dvi_out(max_push div 256); dvi_out(max_push mod 256);@/
+  dvi_out((total_pages div 256) mod 256); dvi_out(total_pages mod 256);@/
+  @<Output the font definitions for all fonts that were used@>;
+  dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/
+  k:=4+((dvi_buf_size-dvi_ptr) mod 4); {the number of 223's}
+  while k>0 do
+    begin dvi_out(223); decr(k);
+    end;
+  @<Empty the last bytes out of |dvi_buf|@>;
+  if callback_id=0 then begin
+    print_nl("Output written on "); slow_print(output_file_name);
+@.Output written on x@>
+    print(" ("); print_int(total_pages); print(" page");
+    if total_pages<>1 then print_char("s");
+    print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
+    end
+  else
+    res:=run_callback(callback_id,'->');
+  b_close(dvi_file);
+  end
+
+@ @<Output the font definitions...@>=
+k := max_font_id;
+while k>0 do
+  begin if font_used(k) then dvi_font_def(k);
+  decr(k);
+  end
+
+
+@* \[32a] \pdfTeX\ basic.
+
+Initialize \pdfTeX's parameters to some useful default value.
+Helpful in case one forgets to set them during initex run.
+
+@<Initialize table entries...@>=
+pdf_h_origin := one_inch;
+pdf_v_origin := one_inch;
+pdf_compress_level := 9;
+pdf_objcompresslevel := 0;
+pdf_decimal_digits := 3;
+pdf_image_resolution := 72;
+pdf_minor_version := 4;
+pdf_gamma := 1000;
+pdf_image_gamma := 2200;
+pdf_image_hicolor := 1;
+pdf_image_apply_gamma := 0;
+pdf_px_dimen := one_bp;
+pdf_draftmode := 0;
+
+@ The subroutines define the corresponding macros so we can use them
+in C.
+
+@d flushable(#) == (# = str_ptr - 1)
+
+@d is_valid_char(#) == char_exists(f,#)
+
+@p function get_pdf_compress_level: integer;
+begin
+    get_pdf_compress_level := pdf_compress_level;
+end;
+
+function get_nullfont: internal_font_number;
+begin
+    get_nullfont := null_font;
+end;
+
+function get_escape_char: integer;
+begin
+    get_escape_char := escape_char;
+end;
+
+function get_undefined_control_sequence: integer;
+begin
+    get_undefined_control_sequence := undefined_control_sequence;
+end;
+
+function get_fontbase: internal_font_number;
+begin
+    get_fontbase := font_base;
+end;
+
+function get_nullcs: pointer;
+begin
+    get_nullcs := null_cs;
+end;
+
+function get_nullptr: pointer;
+begin
+    get_nullptr := null;
+end;
+
+function get_tex_int(code: integer): integer;
+begin
+    get_tex_int := int_par(code);
+end;
+
+function get_tex_dimen(code: integer): scaled;
+begin
+    get_tex_dimen := dimen_par(code);
+end;
+
+function get_x_height(f: internal_font_number): scaled;
+begin
+    get_x_height := x_height(f);
+end;
+
+function get_charwidth(f: internal_font_number; c: integer): scaled;
+begin
+    if is_valid_char(c) then
+        get_charwidth := char_width(f,c)
+    else
+        get_charwidth := 0;
+end;
+
+function get_charheight(f: internal_font_number; c: integer): scaled;
+begin
+    if is_valid_char(c) then
+        get_charheight := char_height(f,c)
+    else
+        get_charheight := 0;
+end;
+
+function get_chardepth(f: internal_font_number; c: integer): scaled;
+begin
+    if is_valid_char(c) then
+        get_chardepth := char_depth(f,c)
+    else
+        get_chardepth := 0;
+end;
+
+function get_quad(f: internal_font_number): scaled;
+begin
+    get_quad := quad(f);
+end;
+
+function get_slant(f: internal_font_number): scaled;
+begin
+    get_slant := slant(f);
+end;
+
+function new_dummy_font: internal_font_number;
+begin
+    new_dummy_font := read_font_info(null_cs, "dummy", "", -1000, -1);
+end;
+
+function get_hash_size: integer;
+begin
+  get_hash_size:= hash_size;
+end;
+
+function get_eqtb_size: integer;
+begin
+  get_eqtb_size:= eqtb_size;
+end;
+
+function get_hash_base: integer;
+begin
+  get_hash_base:= hash_base;
+end;
+
+function get_active_base: integer;
+begin
+  get_active_base:= active_base;
+end;
+
+function get_cur_font: internal_font_number;
+begin
+  get_cur_font:= cur_font;
+end;
+
+procedure set_cur_font (f: internal_font_number);
+var a:small_number;
+begin
+  a:=0;
+  define(cur_font_loc,data,f);
+end;
+
+function get_current_name: str_number;
+begin
+  get_current_name:= name;
+end;
+
+
+@ Helper for debugging purposes
+
+@p procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
+var i: integer;
+begin
+i := 0;
+font_in_short_display:=null_font;
+if p = null then
+    return;
+while p<>null do
+  begin if is_char_node(p) then
+    begin if p<=max_halfword then
+      begin if font(p)<>font_in_short_display then
+        begin if not is_valid_font(font(p)) then
+          print_char("*")
+@.*\relax@>
+        else print_font_identifier(font(p));
+        print_char(" "); font_in_short_display:=font(p);
+        end;
+      print(qo(character(p)));
+      end;
+    end
+  else begin
+      if (type(p) = glue_node) or
+         (type(p) = disc_node) or
+         (type(p) = penalty_node) or
+         ((type(p) = kern_node) and (subtype(p) = explicit)) then
+         incr(i);
+      if i >= m then
+         return;
+      if (type(p) = disc_node) then begin
+          print("|");
+          short_display(vlink(pre_break(p)));
+          print("|");
+          short_display(vlink(post_break(p)));
+          print("|");
+        end
+        else
+            @<Print a short indication of the contents of node |p|@>;
+  end;
+  p:=vlink(p);
+  if p = null then
+      return;
+  end;
+  update_terminal;
+end;
+
+@ Sometimes it is neccesary to allocate memory for PDF output that cannot
+be deallocated then, so we use |pdf_mem| for this purpose.
+
+@<Constants...@>=
+@!inf_pdf_mem_size = 10000; {min size of the |pdf_mem| array}
+@!sup_pdf_mem_size = 10000000; {max size of the |pdf_mem| array}
+
+@ @<Glob...@>=
+@!pdf_mem_size: integer;
+@!pdf_mem: ^integer;
+@!pdf_mem_ptr: integer;
+
+@ @<Set init...@>=
+pdf_mem_ptr := 1; {the first word is not used so we can use zero as a value for testing
+whether a pointer to |pdf_mem| is valid}
+pdf_mem_size := inf_pdf_mem_size; {allocated size of |pdf_mem| array}
+
+@ We use |pdf_get_mem| to allocate memory in |pdf_mem|
+
+@p function pdf_get_mem(s: integer): integer; {allocate |s| words in |pdf_mem|}
+var a: integer;
+begin
+    if s > sup_pdf_mem_size - pdf_mem_ptr then
+        overflow("PDF memory size (pdf_mem_size)", pdf_mem_size);
+    if pdf_mem_ptr + s > pdf_mem_size then begin
+        a := 0.2 * pdf_mem_size;
+        if pdf_mem_ptr + s > pdf_mem_size + a then
+            pdf_mem_size := pdf_mem_ptr + s
+        else if pdf_mem_size < sup_pdf_mem_size - a then
+            pdf_mem_size := pdf_mem_size + a
+        else
+            pdf_mem_size := sup_pdf_mem_size;
+        pdf_mem := xreallocarray(pdf_mem, integer, pdf_mem_size);
+    end;
+    pdf_get_mem := pdf_mem_ptr;
+    pdf_mem_ptr := pdf_mem_ptr + s;
+end;
+
+@* \[32b] \pdfTeX\ output low-level subroutines.
+We use the similiar subroutines to handle the output buffer for
+PDF output. When compress is used, the state of writing to buffer
+is held in |zip_write_state|. We must write the header of PDF
+output file in initialization to ensure that it will be the first
+written bytes.
+
+@<Constants...@>=
+@!pdf_op_buf_size = 16384; {size of the PDF output buffer}
+@!inf_pdf_os_buf_size = 1; {initial value of |pdf_os_buf_size|}
+@!sup_pdf_os_buf_size = 5000000; {arbitrary upper hard limit of |pdf_os_buf_size|}
+@!pdf_os_max_objs = 100; {maximum number of objects in object stream}
+
+@ The following macros are similar as for \.{DVI} buffer handling
+
+@d pdf_offset == (pdf_gone + pdf_ptr) {the file offset of last byte in PDF
+buffer that |pdf_ptr| points to}
+
+@d no_zip == 0 {no \.{ZIP} compression}
+@d zip_writing == 1 {\.{ZIP} compression being used}
+@d zip_finish == 2 {finish \.{ZIP} compression}
+
+@d pdf_quick_out(#) == {output a byte to PDF buffer without checking of
+overflow}
+begin
+    pdf_buf[pdf_ptr] := #;
+    incr(pdf_ptr);
+end
+
+@d pdf_room(#) == {make sure that there are at least |n| bytes free in PDF buffer}
+begin
+    if pdf_os_mode and (# + pdf_ptr > pdf_buf_size) then
+        pdf_os_get_os_buf(#)
+    else if not pdf_os_mode and (# > pdf_buf_size) then
+        overflow("PDF output buffer", pdf_op_buf_size)
+    else if not pdf_os_mode and (# + pdf_ptr > pdf_buf_size) then
+        pdf_flush;
+end
+
+@d pdf_out(#) == {do the same as |pdf_quick_out| and flush the PDF
+buffer if necessary}
+begin
+    pdf_room(1);
+    pdf_quick_out(#);
+end
+
+@<Glob...@>=
+@!pdf_file: byte_file; {the PDF output file}
+@!pdf_buf: ^real_eight_bits; {pointer to the PDF output buffer or PDF object stream buffer}
+@!pdf_buf_size: integer; {end of PDF output buffer or PDF object stream buffer}
+@!pdf_ptr: integer; {pointer to the first unused byte in the PDF buffer or object stream buffer}
+@!pdf_op_buf: ^real_eight_bits; {the PDF output buffer}
+@!pdf_os_buf: ^real_eight_bits; {the PDF object stream buffer}
+@!pdf_os_buf_size: integer; {current size of the PDF object stream buffer, grows dynamically}
+@!pdf_os_objnum: ^integer; {array of object numbers within object stream}
+@!pdf_os_objoff: ^integer; {array of object offsets within object stream}
+@!pdf_os_objidx: pointer; {pointer into |pdf_os_objnum| and |pdf_os_objoff|}
+@!pdf_os_cntr: integer; {counter for object stream objects}
+@!pdf_op_ptr: integer; {store for PDF buffer |pdf_ptr| while inside object streams}
+@!pdf_os_ptr: integer; {store for object stream |pdf_ptr| while outside object streams}
+@!pdf_os_mode: boolean; {true if producing object stream}
+@!pdf_os_enable: boolean; {true if object streams are globally enabled}
+@!pdf_os_cur_objnum: integer; {number of current object stream object}
+@!pdf_gone: integer; {number of bytes that were flushed to output}
+@!pdf_save_offset: integer; {to save |pdf_offset|}
+@!zip_write_state: integer; {which state of compression we are in}
+@!fixed_pdf_minor_version: integer; {fixed minor part of the PDF version}
+@!fixed_pdf_objcompresslevel: integer; {fixed level for activating PDF object streams}
+@!pdf_minor_version_written: boolean; {flag if the PDF version has been written}
+@!fixed_pdfoutput: integer; {fixed output format}
+@!fixed_pdfoutput_set: boolean; {|fixed_pdfoutput| has been set?}
+@!fixed_gamma: integer;
+@!fixed_image_gamma: integer;
+@!fixed_image_hicolor: boolean;
+@!fixed_image_apply_gamma: integer;
+@!epochseconds: integer;
+@!microseconds: integer;
+@!fixed_pdf_draftmode: integer; {fixed \\pdfdraftmode}
+@!fixed_pdf_draftmode_set: boolean; {|fixed_pdf_draftmode| has been set?}
+
+
+@ @<Set init...@>=
+pdf_gone := 0;
+pdf_os_mode := false;
+pdf_ptr := 0;
+pdf_op_ptr := 0;
+pdf_os_ptr := 0;
+pdf_os_cur_objnum := 0;
+pdf_os_cntr := 0;
+pdf_buf_size := pdf_op_buf_size;
+pdf_os_buf_size := inf_pdf_os_buf_size;
+pdf_buf := pdf_op_buf;
+pdf_seek_write_length := false;
+zip_write_state := no_zip;
+pdf_minor_version_written := false;
+fixed_pdfoutput_set := false;
+fixed_pdf_draftmode_set := false;
+
+@ @p
+function fix_int(val, min, max: integer): integer;
+begin
+    if val < min then
+        fix_int := min
+    else if val > max then
+        fix_int := max
+    else
+        fix_int := val;
+end;
+
+@ This ensures that |pdfminorversion| is set only before any bytes have
+been written to the generated PDF file. Here also the PDF file is opened
+by |ensure_pdf_open| and the PDF header is written.
+
+@p procedure check_pdfminorversion;
+begin
+    if not pdf_minor_version_written then begin
+        pdf_minor_version_written := true;
+        if (pdf_minor_version < 0) or (pdf_minor_version > 9) then begin
+            print_err("pdfTeX error (illegal pdfminorversion)");
+            print_ln;
+            help2 ("The pdfminorversion must be between 0 and 9.")@/
+                ("I changed this to 4.");
+            int_error (pdf_minor_version);
+            pdf_minor_version := 4;
+        end;
+        fixed_pdf_minor_version := pdf_minor_version;
+        fixed_gamma             := fix_int(pdf_gamma, 0, 1000000);
+        fixed_image_gamma       := fix_int(pdf_image_gamma, 0, 1000000);
+        fixed_image_hicolor     := fix_int(pdf_image_hicolor, 0, 1);
+        fixed_image_apply_gamma := fix_int(pdf_image_apply_gamma, 0, 1);
+        fixed_pdf_objcompresslevel := fix_int(pdf_objcompresslevel, 0, 3);
+        fixed_pdf_draftmode     := fix_int(pdf_draftmode, 0, 1);
+		fixed_replace_font      := fix_int(pdf_replace_font, 0, 1);
+        if (fixed_pdf_minor_version >= 5) and (fixed_pdf_objcompresslevel > 0) then
+            pdf_os_enable := true
+        else begin
+            if fixed_pdf_objcompresslevel > 0 then begin
+                pdf_warning("Object streams", "\pdfobjcompresslevel > 0 requires \pdfminorversion > 4. Object streams disabled now.", true, true);
+                fixed_pdf_objcompresslevel := 0;
+            end;
+            pdf_os_enable := false;
+        end;
+        ensure_pdf_open;
+        fix_pdfoutput;
+        pdf_print("%PDF-1.");
+        pdf_print_int_ln(fixed_pdf_minor_version);
+        pdf_print("%");
+        pdf_out(208); {'P' + 128}
+        pdf_out(212); {'T' + 128}
+        pdf_out(197); {'E' + 128}
+        pdf_out(216); {'X' + 128}
+        pdf_print_nl;
+    end
+    else begin
+        if fixed_pdf_minor_version <> pdf_minor_version then
+            pdf_error("setup",
+               "\pdfminorversion cannot be changed after data is written to the PDF file");
+    end;
+end;
+
+@ Checks that we have a name for the generated PDF file and that it's open.
+
+@p procedure ensure_pdf_open;
+begin
+    if output_file_name <> 0 then
+        return;
+    if job_name = 0 then
+        open_log_file;
+    pack_job_name(".pdf");
+	if fixed_pdf_draftmode = 0 then
+    while not lua_b_open_out(pdf_file) do
+        prompt_file_name("file name for output",".pdf");
+    pdf_file:=name_file_pointer;
+    output_file_name := b_make_name_string(pdf_file);
+end;
+
+@ The PDF buffer is flushed by calling |pdf_flush|, which checks the
+variable |zip_write_state| and will compress the buffer before flushing if
+neccesary. We call |pdf_begin_stream| to begin a stream  and |pdf_end_stream|
+to finish it. The stream contents will be compressed if compression is turn on.
+
+@p procedure pdf_flush; {flush out the |pdf_buf|}
+begin
+    if not pdf_os_mode then begin
+        case zip_write_state of
+            no_zip: if pdf_ptr > 0 then begin
+                if fixed_pdf_draftmode = 0 then write_pdf(0, pdf_ptr - 1);
+                pdf_gone := pdf_gone + pdf_ptr;
+                pdf_last_byte := pdf_buf[pdf_ptr - 1];
+            end;
+            zip_writing:
+                if fixed_pdf_draftmode = 0 then write_zip(false);
+            zip_finish: begin
+                if fixed_pdf_draftmode = 0 then write_zip(true);
+                zip_write_state := no_zip;
+            end;
+        end;
+        pdf_ptr := 0;
+    end;
+end;
+
+procedure pdf_begin_stream; {begin a stream}
+begin
+    pdf_print_ln("/Length           ");
+    pdf_seek_write_length := true; {fill in length at |pdf_end_stream| call}
+    pdf_stream_length_offset := pdf_offset - 11;
+    pdf_stream_length := 0;
+    if pdf_compress_level > 0 then begin
+        pdf_print_ln("/Filter /FlateDecode");
+        pdf_print_ln(">>");
+        pdf_print_ln("stream");
+        pdf_flush;
+        zip_write_state := zip_writing;
+    end
+    else begin
+        pdf_print_ln(">>");
+        pdf_print_ln("stream");
+        pdf_save_offset := pdf_offset;
+    end;
+end;
+
+procedure pdf_end_stream; {end a stream}
+begin
+    if zip_write_state = zip_writing then
+        zip_write_state := zip_finish
+    else
+        pdf_stream_length := pdf_offset - pdf_save_offset;
+    pdf_flush;
+    if pdf_seek_write_length then
+        write_stream_length(pdf_stream_length, pdf_stream_length_offset);
+    pdf_seek_write_length := false;
+    if pdf_last_byte <> pdf_new_line_char then
+        pdf_out(pdf_new_line_char);
+    pdf_print_ln("endstream");
+    pdf_end_obj;
+end;
+
+@ Basic printing procedures for PDF output are very similiar to \TeX\ basic
+printing ones but the output is going to PDF buffer. Subroutines with
+suffix |_ln| append a new-line character to the PDF output.
+
+@d pdf_new_line_char == 10 {new-line character for UNIX platforms}
+
+@d pdf_print_nl == {output a new-line character to PDF buffer}
+pdf_out(pdf_new_line_char)
+
+@d pdf_print_ln(#) == {print out a string to PDF buffer followed by
+a new-line character}
+begin
+    pdf_print(#);
+    pdf_print_nl;
+end
+
+@d pdf_print_int_ln(#) == {print out an integer to PDF buffer followed by
+a new-line character}
+begin
+    pdf_print_int(#);
+    pdf_print_nl;
+end
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+procedure pdf_error(t, p: str_number);
+begin
+    normalize_selector;
+    print_err("pdfTeX error");
+    if t <> 0 then begin
+        print(" (");
+        print(t);
+        print(")");
+    end;
+    print(": "); print(p);
+    succumb;
+end;
+
+procedure pdf_warning(t, p: str_number; prepend_nl, append_nl: boolean);
+begin
+    if interaction = error_stop_mode then
+        wake_up_terminal;
+    if prepend_nl then
+        print_ln;
+    print("pdfTeX warning");
+    if t <> 0 then begin
+        print(" (");
+        print(t);
+        print(")");
+    end;
+    print(": "); print(p);
+    if append_nl then
+        print_ln;
+	if history=spotless then history:=warning_issued;
+end;
+
+procedure pdf_os_get_os_buf(s: integer); {check that |s| bytes more
+fit into |pdf_os_buf|; increase it if required}
+var a: integer;
+begin
+    if s > sup_pdf_os_buf_size - pdf_ptr then
+        overflow("PDF object stream buffer", pdf_os_buf_size);
+    if pdf_ptr + s > pdf_os_buf_size then begin
+        a := 0.2 * pdf_os_buf_size;
+        if pdf_ptr + s > pdf_os_buf_size + a then
+            pdf_os_buf_size := pdf_ptr + s
+        else if pdf_os_buf_size < sup_pdf_os_buf_size - a then
+            pdf_os_buf_size := pdf_os_buf_size + a
+        else
+            pdf_os_buf_size := sup_pdf_os_buf_size;
+        pdf_os_buf := xreallocarray(pdf_os_buf, real_eight_bits, pdf_os_buf_size);
+        pdf_buf := pdf_os_buf;
+        pdf_buf_size := pdf_os_buf_size;
+    end;
+end;
+
+procedure remove_last_space;
+begin
+    if (pdf_ptr > 0) and (pdf_buf[pdf_ptr - 1] = 32) then
+        decr(pdf_ptr);
+end;
+
+function str_in_str(s, r: str_number; i: integer): boolean;
+  {test equality of strings}
+label not_found; {loop exit}
+var j, k: pool_pointer; {running indices}
+begin
+    str_in_str := false;
+    if length(s) < i + length(r) then
+        return;
+    j := i + str_start_macro(s);
+    k := str_start_macro(r);
+    while (j < str_start_macro(s + 1)) and (k < str_start_macro(r + 1)) do begin
+        if str_pool[j] <> str_pool[k] then
+            return;
+        incr(j);
+        incr(k);
+    end;
+    str_in_str := true;
+end;
+
+function tokens_to_string(p: pointer): str_number; {return a string from tokens
+list}
+var old_setting:integer;
+begin
+    if selector = new_string then
+        pdf_error("tokens", "tokens_to_string() called while selector = new_string");
+    old_setting:=selector; selector:=new_string;
+    show_token_list(link(p),null,pool_size-pool_ptr);
+    selector:=old_setting;
+    last_tokens_string := make_string;
+    tokens_to_string := last_tokens_string;
+end;
+
+
+@ To print |scaled| value to PDF output we need some subroutines to ensure
+accurary.
+
+@d max_integer == @"7FFFFFFF {$2^{31}-1$}
+@d call_func(#) == begin if # <> 0 then do_nothing end
+
+
+@<Glob...@>=
+@!one_hundred_inch: scaled; {scaled value corresponds to 100in}
+@!one_inch: scaled; {scaled value corresponds to 1in (rounded!)}
+@!one_hundred_bp: scaled; {scaled value corresponds to 100bp}
+@!one_bp: scaled; {scaled value corresponds to 1bp (rounded!)}
+@!ten_pow: array[0..9] of integer; {$10^0..10^9$}
+@!scaled_out: integer; {amount of |scaled| that was taken out in
+|divide_scaled|}
+@!init_pdf_output: boolean;
+
+@ @<Set init...@>=
+one_hundred_inch := 7227 * 65536; {exact, 473628672}
+one_inch := (one_hundred_inch + 50) div 100; {rounded to 4736287}
+one_hundred_bp := one_hundred_inch div 72; {exact, 6578176}
+one_bp := (one_hundred_bp + 50) div 100; {rounded to 65782}
+ten_pow[0] := 1;
+for i := 1 to 9 do
+    ten_pow[i] := 10*ten_pow[i - 1];
+init_pdf_output := false;
+
+
+@ The function |divide_scaled| divides |s| by |m| using |dd| decimal
+digits of precision. It is defined in C because it is a good candidate
+for optimizations that are not possible in pascal.
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled;
+var positive:boolean; {was |x>=0|?}
+@!t,@!u,@!v:nonnegative_integer; {intermediate quantities}
+begin if x>=0 then positive:=true
+else  begin negate(x); positive:=false;
+  end;
+t:=(x mod @'100000)*n;
+u:=(x div @'100000)*n+(t div @'100000);
+v:=(u mod d)*@'100000 + (t mod @'100000);
+if u div d>=@'100000 then arith_error:=true
+else u:=@'100000*(u div d) + (v div d);
+v := v mod d;
+if 2*v >= d then
+    incr(u);
+if positive then
+    round_xn_over_d := u
+else
+    round_xn_over_d := -u;
+end;
+
+@ Next subroutines are needed for controling spacing in PDF page description.
+For a given character |c| from a font |f|,
+the procedure |adv_char_width| advances |pdf_h|
+by {\it about\/} the amount |w|, which is the character width.
+But we cannot simply add |w| to |pdf_h|.
+Instead we have to bring the required shift into the same raster,
+on which also the \.{/Widths} array values,
+as they appear in the PDF file, are based.
+The |scaled_out| value is the |w| value moved into this raster.
+The \.{/Widths} values are used by the PDF reader independently
+to update its positions.
+So one has to be sure, that calculations are properly synchronized.
+Currently the \.{/Widths} array values are output
+with one digit after the decimal point,
+therefore the raster on which |adv_char_width| is operating
+is $1/10000$ of the |pdf_font_size|.
+
+For PK fonts things are more complicated,
+as we have to deal with scaling bitmaps as well.
+
+@p
+procedure adv_char_width(f: internal_font_number; c: integer); {update |pdf_h|
+by character width |w| from font |f|}
+var w, s_out: scaled;
+    s: integer;
+begin
+    w := char_width(f,c);
+    if hasfmentry(f) then begin
+        if pdf_cur_Tm_a = 0 then begin
+            call_func(divide_scaled_n(w, pdf_font_size(f),10000.0));
+            pdf_delta_h := pdf_delta_h + scaled_out;
+        end
+        else begin
+            s := divide_scaled_n(round_xn_over_d(w, 1000, 1000 + pdf_cur_Tm_a),
+                               pdf_font_size(f),10000.0);
+            s_out := round_xn_over_d(round_xn_over_d(pdf_font_size(f), abs(s), 10000),
+                                     1000 + pdf_cur_Tm_a, 1000);
+            if s < 0 then
+                s_out := -s_out;
+            pdf_delta_h := pdf_delta_h + s_out;
+        end;
+    end else
+        pdf_delta_h := pdf_delta_h + get_pk_char_width(f, w);
+end;
+
+procedure pdf_print_bp(s: scaled); {print scaled as |bp|}
+begin
+    pdf_print_real(divide_scaled(s, one_hundred_bp, fixed_decimal_digits + 2),
+                   fixed_decimal_digits);
+end;
+
+procedure pdf_print_mag_bp(s: scaled); {take |mag| into account}
+begin
+    prepare_mag;
+    if mag <> 1000 then
+        s := round_xn_over_d(s, mag, 1000);
+    pdf_print_bp(s);
+end;
+
+@* \[32c] PDF page description.
+
+@d pdf_h_offset == (h_offset + pdf_h_origin)
+@d pdf_v_offset == (v_offset + pdf_v_origin)
+@d pdf_x(#) == ((#) - pdf_h_offset + one_inch) {convert $x$-coordinate from \.{DVI} to PDF}
+@d pdf_y(#) == (cur_page_height - (#) - pdf_v_offset + one_inch) {convert $y$-coordinate from \.{DVI} to PDF}
+
+@<Glob...@>=
+@!pdf_f: internal_font_number; {the current font in PDF output page}
+@!pdf_h: scaled; {current horizontal coordinate in PDF output page}
+@!pdf_v: scaled; {current vertical coordinate in PDF output page}
+@!pdf_tj_start_h: scaled; {horizontal coordinate in PDF output page just before \.{TJ} array start}
+@!cur_delta_h: scaled; {horizontal |cur_h| offset from |pdf_tj_start_h|}
+@!pdf_delta_h: scaled; {horizontal offset from |pdf_tj_start_h|}
+@!pdf_origin_h: scaled; {current horizontal origin in PDF output page}
+@!pdf_origin_v: scaled; {current vertical origin in PDF output page}
+@!pdf_doing_string: boolean; {we are writing string to PDF file?}
+@!pdf_doing_text: boolean; {we are writing text section to PDF file?}
+@!min_bp_val: scaled;
+@!min_font_val: scaled; {(TJ array system)}
+@!fixed_pk_resolution: integer;
+@!fixed_decimal_digits: integer;
+@!fixed_gen_tounicode: integer;
+@!fixed_replace_font: integer;
+@!pk_scale_factor: integer;
+@!pdf_output_option: integer;
+@!pdf_output_value: integer;
+@!pdf_draftmode_option: integer;
+@!pdf_draftmode_value: integer;
+@!pdf_cur_Tm_a: integer; {|a| value of the current text matrix, ie the current
+                          horizontal scaling factor}
+@!pdf_last_f: internal_font_number; {last font in PDF output page}
+@!pdf_last_fs: internal_font_number; {last font size in PDF output page}
+
+
+@ Following procedures implement low-level subroutines to convert \TeX{}
+internal structures to PDF page description.
+
+@p procedure pdf_set_origin(h, v: scaled); {set the origin to |h|, |v|}
+begin
+    if (abs(h - pdf_origin_h) >= min_bp_val) or
+        (abs(v - pdf_origin_v) >= min_bp_val) then begin
+        pdf_print("1 0 0 1 ");
+        pdf_print_bp(h - pdf_origin_h);
+        pdf_origin_h := pdf_origin_h + scaled_out;
+        pdf_out(" ");
+        pdf_print_bp(pdf_origin_v - v);
+        pdf_origin_v := pdf_origin_v - scaled_out;
+        pdf_print_ln(" cm");
+    end;
+    pdf_h := pdf_origin_h;
+    pdf_tj_start_h := pdf_h;
+    pdf_v := pdf_origin_v;
+end;
+
+procedure pdf_set_origin_temp(h, v: scaled); {set the origin to |h|, |v| inside group}
+begin
+    if (abs(h - pdf_origin_h) >= min_bp_val) or
+        (abs(v - pdf_origin_v) >= min_bp_val) then begin
+        pdf_print("1 0 0 1 ");
+        pdf_print_bp(h - pdf_origin_h);
+        pdf_out(" ");
+        pdf_print_bp(pdf_origin_v - v);
+        pdf_print_ln(" cm");
+    end;
+end;
+
+procedure pdf_end_string; {end the current string}
+begin
+    if pdf_doing_string then begin
+        pdf_print(")]TJ");
+        pdf_doing_string := false;
+    end;
+end;
+
+procedure pdf_end_string_nl; {end the current string, with new-line}
+begin
+    if pdf_doing_string then begin
+        pdf_print_ln(")]TJ");
+        pdf_doing_string := false;
+    end;
+end;
+
+procedure pdf_set_textmatrix(v, v_out: scaled; f: internal_font_number);
+{set the next starting point to |cur_h|, |cur_v|}
+var pdf_new_Tm_a: integer; {|a| value of the new text matrix}
+begin
+    pdf_out(" ");
+    if f = pdf_f then
+        pdf_new_Tm_a := pdf_cur_Tm_a
+    else if not pdf_font_auto_expand(f) then
+        pdf_new_Tm_a := 0
+    else
+        pdf_new_Tm_a := pdf_font_expand_ratio(f);
+    if (pdf_new_Tm_a <> 0) or
+        ((pdf_new_Tm_a = 0) and (pdf_cur_Tm_a <> 0)) then begin
+        pdf_print_real(1000 + pdf_new_Tm_a, 3);
+        pdf_print(" 0 0 1 ");
+        pdf_print_bp(cur_h - pdf_origin_h);
+        pdf_h := pdf_origin_h + scaled_out;
+        pdf_out(" ");
+        pdf_print_bp(pdf_origin_v - cur_v);
+        pdf_v := pdf_origin_v - scaled_out;
+        pdf_print(" Tm");
+        pdf_cur_Tm_a := pdf_new_Tm_a;
+        pdfassert(pdf_cur_Tm_a > -1000);
+    end else begin
+        pdf_print_bp(cur_h - pdf_tj_start_h); {works only for unexpanded fonts}
+        pdf_h := pdf_tj_start_h + scaled_out;
+        pdf_out(" ");
+        pdf_print_real(v, fixed_decimal_digits); {use |v| and |v_out| to avoid duplicate calculation}
+        pdf_v := pdf_v - v_out;
+        pdf_print(" Td");
+    end;
+    pdf_tj_start_h := pdf_h;
+    pdf_delta_h := 0;
+end;
+
+procedure pdf_use_font(f: internal_font_number; fontnum: integer);
+{mark |f| as a used font; set |font_used(f)|, |pdf_font_size(f)| and |pdf_font_num(f)|}
+begin
+    call_func(divide_scaled(font_size(f), one_hundred_bp, 6));
+    set_pdf_font_size(f,scaled_out);
+    set_font_used(f,true);
+    pdfassert((fontnum > 0) or ((fontnum < 0) and (pdf_font_num(-fontnum) > 0)));
+    set_pdf_font_num(f,fontnum);
+    if pdf_move_chars > 0 then begin
+        pdf_warning(0,"Primitive \pdfmovechars is obsolete.",true, true);
+        pdf_move_chars := 0; {warn only once}
+    end;
+end;
+
+@ To set PDF font we need to find out fonts with the same name, because \TeX\
+can load the same font several times for various sizes. For such fonts we
+define only one font resource. The array |pdf_font_num| holds the object
+number of font resource. A negative value of an entry of |pdf_font_num|
+indicates that the corresponding font shares the font resource with the font
+
+@d pdf_print_resname_prefix ==
+if pdf_resname_prefix <> 0 then
+    pdf_print(pdf_resname_prefix)
+
+@p procedure pdf_init_font(f: internal_font_number);
+{create a font object}
+var k, b: internal_font_number;
+    i: integer;
+begin
+    pdfassert(not font_used(f));
+
+    {if |f| is auto expanded then ensure the base font is initialized}
+    if pdf_font_auto_expand(f) and (pdf_font_blink(f) <> null_font) then begin
+        b := pdf_font_blink(f);
+	    {TODO: reinstate this check. disabled because wide fonts font have fmentries}
+        if false and (not hasfmentry(b)) then
+            pdf_error("font expansion", "auto expansion is only possible with scalable fonts");
+        if not font_used(b) then
+            pdf_init_font(b);
+        set_font_map(f,font_map(b));
+    end;
+
+    {check whether |f| can share the font object with some |k|: we have 2 cases
+    here: 1) |f| and |k| have the same tfm name (so they have been loaded at
+    different sizes, eg 'cmr10' and 'cmr10 at 11pt'); 2) |f| has been auto
+    expanded from |k|}
+    if hasfmentry(f) or true then begin
+        i := head_tab[obj_type_font];
+        while i <> 0 do begin
+            k := obj_info(i);
+            if font_shareable(f,k) then
+            begin
+                pdfassert(pdf_font_num(k) <> 0);
+                if pdf_font_num(k) < 0 then
+                    pdf_use_font(f, pdf_font_num(k))
+                else
+                    pdf_use_font(f, -k);
+                return;
+            end;
+            i := obj_link(i);
+        end;
+    end;
+
+    {create a new font object for |f|}
+    pdf_create_obj(obj_type_font, f);
+    pdf_use_font(f, obj_ptr);
+end;
+
+procedure pdf_init_font_cur_val;
+begin
+    pdf_init_font(cur_val);
+end;
+
+procedure pdf_set_font(f: internal_font_number);
+{set the actual font on PDF page}
+label found, found1;
+var p: pointer;
+    k: internal_font_number;
+begin
+    if not font_used(f) then
+        pdf_init_font(f);
+    set_ff(f); {set |ff| to the tfm number of the font sharing the font object
+                with |f|; |ff| is either |f| or some font with the same tfm name
+                at different size and/or expansion}
+    k := ff;
+    p := pdf_font_list;
+    while p <> null do begin
+        set_ff(info(p));
+        if ff = k then
+            goto found;
+        p := link(p);
+    end;
+    pdf_append_list(f)(pdf_font_list); {|f| not found in |pdf_font_list|, append it now}
+found:
+    if (k = pdf_last_f) and (font_size(f) = pdf_last_fs) then
+        return;
+    pdf_print("/F");
+    pdf_print_int(k);
+    pdf_print_resname_prefix;
+    pdf_out(" ");
+    pdf_print_real(divide_scaled(font_size(f), one_hundred_bp, 6), 4);
+    pdf_print(" Tf");
+    pdf_last_f := k;
+    pdf_last_fs := font_size(f);
+end;
+
+procedure pdf_begin_text; {begin a text section}
+begin
+    pdf_set_origin(0, cur_page_height);
+    pdf_print_ln("BT");
+    pdf_doing_text := true;
+    pdf_f := null_font;
+    pdf_last_f := null_font;
+    pdf_last_fs := 0;
+    pdf_doing_string := false;
+    pdf_cur_Tm_a := 0;
+end;
+
+@ @p
+procedure pdf_begin_string(f: internal_font_number); {begin to draw a string}
+var s_out, v, v_out: scaled;
+    s: integer;
+begin s_out:=0;
+    if not pdf_doing_text then
+        pdf_begin_text;
+    if f <> pdf_f then begin
+        pdf_end_string;
+        pdf_set_font(f);
+    end;
+    if pdf_cur_Tm_a = 0 then begin
+        s := divide_scaled_n(cur_h - (pdf_tj_start_h + pdf_delta_h), pdf_font_size(f),1000.0);
+        s_out := scaled_out;
+    end
+    else begin
+        s := divide_scaled_n(round_xn_over_d(cur_h - (pdf_tj_start_h + pdf_delta_h), 1000,
+                                           1000 + pdf_cur_Tm_a),
+                           pdf_font_size(f),
+	                   1000.0);
+        if abs(s) < @'100000 then begin
+            s_out := round_xn_over_d(round_xn_over_d(pdf_font_size(f), abs(s), 1000),
+                                     1000 + pdf_cur_Tm_a, 1000);
+            if s < 0 then
+                s_out := -s_out;
+        end;
+        {no need to calculate |s_out| when |abs(s) >= @'100000|, since the text
+         matrix will be reset below}
+    end;
+    if abs(cur_v - pdf_v) >= min_bp_val then begin
+        v := divide_scaled(pdf_v - cur_v, one_hundred_bp,
+                           fixed_decimal_digits + 2);
+        v_out := scaled_out;
+    end
+    else begin
+        v := 0;
+        v_out := 0;
+    end;
+    if (f <> pdf_f) or (v <> 0) or (abs(s) >= @'100000) then begin
+        pdf_end_string;
+        pdf_set_textmatrix(v, v_out, f);
+        pdf_f := f;
+        s := 0;
+    end;
+    if not pdf_doing_string then begin
+        pdf_print(" [");
+        if s = 0 then
+            pdf_out("(");
+    end;
+    if s <> 0 then begin
+        if pdf_doing_string then
+            pdf_out(")");
+        pdf_print_int(-s);
+        pdf_out("(");
+        pdf_delta_h := pdf_delta_h + s_out;
+    end;
+    pdf_doing_string := true;
+end;
+
+procedure pdf_end_text; {end a text section}
+begin
+    if pdf_doing_text then begin
+        pdf_end_string_nl;
+        pdf_print_ln("ET");
+        pdf_doing_text := false;
+    end;
+end;
+
+procedure pdf_set_rule(x, y, w, h: scaled); {draw a rule}
+begin
+    pdf_end_text;
+    pdf_print_ln("q");
+    if h <= one_bp then begin
+        pdf_set_origin_temp(x, y - (h + 1)/2);
+        pdf_print("[]0 d 0 J ");
+        pdf_print_bp(h); pdf_print(" w 0 0 m ");
+        pdf_print_bp(w); pdf_print_ln(" 0 l S");
+    end
+    else if w <= one_bp then begin
+        pdf_set_origin_temp(x + (w + 1)/2, cur_v);
+        pdf_print("[]0 d 0 J ");
+        pdf_print_bp(w); pdf_print(" w 0 0 m 0 ");
+        pdf_print_bp(h); pdf_print_ln(" l S");
+    end
+    else begin
+        pdf_set_origin_temp(x, y);
+        pdf_print("0 0 ");
+        pdf_print_bp(w); pdf_out(" ");
+        pdf_print_bp(h); pdf_print_ln(" re f");
+    end;
+    pdf_print_ln("Q");
+end;
+
+procedure pdf_rectangle(left, top, right, bottom: scaled); {output a
+rectangle specification to PDF file}
+begin
+    prepare_mag;
+    pdf_print("/Rect [");
+    pdf_print_mag_bp(pdf_x(left)); pdf_out(" ");
+    pdf_print_mag_bp(pdf_y(bottom)); pdf_out(" ");
+    pdf_print_mag_bp(pdf_x(right)); pdf_out(" ");
+    pdf_print_mag_bp(pdf_y(top));
+    pdf_print_ln("]");
+end;
+
+procedure literal(s: str_number; literal_mode: integer; warn: boolean);
+var j: pool_pointer; {current character code position}
+begin
+    j:=str_start_macro(s);
+    if literal_mode = scan_special then begin
+        if not (str_in_str(s, "PDF:", 0) or str_in_str(s, "pdf:", 0)) then begin
+            if warn and not (str_in_str(s, "SRC:", 0)
+                or str_in_str(s, "src:", 0)
+                or (length(s) = 0)) then
+                    print_nl("Non-PDF special ignored!");
+            return;
+        end;
+        j := j + length("PDF:");
+        if str_in_str(s, "direct:", length("PDF:")) then begin
+            j := j + length("direct:");
+            literal_mode := direct_always; end
+        else if str_in_str(s, "page:", length("PDF:")) then begin
+            j := j + length("page:");
+            literal_mode := direct_page; end
+        else
+            literal_mode := set_origin;
+    end;
+    case literal_mode of
+    set_origin: begin
+        pdf_end_text;
+        pdf_set_origin(cur_h, cur_v);
+        end;
+    direct_page:
+        pdf_end_text;
+    direct_always:
+        pdf_end_string_nl;
+    othercases confusion("literal1")
+    endcases;
+    while j<str_start_macro(s+1) do begin
+       pdf_out(str_pool[j]);
+       incr(j);
+    end;
+    pdf_print_nl;
+end;
+
+procedure latelua(lua_id: quarterword; s: str_number);
+var b, j: pool_pointer; {current character code position}
+begin
+    j:=str_start_macro(s);
+    b := pool_ptr;
+    luacall(lua_id,(s-string_offset));
+    while b<pool_ptr do begin
+       pdf_out(str_pool[b]);
+       incr(b);
+    end;
+    pdf_print_nl;
+end;
+
+@* \[32d] The cross-reference table.
+
+The cross-reference table |obj_tab| is an array of |obj_tab_size| of
+|tab_entry|. Each entry contains five integer fields and represents an object
+in PDF file whose object number is the index of this entry in |obj_tab|.
+Objects in |obj_tab| maybe linked into list; objects in such a linked list have
+the same type.
+
+@<Types...@>=
+@!obj_entry = record@;@/
+    int0, int1, int2, int3, int4: integer;
+end;
+
+@ The first field contains information representing identifier of this object.
+It is usally a number for most of object types, but it may be a string number
+for named destination or named thread.
+
+The second field of |obj_entry| contains link to the next
+object in |obj_tab| if this object is linked in a list.
+
+The third field holds the byte offset of the object in the output PDF file,
+or its byte offset within an object stream.
+Objects that have been not written yet have this field set to zero. However
+sometimes we have to use this field to store some info before the object is
+written out.
+
+The fourth field holds the object number of the object stream, into which
+the object is included.
+
+The last field usually represents the pointer to some auxiliary data
+structure depending on the object type; however it may be used as a counter as
+well.
+
+@d obj_info(#) == obj_tab[#].int0 {information representing identifier of this object}
+@d obj_link(#) == obj_tab[#].int1 {link to the next entry in linked list}
+@d obj_offset(#) == obj_tab[#].int2 {byte offset for this object in PDF output file, or object stream number for this object}
+@d obj_os_idx(#) == obj_tab[#].int3 {index of this object in object stream}
+@d obj_aux(#) == obj_tab[#].int4 {auxiliary pointer}
+@d is_obj_written(#) == (obj_offset(#) <> 0)
+
+@# {types of objects}
+@d obj_type_others              == 0 {objects which are not linked in any list}
+@d obj_type_page                == 1 {index of linked list of Page objects}
+@d obj_type_pages               == 2 {index of linked list of Pages objects}
+@d obj_type_font                == 3 {index of linked list of Fonts objects}
+@d obj_type_outline             == 4 {index of linked list of outline objects}
+@d obj_type_dest                == 5 {index of linked list of destination objects}
+@d obj_type_obj                 == 6 {index of linked list of raw objects}
+@d obj_type_xform               == 7 {index of linked list of XObject forms}
+@d obj_type_ximage              == 8 {index of linked list of XObject image}
+@d obj_type_thread              == 9 {index of linked list of num article threads}
+@d head_tab_max                 == obj_type_thread {max index of |head_tab|}
+
+@# {max number of kids for balanced trees}
+@d pages_tree_kids_max     == 6 {max number of kids of Pages tree node}
+@d name_tree_kids_max      == 6 {max number of kids of node of name tree for
+name destinations}
+
+@# {when a whatsit node representing annotation is created, words |1..3| are
+width, height and depth of this annotation; after shipping out words |1..4|
+are rectangle specification of annotation. For whatsit node representing
+destination |pdf_left| and |pdf_top| are used for some types of destinations}
+
+@# {coordinates of destinations/threads/annotations (in whatsit node)}
+@d pdf_left(#)             == vmem(# + 2).sc
+@d pdf_top(#)              == vmem(# + 3).sc
+@d pdf_right(#)            == vmem(# + 4).sc
+@d pdf_bottom(#)           == vmem(# + 5).sc
+
+@# {dimension of destinations/threads/annotations (in whatsit node)}
+@d pdf_width(#)            == vmem(# + 2).sc
+@d pdf_height(#)           == vmem(# + 3).sc
+@d pdf_depth(#)            == vmem(# + 4).sc
+
+@# {data structure for \.{\\pdfliteral}}
+@d pdf_literal_data(#)     == vlink(#+2) {data}
+@d pdf_literal_mode(#)     == vinfo(#+2) {mode of resetting the text matrix
+                              while writing data to the page stream}
+@# {modes of setting the current transformation matrix (CTM)}
+@d set_origin              == 0 {end text (ET) if needed, set CTM to current point}
+@d direct_page             == 1 {end text (ET) if needed, but don't change the CTM}
+@d direct_always           == 2 {don't end text, don't change the CTM}
+@d scan_special            == 3 {look into special text}
+
+@# {data structure for \.{\\pdfcolorstack}}
+@d pdf_colorstack_node_size == 4
+@d pdf_colorstack_stack(#)  == vlink(#+2) {stack number}
+@d pdf_colorstack_cmd(#)    == vinfo(#+2) {command: set, push, pop, current}
+@d pdf_colorstack_data(#)   == vlink(#+3) {data}
+
+@# {color stack commands}
+@d colorstack_set          == 0
+@d colorstack_push         == 1
+@d colorstack_data         == 1 { last value where data field is set }
+@d colorstack_pop          == 2
+@d colorstack_current      == 3
+
+@# {data structure for \.{\\pdfsetmatrix}}
+@d pdf_setmatrix_node_size == 3
+@d pdf_setmatrix_data(#)   == vlink(#+2) {data}
+
+@# {data structure for \.{\\pdsave}}
+@d pdf_save_node_size      == 3
+
+@# {data structure for \.{\\pdfrestore}}
+@d pdf_restore_node_size   == 3
+
+
+@# {data structure for \.{\\latelua}}
+@d late_lua_data(#)        == vlink(#+2) {data}
+@d late_lua_reg(#)         == vinfo(#+2) {register id}
+
+@# {data structure for \.{\\pdfobj} and \.{\\pdfrefobj}}
+@d pdf_refobj_node_size    == 3 {size of whatsit node representing the raw object}
+@d pdf_obj_objnum(#)       == vinfo(# + 2) {number of the raw object}
+@d obj_data_ptr            == obj_aux {pointer to |pdf_mem|}
+@d pdfmem_obj_size         == 4 {size of memory in |pdf_mem| which |obj_data_ptr| holds}
+@d obj_obj_data(#)         == pdf_mem[obj_data_ptr(#) + 0] {object data}
+@d obj_obj_is_stream(#)    == pdf_mem[obj_data_ptr(#) + 1] {will this object
+                              be written as a stream instead of a dictionary?}
+@d obj_obj_stream_attr(#)  == pdf_mem[obj_data_ptr(#) + 2] {additional
+                              object attributes for streams}
+@d obj_obj_is_file(#)      == pdf_mem[obj_data_ptr(#) + 3] {data should be
+                              read from an external file?}
+
+@# {data structure for \.{\\pdfxform} and \.{\\pdfrefxform}}
+@d pdf_refxform_node_size  == 6 {size of whatsit node for xform; words 1..3 are
+                              form dimensions}
+@d pdf_xform_objnum(#)     == vinfo(# + 4) {object number}
+@d pdfmem_xform_size       == 6 {size of memory in |pdf_mem| which
+                              |obj_data_ptr| holds}
+@d obj_xform_width(#)      == pdf_mem[obj_data_ptr(#) + 0]
+@d obj_xform_height(#)     == pdf_mem[obj_data_ptr(#) + 1]
+@d obj_xform_depth(#)      == pdf_mem[obj_data_ptr(#) + 2]
+@d obj_xform_box(#)        == pdf_mem[obj_data_ptr(#) + 3] {this field holds
+                              pointer to the corresponding box}
+@d obj_xform_attr(#)       == pdf_mem[obj_data_ptr(#) + 4] {additional xform
+                              attributes}
+@d obj_xform_resources(#)  == pdf_mem[obj_data_ptr(#) + 5] {additional xform
+                              Resources}
+
+@# {data structure for \.{\\pdfximage} and \.{\\pdfrefximage}}
+@d pdf_refximage_node_size == 6 {size of whatsit node for ximage; words 2..4
+                               are image dimensions}
+@d pdf_ximage_ref(#)       == vinfo(# + 5) {image reference number}
+
+@# {data structure of annotations; words 1..4 represent the coordinates of
+    the annotation}
+@d obj_annot_ptr           == obj_aux {pointer to corresponding whatsit node}
+@d pdf_annot_node_size     == 8 {size of whatsit node representing annotation}
+@d pdf_annot_data(#)       == vinfo(# + 6) {raw data of general annotations}
+@d pdf_link_attr(#)        == vinfo(# + 6) {attributes of link annotations}
+@d pdf_link_action(#)      == vlink(# + 6) {pointer to action structure}
+@d pdf_annot_objnum(#)     == vmem(# + 7).int {object number of corresponding object}
+@d pdf_link_objnum(#)      == vmem(# + 7).int {object number of corresponding object}
+
+@# {types of actions}
+@d pdf_action_page         == 0 {GoTo action}
+@d pdf_action_goto         == 1 {GoTo action}
+@d pdf_action_thread       == 2 {Thread action}
+@d pdf_action_user         == 3 {user-defined action}
+
+@# {data structure of actions}
+@d pdf_action_size         == 4 {size of action structure in |mem|}
+@d action_node         == 45
+@d pdf_action_type(#)      == type(#+1) {action type}
+@d pdf_action_named_id(#)  == subtype(#+1) {identifier is type of name}
+@d pdf_action_id(#)        == vlink(#+1) {destination/thread name identifier}
+@d pdf_action_file(#)      == vinfo(# + 2) {file name for external action}
+@d pdf_action_new_window(#) == vlink(# + 2) {open a new window?}
+@d pdf_action_tokens(#)    == vinfo(# + 3) {specification of GoTo page or user action}
+@d pdf_action_refcount(#)  == vlink(# + 3) {counter of references to this action}
+
+@# {data structure of outlines; it's not able to write out outline entries
+before all outline entries are defined, so memory allocated for outline
+entries can't not be deallocated and will stay in memory. For this reason we
+will store data of outline entries in |pdf_mem| instead of |mem|}
+
+@d pdfmem_outline_size     == 8 {size of memory in |pdf_mem| which
+|obj_outline_ptr| points to}
+@d obj_outline_count        == obj_info{count of all opened children}
+@d obj_outline_ptr          == obj_aux {pointer to |pdf_mem|}
+@d obj_outline_title(#)     == pdf_mem[obj_outline_ptr(#)]
+@d obj_outline_parent(#)    == pdf_mem[obj_outline_ptr(#) + 1]
+@d obj_outline_prev(#)      == pdf_mem[obj_outline_ptr(#) + 2]
+@d obj_outline_next(#)      == pdf_mem[obj_outline_ptr(#) + 3]
+@d obj_outline_first(#)     == pdf_mem[obj_outline_ptr(#) + 4]
+@d obj_outline_last(#)      == pdf_mem[obj_outline_ptr(#) + 5]
+@d obj_outline_action_objnum(#) == pdf_mem[obj_outline_ptr(#) + 6] {object number of
+action}
+@d obj_outline_attr(#)      == pdf_mem[obj_outline_ptr(#) + 7]
+
+@# {types of destinations}
+@d pdf_dest_xyz             == 0
+@d pdf_dest_fit             == 1
+@d pdf_dest_fith            == 2
+@d pdf_dest_fitv            == 3
+@d pdf_dest_fitb            == 4
+@d pdf_dest_fitbh           == 5
+@d pdf_dest_fitbv           == 6
+@d pdf_dest_fitr            == 7
+
+@# {data structure of destinations}
+@d obj_dest_ptr             == obj_aux {pointer to |pdf_dest_node|}
+@d pdf_dest_node_size       == 8 {size of whatsit node for destination;
+words |1..4| hold dest dimensions, word |6| identifier type, subtype
+and identifier of destination, word |6| the corresponding object number}
+@d pdf_dest_type(#)          == type(# + 6) {type of destination}
+@d pdf_dest_named_id(#)      == subtype(# + 6) {is named identifier?}
+@d pdf_dest_id(#)            == vlink(# + 6) {destination identifier}
+@d pdf_dest_xyz_zoom(#)      == vinfo(# + 7) {zoom factor for |destxyz| destination}
+@d pdf_dest_objnum(#)        == vlink(# + 7) {object number of corresponding
+object}
+
+@# {data structure of threads; words 1..4 represent the coordinates of the
+    corners}
+@d pdf_thread_node_size      == 8
+@d pdf_thread_named_id(#)    == subtype(# + 6) {is a named identifier}
+@d pdf_thread_id(#)          == vlink(# + 6) {thread identifier}
+@d pdf_thread_attr(#)        == vinfo(# + 7) {attributes of thread}
+@d obj_thread_first          == obj_aux {pointer to the first bead}
+
+@# {data structure of beads}
+@d pdfmem_bead_size         == 5 {size of memory in |pdf_mem| which
+                                  |obj_bead_ptr| points to}
+@d obj_bead_ptr             == obj_aux {pointer to |pdf_mem|}
+@d obj_bead_rect(#)         == pdf_mem[obj_bead_ptr(#)]
+@d obj_bead_page(#)         == pdf_mem[obj_bead_ptr(#) + 1]
+@d obj_bead_next(#)         == pdf_mem[obj_bead_ptr(#) + 2]
+@d obj_bead_prev(#)         == pdf_mem[obj_bead_ptr(#) + 3]
+@d obj_bead_attr(#)         == pdf_mem[obj_bead_ptr(#) + 4]
+@d obj_bead_data            == obj_bead_rect {pointer to the corresponding
+whatsit node; |obj_bead_rect| is needed only when the bead rectangle has
+been written out and after that |obj_bead_data| is not needed any more
+so we can use this field for both}
+
+@<Constants...@>=
+@!inf_obj_tab_size = 1000; {min size of the cross-reference table for PDF output}
+@!sup_obj_tab_size = 8388607; {max size of the cross-reference table for PDF output}
+@!inf_dest_names_size = 1000; {min size of the destination names table for PDF output}
+@!sup_dest_names_size = 131072; {max size of the destination names table for PDF output}
+@!inf_pk_dpi = 72; {min PK pixel density value from \.{texmf.cnf}}
+@!sup_pk_dpi = 8000; {max PK pixel density value from \.{texmf.cnf}}
+@!pdf_objtype_max = head_tab_max;
+
+@ @<Glob...@>=
+@!obj_tab_size:integer;
+@!obj_tab:^obj_entry;
+@!head_tab: array[1..head_tab_max] of integer;
+@!pages_tail: integer;
+@!obj_ptr: integer; {user objects counter}
+@!sys_obj_ptr: integer; {system objects counter, including object streams}
+@!pdf_last_pages: integer; {pointer to most recently generated pages object}
+@!pdf_last_page: integer; {pointer to most recently generated page object}
+@!pdf_last_stream: integer; {pointer to most recently generated stream}
+@!pdf_stream_length: integer; {length of most recently generated stream}
+@!pdf_stream_length_offset: integer; {file offset of the last stream length}
+@!pdf_seek_write_length: boolean; {flag whether to seek back and write \.{/Length}}
+@!pdf_last_byte: integer; {byte most recently written to PDF file; for \.{endstream} in new line}
+@!pdf_append_list_arg: integer; {for use with |pdf_append_list|}
+@!ff: integer; {for use with |set_ff|}
+@!pdf_box_spec_media: integer;
+@!pdf_box_spec_crop: integer;
+@!pdf_box_spec_bleed: integer;
+@!pdf_box_spec_trim: integer;
+@!pdf_box_spec_art: integer;
+
+@ @<Set init...@>=
+obj_ptr := 0;
+sys_obj_ptr := 0;
+obj_tab_size := inf_obj_tab_size; {allocated size of |obj_tab| array}
+dest_names_size := inf_dest_names_size; {allocated size of |dest_names| array}
+for k := 1 to head_tab_max do
+    head_tab[k] := 0;
+pdf_box_spec_media  := 1;
+pdf_box_spec_crop   := 2;
+pdf_box_spec_bleed  := 3;
+pdf_box_spec_trim   := 4;
+pdf_box_spec_art    := 5;
+
+@ Here we implement subroutines for work with objects and related things.
+Some of them are used in former parts too, so we need to declare them
+forward.
+
+@d pdf_append_list_end(#) == # := append_ptr(#, pdf_append_list_arg); end
+@d pdf_append_list(#) == begin pdf_append_list_arg := #; pdf_append_list_end
+@d set_ff(#) == begin
+    if pdf_font_num(#) < 0 then
+        ff := -pdf_font_num(#)
+    else
+        ff := #;
+end
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+procedure append_dest_name(s: str_number; n: integer);
+var a: integer;
+begin
+    if pdf_dest_names_ptr = sup_dest_names_size then
+        overflow("number of destination names (dest_names_size)", dest_names_size);
+    if pdf_dest_names_ptr = dest_names_size then begin
+        a := 0.2 * dest_names_size;
+        if dest_names_size < sup_dest_names_size - a then
+            dest_names_size := dest_names_size + a
+        else
+            dest_names_size := sup_dest_names_size;
+        dest_names := xreallocarray(dest_names, dest_name_entry, dest_names_size);
+    end;
+    dest_names[pdf_dest_names_ptr].objname := s;
+    dest_names[pdf_dest_names_ptr].objnum := n;
+    incr(pdf_dest_names_ptr);
+end;
+
+procedure pdf_create_obj(t, i: integer); {create an object with type |t| and
+identifier |i|}
+label done;
+var a, p, q: integer;
+begin
+    if sys_obj_ptr = sup_obj_tab_size then
+        overflow("indirect objects table size", obj_tab_size);
+    if sys_obj_ptr = obj_tab_size then begin
+        a := 0.2 * obj_tab_size;
+        if obj_tab_size < sup_obj_tab_size - a then
+            obj_tab_size := obj_tab_size + a
+        else
+            obj_tab_size := sup_obj_tab_size;
+        obj_tab := xreallocarray(obj_tab, obj_entry, obj_tab_size);
+    end;
+    incr(sys_obj_ptr);
+    obj_ptr := sys_obj_ptr;
+    obj_info(obj_ptr) := i;
+    obj_offset(obj_ptr) := 0;
+    obj_aux(obj_ptr) := 0;
+    avl_put_obj(obj_ptr, t);
+    if t = obj_type_page then begin
+        p := head_tab[t];
+        {find the right position to insert newly created object}@/
+        if (p = 0) or (obj_info(p) < i) then begin
+            obj_link(obj_ptr) := p;
+            head_tab[t] := obj_ptr;
+        end
+        else begin
+            while p <> 0 do begin
+                if obj_info(p) < i then
+                    goto done;
+                q := p;
+                p := obj_link(p);
+            end;
+done:
+            obj_link(q) := obj_ptr;
+            obj_link(obj_ptr) := p;
+        end;
+    end
+    else if t <> obj_type_others then begin
+        obj_link(obj_ptr) := head_tab[t];
+        head_tab[t] := obj_ptr;
+        if (t = obj_type_dest) and (i < 0) then
+            append_dest_name(-obj_info(obj_ptr), obj_ptr);
+    end;
+end;
+
+function pdf_new_objnum: integer; {create a new object and return its number}
+begin
+    pdf_create_obj(obj_type_others, 0);
+    pdf_new_objnum := obj_ptr;
+end;
+
+procedure pdf_os_switch(pdf_os: boolean); {switch between PDF stream and object stream mode}
+begin
+    if pdf_os and pdf_os_enable then begin
+        if not pdf_os_mode then begin {back up PDF stream variables}
+            pdf_op_ptr := pdf_ptr;
+            pdf_ptr := pdf_os_ptr;
+            pdf_buf := pdf_os_buf;
+            pdf_buf_size := pdf_os_buf_size;
+            pdf_os_mode := true; {switch to object stream}
+        end;
+    end else begin
+        if pdf_os_mode then begin {back up object stream variables}
+            pdf_os_ptr := pdf_ptr;
+            pdf_ptr := pdf_op_ptr;
+            pdf_buf := pdf_op_buf;
+            pdf_buf_size := pdf_op_buf_size;
+            pdf_os_mode := false; {switch to PDF stream}
+        end;
+    end;
+end;
+
+procedure pdf_os_prepare_obj(i: integer; pdf_os_level: integer); {create new \.{/ObjStm} object
+if required, and set up cross reference info}
+begin
+    pdf_os_switch((pdf_os_level > 0) and (fixed_pdf_objcompresslevel >= pdf_os_level));
+    if pdf_os_mode then begin
+        if pdf_os_cur_objnum = 0 then begin
+            pdf_os_cur_objnum := pdf_new_objnum;
+            decr(obj_ptr); {object stream is not accessible to user}
+            incr(pdf_os_cntr); {only for statistics}
+            pdf_os_objidx := 0;
+            pdf_ptr := 0; {start fresh object stream}
+        end else
+            incr(pdf_os_objidx);
+        obj_os_idx(i) := pdf_os_objidx;
+        obj_offset(i) := pdf_os_cur_objnum;
+        pdf_os_objnum[pdf_os_objidx] := i;
+        pdf_os_objoff[pdf_os_objidx] := pdf_ptr;
+    end else begin
+        obj_offset(i) := pdf_offset;
+        obj_os_idx(i) := -1; {mark it as not included in object stream}
+    end;
+end;
+
+procedure pdf_begin_obj(i: integer; pdf_os_level: integer); {begin a PDF object}
+begin
+    check_pdfminorversion;
+    pdf_os_prepare_obj(i, pdf_os_level);
+    if not pdf_os_mode then begin
+        pdf_print_int(i);
+        pdf_print_ln(" 0 obj");
+    end else if pdf_compress_level = 0 then begin
+        pdf_print("% "); {debugging help}
+        pdf_print_int(i);
+        pdf_print_ln(" 0 obj");
+    end;
+end;
+
+procedure pdf_new_obj(t, i: integer; pdf_os: integer); {begin a new PDF object}
+begin
+    pdf_create_obj(t, i);
+    pdf_begin_obj(obj_ptr, pdf_os);
+end;
+
+procedure pdf_end_obj; {end a PDF object}
+begin
+    if pdf_os_mode then begin
+        if pdf_os_objidx = pdf_os_max_objs - 1 then
+            pdf_os_write_objstream;
+    end else
+        pdf_print_ln("endobj"); {end a PDF object}
+end;
+
+procedure pdf_begin_dict(i: integer; pdf_os_level: integer); {begin a PDF dictionary object}
+begin
+    check_pdfminorversion;
+    pdf_os_prepare_obj(i, pdf_os_level);
+    if not pdf_os_mode then begin
+        pdf_print_int(i);
+        pdf_print(" 0 obj ");
+    end else if pdf_compress_level = 0 then begin
+        pdf_print("% "); {debugging help}
+        pdf_print_int(i);
+        pdf_print_ln(" 0 obj");
+    end;
+    pdf_print_ln("<<");
+end;
+
+procedure pdf_new_dict(t, i: integer; pdf_os: integer); {begin a new PDF dictionary object}
+begin
+    pdf_create_obj(t, i);
+    pdf_begin_dict(obj_ptr, pdf_os);
+end;
+
+procedure pdf_end_dict; {end a PDF dictionary object}
+begin
+    if pdf_os_mode then begin
+        pdf_print_ln(">>");
+        if pdf_os_objidx = pdf_os_max_objs - 1 then
+            pdf_os_write_objstream;
+    end else
+        pdf_print_ln(">> endobj");
+end;
+
+@ Write out an accumulated object stream.
+First the object number and byte offset pairs are generated
+and appended to the ready buffered object stream.
+By this the value of \.{/First} can be calculated.
+Then a new \.{/ObjStm} object is generated, and everything is
+copied to the PDF output buffer, where also compression is done.
+When calling this procedure, |pdf_os_mode| must be |true|.
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+procedure pdf_os_write_objstream;
+var i, j, p, q: pointer;
+begin
+    if pdf_os_cur_objnum = 0 then {no object stream started}
+        return;
+    p := pdf_ptr;
+    i := 0;
+    j := 0;
+    while i <= pdf_os_objidx do begin {assemble object number and byte offset pairs}
+        pdf_print_int(pdf_os_objnum[i]);
+        pdf_print(" ");
+        pdf_print_int(pdf_os_objoff[i]);
+        if j = 9 then begin {print out in groups of ten for better readability}
+            pdf_out(pdf_new_line_char);
+            j := 0;
+        end else begin
+            pdf_print(" ");
+            incr(j);
+        end;
+        incr(i);
+    end;
+    pdf_buf[pdf_ptr - 1] := pdf_new_line_char; {no risk of flush, as we are in |pdf_os_mode|}
+    q := pdf_ptr;
+    pdf_begin_dict(pdf_os_cur_objnum, 0); {switch to PDF stream writing}
+    pdf_print_ln("/Type /ObjStm");
+    pdf_print("/N ");
+    pdf_print_int_ln(pdf_os_objidx + 1);
+    pdf_print("/First ");
+    pdf_print_int_ln(q - p);
+    pdf_begin_stream;
+    pdf_room(q - p); {should always fit into the PDF output buffer}
+    i := p;
+    while i < q do begin {write object number and byte offset pairs}
+        pdf_quick_out(pdf_os_buf[i]);
+        incr(i);
+    end;
+    i := 0;
+    while i < p do begin
+        q := i + pdf_buf_size;
+        if q > p then q := p;
+        pdf_room(q - i);
+        while i < q do begin {write the buffered objects}
+            pdf_quick_out(pdf_os_buf[i]);
+            incr(i);
+        end;
+    end;
+    pdf_end_stream;
+    pdf_os_cur_objnum := 0; {to force object stream generation next time}
+end;
+
+@ @<Declare procedures that need to be declared forward for \pdfTeX@>=
+function append_ptr(p: pointer; i: integer): pointer; {appends a pointer with
+info |i| to the end of linked list with head |p|}
+var q: pointer;
+begin
+    append_ptr := p;
+    fast_get_avail(q);
+    info(q) := i;
+    link(q) := null;
+    if p = null then begin
+        append_ptr := q;
+        return;
+    end;
+    while link(p) <> null do
+        p := link(p);
+    link(p) := q;
+end;
+
+function pdf_lookup_list(p: pointer; i: integer): pointer; {looks up for pointer
+with info |i| in list |p|}
+begin
+    pdf_lookup_list := null;
+    while p <> null do begin
+        if info(p) = i then begin
+            pdf_lookup_list := p;
+            return;
+        end;
+        p := link(p);
+    end;
+end;
+
+@ @<Glob...@>=
+@!pdf_image_procset: integer; {collection of image types used in current page/form}
+@!pdf_text_procset: boolean; {mask of used ProcSet's in the current page/form}
+
+@ Subroutines to print out various PDF objects
+
+@p procedure pdf_print_fw_int(n, w: integer); {print out an integer with
+fixed width; used for outputting cross-reference table}
+var k: integer; {$0\le k\le23$}
+begin
+    k := 0;
+    repeat dig[k] := n mod 10; n := n div 10; incr(k);
+    until k = w;
+    pdf_room(k);
+    while k > 0 do begin
+        decr(k);
+        pdf_quick_out("0" + dig[k]);
+    end;
+end;
+
+procedure pdf_out_bytes(n, w: integer); {print out an integer as
+a number of bytes; used for outputting \.{/XRef} cross-reference stream}
+var k: integer;
+byte: array[0..3] of integer; {digits in a number being output}
+begin
+    k := 0;
+    repeat byte[k] := n mod 256; n := n div 256; incr(k);
+    until k = w;
+    pdf_room(k);
+    while k > 0 do begin
+        decr(k);
+        pdf_quick_out(byte[k]);
+    end;
+end;
+
+procedure pdf_int_entry(s: str_number; v: integer); {print out an entry in
+dictionary with integer value to PDF buffer}
+begin
+    pdf_out("/");
+    pdf_print(s);
+    pdf_out(" ");
+    pdf_print_int(v);
+end;
+
+procedure pdf_int_entry_ln(s: str_number; v: integer);
+begin
+    pdf_int_entry(s, v);
+    pdf_print_nl;
+end;
+
+procedure pdf_indirect(s: str_number; o: integer); {print out an indirect
+entry in dictionary}
+begin
+    pdf_out("/");
+    pdf_print(s);
+    pdf_out(" ");
+    pdf_print_int(o);
+    pdf_print(" 0 R");
+end;
+
+procedure pdf_indirect_ln(s: str_number; o: integer);
+begin
+    pdf_indirect(s, o);
+    pdf_print_nl;
+end;
+
+procedure pdf_print_str_ln(s: str_number); {print out |s| as string in PDF
+output}
+begin
+    pdf_print_str(s);
+    pdf_print_nl;
+end;
+
+procedure pdf_str_entry(s, v: str_number); {print out an entry in
+dictionary with string value to PDF buffer}
+begin
+    if v = 0 then
+        return;
+    pdf_out("/");
+    pdf_print(s);
+    pdf_out(" ");
+    pdf_print_str(v);
+end;
+
+procedure pdf_str_entry_ln(s, v: str_number);
+begin
+    if v = 0 then
+        return;
+    pdf_str_entry(s, v);
+    pdf_print_nl;
+end;
+
+@* \[32e] Font processing.
+
+As \pdfTeX{} should also act as a back-end driver, it needs to support virtual
+fonts too. Information about virtual fonts can be found in the source of some
+\.{DVI}-related programs.
+
+Whenever we want to write out a character in a font to PDF output, we
+should check whether the used character is a virtual or read character.
+The |has_packet()| C macro checks for this condition. 
+
+@ The following code typesets a character to PDF output.
+
+@p procedure output_one_char(ffi:internal_font_number;c:integer);
+begin
+  if has_packet(ffi,c) then 
+      do_vf_packet(ffi, c)
+  else begin
+      pdf_begin_string(ffi);
+      pdf_print_char(ffi, c);
+      adv_char_width(ffi, c);
+  end;
+end;
+
+@ @<Declare procedures that need to be declared forward for \pdfTeX@>=
+procedure pdf_check_vf_cur_val; forward;
+procedure pdf_create_font_obj; forward;
+procedure pdf_init_font_cur_val; forward;
+procedure scan_pdf_ext_toks; forward;
+
+@ Here come some subroutines to deal with expanded fonts for HZ-algorithm.
+
+@d set_char_and_font(#) ==
+if is_char_node(#) then begin
+    c := character(#);
+    f := font(#);
+end
+
+@p
+function get_default_hyphen_char:integer;
+begin
+	get_default_hyphen_char:=default_hyphen_char; 
+end;
+@#
+function get_default_skew_char:integer;
+begin
+	get_default_skew_char:=default_skew_char; 
+end;
+@#
+
+procedure copy_expand_params(k, f: internal_font_number; e: integer);
+{set expansion-related parameters for an expanded font |k|, based on the base
+font |f| and the expansion amount |e|}
+begin
+    set_pdf_font_expand_ratio(k,e);
+    set_pdf_font_step(k,pdf_font_step(f));
+    set_pdf_font_auto_expand(k, pdf_font_auto_expand(f));
+    set_pdf_font_blink(k,f);
+end;
+
+function tfm_lookup(s: str_number; fs: scaled): internal_font_number;
+{looks up for a TFM with name |s| loaded at |fs| size; if found then flushes |s|}
+label exit;
+var k: internal_font_number;
+begin
+    if fs <> 0 then begin
+        for k := 1 to max_font_id do
+            if cmp_font_name(k, s) and (font_size(k) = fs) then begin
+                flush_str(s);
+                tfm_lookup := k;
+                return;
+            end;
+    end
+    else begin
+        for k := 1 to max_font_id do
+            if cmp_font_name(k, s) then begin
+	            flush_string; {|font_name|}
+                flush_str(s);
+                tfm_lookup := k;
+                return;
+            end else flush_string;
+    end;
+    tfm_lookup := null_font;
+exit:
+end;
+
+function load_expand_font(f: internal_font_number; e: integer): internal_font_number;
+{loads font |f| expanded by |e| thousandths into font memory; |e| is nonzero
+and is a multiple of |pdf_font_step(f)|}
+label found;
+var s: str_number; {font name}
+    k: internal_font_number;
+begin
+    s := expand_font_name(f, e);
+    k := tfm_lookup(s, font_size(f));
+    if k = null_font then begin
+        if pdf_font_auto_expand(f) then begin
+            k := auto_expand_font(f, e);
+	        font_id_text(k) := font_id_text(f);
+            end
+        else
+           k := read_font_info(null_cs, s, "", font_size(f), font_natural_dir(f)); 
+    end;
+    copy_expand_params(k, f, e);
+    load_expand_font := k;
+end;
+
+function fix_expand_value(f: internal_font_number; e: integer): integer;
+{return the multiple of |pdf_font_step(f)| that is nearest to |e|}
+var step: integer;
+    max_expand: integer;
+    neg: boolean;
+begin
+    fix_expand_value := 0;
+    if e = 0 then
+        return;
+    if e < 0 then begin
+        e := -e;
+        neg := true;
+        max_expand := -pdf_font_expand_ratio(pdf_font_shrink(f));
+    end
+    else begin
+        neg := false;
+        max_expand := pdf_font_expand_ratio(pdf_font_stretch(f));
+    end;
+    if e > max_expand then
+        e :=  max_expand
+    else begin
+        step := pdf_font_step(f);
+        if e mod step > 0 then
+            e := step*round_xn_over_d(e, 1, step);
+    end;
+    if neg then
+        e := -e;
+    fix_expand_value := e;
+end;
+
+function get_expand_font(f: internal_font_number; e: integer): internal_font_number;
+{look up and create if not found an expanded version of |f|; |f| is an
+expandable font; |e| is nonzero and is a multiple of |pdf_font_step(f)|}
+var k: internal_font_number;
+begin
+    k := pdf_font_elink(f);
+    while k <> null_font do begin
+        if pdf_font_expand_ratio(k) = e then begin
+            get_expand_font := k;
+            return;
+        end;
+        k := pdf_font_elink(k);
+    end;
+    k := load_expand_font(f, e);
+    set_pdf_font_elink(k,pdf_font_elink(f));
+    set_pdf_font_elink(f,k);
+    {|wterm_ln('get_expand_font ', e:1, ': ',f:1, ' became ', k:1);|}
+    get_expand_font := k;
+end;
+
+function expand_font(f: internal_font_number; e: integer): internal_font_number;
+{looks up for font |f| expanded by |e| thousandths, |e| is an arbitrary value
+between max stretch and max shrink of |f|; if not found then creates it}
+begin
+    expand_font := f;
+    if e = 0 then
+        return;
+    e := fix_expand_value(f, e);
+    if e = 0 then
+        return;
+    if pdf_font_elink(f) = null_font then
+        pdf_error("font expansion", "uninitialized pdf_font_elink");
+    expand_font := get_expand_font(f, e);
+end;
+
+procedure set_expand_params(f: internal_font_number; auto_expand: boolean;
+                            font_stretch, font_shrink, font_step, expand_ratio: integer);
+{expand a font with given parameters}
+begin
+    set_pdf_font_step(f, font_step);
+    set_pdf_font_auto_expand(f, auto_expand);
+    if font_stretch > 0 then
+        set_pdf_font_stretch(f,get_expand_font(f, font_stretch));
+    if font_shrink > 0 then
+        set_pdf_font_shrink(f, get_expand_font(f, -font_shrink));
+    if expand_ratio <> 0 then
+        set_pdf_font_expand_ratio(f,expand_ratio);
+end;
+
+procedure read_expand_font; {read font expansion spec and load expanded font}
+var font_shrink, font_stretch, font_step: integer;
+    f: internal_font_number;
+    auto_expand: boolean;
+begin
+    {read font expansion parameters}
+    scan_font_ident;
+    f := cur_val;
+    if f = null_font then
+        pdf_error("font expansion", "invalid font identifier");
+    if pdf_font_blink(f) <> null_font then
+        pdf_error("font expansion", "\pdffontexpand cannot be used this way (the base font has been expanded or letter-spaced)");
+    scan_optional_equals;
+    scan_int;
+    font_stretch := fix_int(cur_val, 0, 1000);
+    scan_int;
+    font_shrink := fix_int(cur_val, 0, 500);
+    scan_int;
+    font_step := fix_int(cur_val, 0, 100);
+    if font_step = 0 then
+        pdf_error("font expansion", "invalid step");
+    font_stretch := font_stretch - font_stretch mod font_step;
+    if font_stretch < 0 then
+        font_stretch := 0;
+    font_shrink := font_shrink - font_shrink mod font_step;
+    if font_shrink < 0 then
+        font_shrink := 0;
+    if (font_stretch = 0) and (font_shrink = 0) then
+        pdf_error("font expansion", "invalid limit(s)");
+    auto_expand := false;
+    if scan_keyword("autoexpand") then begin
+        auto_expand := true;
+        @<Scan an optional space@>; 
+    end;
+
+    {check if the font can be expanded}
+    if (pdf_font_expand_ratio(f) <> 0) then
+        pdf_error("font expansion", "this font has been expanded by another font so it cannot be used now");
+    if (pdf_font_step(f) <> 0) then
+    {this font has been expanded, ensure the expansion parameters are identical}
+    begin
+        if (pdf_font_step(f) <> font_step) or
+           ((pdf_font_stretch(f) = null_font) and (font_stretch <> 0)) or
+           ((pdf_font_stretch(f) <> null_font) and
+            (pdf_font_expand_ratio(pdf_font_stretch(f)) <> font_stretch)) or
+           ((pdf_font_shrink(f) = null_font) and (font_shrink <> 0)) or
+           ((pdf_font_shrink(f) <> null_font) and
+            (pdf_font_expand_ratio(pdf_font_shrink(f)) <> -font_shrink)) or
+           (pdf_font_auto_expand(f) <> auto_expand)
+        then
+            pdf_error("font expansion", "font has been expanded with different parameters");
+    end
+    else begin
+        if font_used(f) then
+            pdf_warning("font expansion", "font should be expanded before its first use",
+                        true, true);
+        set_expand_params(f, auto_expand, font_stretch, font_shrink, font_step, 0);
+        if font_type(f) = virtual_font_type then
+            vf_expand_local_fonts(f);
+    end;
+end;
+
+procedure new_letterspaced_font(a: small_number);
+{letter-space a font by creating a virtual font}
+var u:pointer; {user's font identifier}
+@!t:str_number; {name for the frozen font identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!f, k:internal_font_number;
+begin
+    get_r_token; u:=cur_cs;
+    if u>=hash_base then t:=text(u)
+    else if u=null_cs then t:="FONT"
+    else  begin old_setting:=selector; selector:=new_string;
+      print("FONT"); print(u-active_base); selector:=old_setting;
+    @.FONTx@>
+      str_room(1); t:=make_string;
+      end;
+    define(u,set_font,null_font); scan_optional_equals; scan_font_ident;
+    k := cur_val;
+    scan_int;
+    f := letter_space_font(u, k, fix_int(cur_val, -1000, 1000));
+    equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+
+@ We need to hold information about used characters in each font for partial
+downloading.
+
+@<Types...@>=
+char_map_array = array[0..32] of eight_bits; {move chars in range 0..32}
+fm_entry_ptr = ^integer;
+
+@ @<Glob...@>=
+@!pdf_font_list: pointer; {list of used fonts in current page}
+@!pdf_resname_prefix: str_number; {global prefix of resources name}
+@!last_tokens_string: str_number; {the number of the most recently string
+created by |tokens_to_string|}
+
+@ @<Set init...@>=
+pdf_resname_prefix := 0;
+last_tokens_string := 0;
+
+@ Reading VF files is done in C, using the procedure |do_vf()|
+
+@* \[32f] PDF shipping out.
+To ship out a \TeX\ box to PDF page description we need to implement
+|pdf_hlist_out|, |pdf_vlist_out| and |pdf_ship_out|, which are equivalent to
+the \TeX' original |hlist_out|, |vlist_out| and |ship_out| resp. But first we
+need to declare some procedures needed in |pdf_hlist_out| and |pdf_vlist_out|.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_out_literal(p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+    s: str_number;
+begin
+    old_setting:=selector; selector:=new_string;
+    show_token_list(link(pdf_literal_data(p)),null,pool_size-pool_ptr);
+    selector:=old_setting;
+    s := make_string;
+    literal(s, pdf_literal_mode(p), false);
+    flush_str(s);
+end;
+
+procedure pdf_out_colorstack(p:pointer);
+var old_setting: 0..max_selector; {holds print |selector|}
+    s: str_number;
+    cmd: integer;
+    stack_no: integer;
+    literal_mode: integer;
+begin
+    cmd := pdf_colorstack_cmd(p);
+    stack_no := pdf_colorstack_stack(p);
+    literal_mode := 0;
+    if stack_no >= colorstackused then begin
+        print_nl("");
+        print("Color stack ");
+        print_int(stack_no);
+        print(" is not initialized for use!");
+        print_nl("");
+        return;
+    end;
+    case cmd of
+    colorstack_set, colorstack_push: begin
+        old_setting:=selector; selector:=new_string;
+        show_token_list(link(pdf_colorstack_data(p)),null,pool_size-pool_ptr);
+        selector:=old_setting;
+        s := make_string;
+        if cmd = colorstack_set then
+            literal_mode := colorstackset(stack_no, s)
+        else
+            literal_mode := colorstackpush(stack_no, s);
+        if length(s) > 0 then
+            literal(s, literal_mode, false);
+        flush_str(s);
+        return;
+    end;
+    colorstack_pop: literal_mode := colorstackpop(stack_no);
+    colorstack_current: literal_mode := colorstackcurrent(stack_no);
+    othercases do_nothing
+    endcases;
+    if cur_length > 0 then begin
+        s := make_string;
+        literal(s, literal_mode, false);
+        flush_str(s);
+    end
+end;
+
+procedure pdf_out_colorstack_startpage;
+var i: integer;
+    max: integer;
+    start_status: integer;
+    literal_mode: integer;
+    s: str_number;
+begin
+    i := 0;
+    max := colorstackused;
+    while i < max do begin
+        start_status := colorstackskippagestart(i);
+        if start_status = 0 then begin
+            literal_mode := colorstackcurrent(i);
+            if cur_length > 0 then begin
+                s := make_string;
+                literal(s, literal_mode, false);
+                flush_str(s);
+            end;
+        end;
+        incr(i);
+    end;
+end;
+
+procedure pdf_out_setmatrix(p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+    s: str_number;
+begin
+    old_setting:=selector; selector:=new_string;
+    show_token_list(link(pdf_setmatrix_data(p)),null,pool_size-pool_ptr);
+    selector:=old_setting;
+    str_room(7);
+    str_pool[pool_ptr] := 0; { make C string for pdfsetmatrix }
+    pdfsetmatrix(str_start[str_ptr], cur_h, cur_page_height - cur_v);
+    str_room(7);
+    append_char(" ");
+    append_char("0");
+    append_char(" ");
+    append_char("0");
+    append_char(" ");
+    append_char("c");
+    append_char("m");
+    s := make_string;
+    literal(s, set_origin, false);
+    flush_str(s);
+end;
+
+procedure pdf_out_save;
+begin
+    checkpdfsave(cur_h, cur_v);
+    literal("q", set_origin, false);
+end;
+
+procedure pdf_out_restore;
+begin
+    checkpdfrestore(cur_h, cur_v);
+    literal("Q", set_origin, false);
+end;
+
+procedure pdf_special(p: pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+    s: str_number;
+begin
+    old_setting:=selector; selector:=new_string;
+    show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
+    selector:=old_setting;
+    s := make_string;
+    literal(s, scan_special, true);
+    flush_str(s);
+end;
+
+procedure do_late_lua(p: pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+    s: str_number;
+begin
+    old_setting:=selector; selector:=new_string;
+    show_token_list(link(late_lua_data(p)),null,pool_size-pool_ptr);
+    selector:=old_setting;
+    s := make_string;
+    latelua(late_lua_reg(p), s);
+    flush_str(s);
+end;
+
+procedure pdf_print_toks(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+    s := tokens_to_string(p);
+    if length(s) > 0 then
+        pdf_print(s);
+    flush_str(s);
+end;
+
+procedure pdf_print_toks_ln(p: pointer); {print tokens list |p|}
+var s: str_number;
+begin
+    s := tokens_to_string(p);
+    if length(s) > 0 then begin
+        pdf_print_ln(s);
+    end;
+    flush_str(s);
+end;
+
+@ Similiar to |vlist_out|, |pdf_vlist_out| needs to be declared forward
+
+@p procedure@?pdf_vlist_out; forward;
+
+@ The implementation of procedure |pdf_hlist_out| is similiar to |hlist_out|
+
+@p @t\4@>@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>@t@>@/
+
+procedure pdf_hlist_out; {output an |hlist_node| box}
+label move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+c_wd,c_ht,c_dp: scaled;
+  {the real width, height and depth of the character}
+w: scaled; { temporary value for directional width calculation }
+dir_nest: integer; { for tracking nested direction nodes }
+edge_v: scaled;
+edge_h: scaled;
+effective_horizontal: scaled;
+basepoint_horizontal: scaled;
+basepoint_vertical: scaled;
+saving_h: scaled;
+saving_v: scaled;
+save_direction: integer;
+dvi_ptr,dir_ptr,dir_tmp:pointer;
+@!left_edge: scaled; {the left coordinate for this box}
+@!save_h: scaled; {what |cur_h| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p,q:pointer; {current position in the hlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_wd:scaled; {width of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {right edge of sub-box or leader space}
+@!prev_p:pointer; {one step behind |p|}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!save_cur_glue:real; { saved version, for direction switch }
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_cur_g:scaled; { saved version, for direction switch }
+@!i: small_number; {index to scan |pdf_link_stack|}
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+dvi_ptr:=0;  lx:=0;
+@<DIR: Initialize |dir_ptr| for |ship_out|@>;
+saving_h:=cur_h; saving_v:=cur_v;
+incr(cur_s);
+base_line:=cur_v;
+left_edge:=cur_h;
+prev_p:=this_box+list_offset;
+@<Create link annotations for the current hbox if needed@>;
+while p<>null do
+    @<Output node |p| for |pdf_hlist_out| and move to the next node,
+    maintaining the condition |cur_v=base_line|@>;
+cur_h:=saving_h; cur_v:=saving_v;
+decr(cur_s);
+dvi_direction:=save_direction;
+@<DIR: Reset |dir_ptr|@>;
+end;
+
+@ @<Create link annotations for the current hbox if needed@>=
+for i := 1 to pdf_link_stack_ptr do begin
+    pdfassert(is_running(pdf_width(pdf_link_stack[i].link_node)));
+    if (pdf_link_stack[i].nesting_level = cur_s) then
+        append_link(this_box, left_edge, base_line, i);
+end
+
+@ 
+
+@d pdf_dvicmd_set(#)==output_one_char(f,#)
+@d pdf_dvicmd_put(#)==output_one_char(f,#); cur_h:=cur_h-c_wd
+@d pdf_dvicmd_right(#)==cur_h := cur_h + #
+@d pdf_dvicmd_left(#)== cur_h := cur_h - #
+@d pdf_dvicmd_down(#)== cur_v := cur_v - #
+@d pdf_dvicmd_up(#)==   cur_v := cur_v + #
+@d pdf_dvicmd_h(#)==case box_direction(dvi_direction) of
+  dir_TL_: begin cur_h := cur_h + #;  end;
+  dir_TR_: begin cur_h := cur_h - #;  end;
+  dir_LT_: begin do_nothing; {if o=right1 then o:=down1 else o:=right1;}  end;
+  dir_LB_: begin do_nothing; {if o=right1 then begin o:=down1; negate(w); end else o:=right1;} end;
+  dir_BL_: begin do_nothing; {if o=down1 then negate(w); } end;
+  dir_BR_: begin do_nothing; {  negate(w);} end;
+  dir_RT_: begin do_nothing; {if o=right1 then o:=down1 else begin o:=right1; negate(w); end;} end;
+  dir_RB_: begin do_nothing; {if o=right1 then o:=down1 else o:=right1;  negate(w);} end;
+  end
+
+
+@<Output node |p| for |pdf_hlist_out|...@>=
+begin
+if is_char_node(p) then 
+  begin
+  repeat f:=font(p); c:=character(p);
+  ci := char_info_short (f,c);
+  {|writeln('hlist_out: a char node ', c:1 , ' in font ',f:1);|}
+  if is_valid_char(c) then begin
+  if is_rotated(dvi_direction) then begin
+    c_ht:=charinfo_width(ci) div 2;
+    c_dp:=0;
+    c_wd:=charinfo_height(ci)+charinfo_depth(ci);
+    end
+  else begin
+    c_ht:=charinfo_height(ci);
+    c_dp:=charinfo_depth(ci);
+    c_wd:=charinfo_width(ci);
+    end;
+  if (font_natural_dir(f)<>-1) then
+    case font_direction(dvi_direction) of
+    dir__LT,dir__LB: begin
+      if x_displace(p)<>0 then pdf_dvicmd_right(x_displace(p));
+      if y_displace(p)<>0 then pdf_dvicmd_up(-y_displace(p));
+      pdf_dvicmd_set(c);
+      if x_displace(p)<>0 then pdf_dvicmd_left(x_displace(p)); 
+      if y_displace(p)<>0 then pdf_dvicmd_down(-y_displace(p));
+      end;
+    dir__RT,dir__RB: begin
+      if x_displace(p)<>0 then pdf_dvicmd_left(x_displace(p));
+      if y_displace(p)<>0 then pdf_dvicmd_up(-y_displace(p));
+      pdf_dvicmd_left(c_wd);
+      pdf_dvicmd_put(c);
+      if x_displace(p)<>0 then pdf_dvicmd_right(x_displace(p));
+      if y_displace(p)<>0 then pdf_dvicmd_down(-y_displace(p));
+      end;
+    dir__TL,dir__TR: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_down(c_wd);
+      end;
+    dir__BL,dir__BR: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_up(c_wd);
+      end;
+    dir__LL,dir__LR: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_wd);
+      end;
+    dir__RL,dir__RR: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_left(c_wd);
+      end;
+    dir__TT,dir__TB: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_down(c_wd);
+      end;
+    dir__BT,dir__BB: begin
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_up(c_wd);
+      end;
+    end
+  else
+    case font_direction(dvi_direction) of
+    dir__LT: begin
+	  if x_displace(p)<>0 then pdf_dvicmd_right(x_displace(p));
+	  if y_displace(p)<>0 then pdf_dvicmd_up(-y_displace(p));
+      pdf_dvicmd_set(c);
+	  if x_displace(p)<>0 then pdf_dvicmd_left(x_displace(p));
+	  if y_displace(p)<>0 then pdf_dvicmd_down(-y_displace(p));
+      end;
+    dir__LB: begin
+      pdf_dvicmd_down(c_ht);
+      pdf_dvicmd_set(c);
+      pdf_dvicmd_up(c_ht);
+      end;
+    dir__RT: begin
+	  if x_displace(p)<>0 then pdf_dvicmd_left(x_displace(p));
+	  if y_displace(p)<>0 then pdf_dvicmd_up(-y_displace(p));
+      pdf_dvicmd_left(c_wd);
+      pdf_dvicmd_put(c);
+	  if x_displace(p)<>0 then pdf_dvicmd_right(x_displace(p));
+	  if y_displace(p)<>0 then pdf_dvicmd_down(-y_displace(p));
+      end;
+    dir__RB: begin
+      pdf_dvicmd_left(c_wd);
+      pdf_dvicmd_down(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_up(c_ht);
+      end;
+    dir__TL: begin
+      pdf_dvicmd_down(c_wd);
+      pdf_dvicmd_left(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_ht);
+      end;
+    dir__TR: begin
+      pdf_dvicmd_down(c_wd);
+      pdf_dvicmd_left(c_dp);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_dp);
+      end;
+    dir__BL: begin
+      pdf_dvicmd_left(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_ht);
+      pdf_dvicmd_up(c_wd);
+      end;
+    dir__BR: begin
+      pdf_dvicmd_left(c_dp);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_dp);
+      pdf_dvicmd_up(c_wd);
+      end;
+    dir__LL,dir__LR: begin
+      pdf_dvicmd_down(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_up(c_ht);
+      pdf_dvicmd_right(c_wd);
+      end;
+    dir__RL,dir__RR: begin
+      pdf_dvicmd_left(c_wd);
+      pdf_dvicmd_down(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_up(c_ht);
+      end;
+    dir__TT,dir__TB: begin
+      pdf_dvicmd_down(c_wd);
+      pdf_dvicmd_left(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_ht);
+      end;
+    dir__BT,dir__BB: begin
+      pdf_dvicmd_left(c_ht);
+      pdf_dvicmd_put(c);
+      pdf_dvicmd_right(c_ht);
+      pdf_dvicmd_up(c_wd);
+      end;
+    end;
+    cur_h:=cur_h+c_wd;
+  end
+  else
+    char_warning(f, c);
+  prev_p:=p;
+  p:=vlink(p);
+  until not is_char_node(p);
+  end
+else @<Output the non-|char_node| |p| for |pdf_hlist_out|
+    and move to the next node@>;
+end
+
+@ @<Output the non-|char_node| |p| for |pdf_hlist_out|...@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in an hlist@>;
+disc_node: if vlink(no_break(p))<>null then begin
+  q:=tail_of_list (vlink(no_break(p))); {TODO, this should be a tlink}
+  vlink(q):=vlink(p);
+  q:=vlink(no_break(p)); 
+  vlink(no_break(p)):=null;
+  vlink(p):=q; 
+  end;
+rule_node: begin 
+  if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+    then begin
+    rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+    end
+  else begin
+    rule_ht:=width(p) div 2;
+    rule_dp:=width(p) div 2;
+    rule_wd:=height(p)+depth(p);
+    end;
+  goto fin_rule;
+  end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_hlist_out|@>;
+glue_node: @<(\pdfTeX) Move right or output leaders@>;
+margin_kern_node,kern_node: pdf_dvicmd_h(width(p));
+math_node: pdf_dvicmd_h(surround(p));
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in an hlist@>;
+move_past: pdf_dvicmd_h(rule_wd);
+next_p:prev_p:=p; p:=vlink(p);
+end
+
+@ @<(\pdfTeX) Output a box in an hlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+  then begin
+  effective_horizontal:=width(p);
+  basepoint_vertical:=0;
+  if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then
+    basepoint_horizontal:=width(p)
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  effective_horizontal:=height(p)+depth(p);
+  if not (is_mirrored(box_dir(p))) then
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(p)
+    else
+      basepoint_horizontal:=depth(p)
+  else
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(p)
+    else
+      basepoint_horizontal:=height(p);
+  if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:= -(width(p) div 2)
+  else
+    basepoint_vertical:= (width(p) div 2);
+  end;
+if not (is_mirrored(dvi_direction)) then
+  basepoint_vertical := basepoint_vertical + shift_amount(p)
+    {shift the box `down'}
+else
+  basepoint_vertical := basepoint_vertical - shift_amount(p);
+    {shift the box `up'}
+if list_ptr(p)=null then begin pdf_dvicmd_h(effective_horizontal); end
+else begin
+  temp_ptr:=p; 
+  edge:=cur_h; pdf_dvicmd_h(basepoint_horizontal);
+  edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+  if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+  cur_h:=edge; pdf_dvicmd_h(effective_horizontal);
+  cur_v:=base_line;
+  end
+end
+
+@ @<(\pdfTeX) Output a rule in an hlist@>=
+if is_running(rule_ht) then rule_ht:=height(this_box);
+if is_running(rule_dp) then rule_dp:=depth(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+  begin cur_v:=base_line+rule_dp;
+  case font_direction(dvi_direction) of
+  dir__LT: begin
+ 	pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    end;
+  dir__LB: begin
+    pdf_dvicmd_down(rule_ht);
+	pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_up(rule_ht);
+    end;
+  dir__RT: begin
+    pdf_dvicmd_left(rule_wd);
+  	pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+	pdf_dvicmd_right(rule_wd);
+    end;
+  dir__RB: begin
+    pdf_dvicmd_left(rule_wd);
+    pdf_dvicmd_down(rule_ht);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+	pdf_dvicmd_left(rule_wd);
+    pdf_dvicmd_up(rule_ht);
+    end;
+  dir__TL: begin
+    pdf_dvicmd_down(rule_wd);
+    pdf_dvicmd_left(rule_ht);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    end;
+  dir__TR: begin
+    pdf_dvicmd_down(rule_wd);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_left(rule_ht);
+    end;
+  dir__BL: begin
+    pdf_dvicmd_left(rule_ht);
+	pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_up(rule_wd);
+    end;
+  dir__BR: begin
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+	pdf_dvicmd_left(rule_ht);
+    pdf_dvicmd_up(rule_wd);
+    end;
+  end;
+  {|cur_h:=cur_h+rule_wd;|}{|dir__RT| is corrected elsewhere}
+  cur_v:=base_line;
+  end
+
+@ @<(\pdfTeX) Move right or output leaders@>=
+begin g:=glue_ptr(p); rule_wd:=width(g)-cur_g;
+if g_sign<>normal then
+  begin if g_sign=stretching then
+    begin if stretch_order(g)=g_order then
+      begin cur_glue:=cur_glue+stretch(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+      cur_g:=round(glue_temp);
+      end;
+    end
+  else if shrink_order(g)=g_order then
+      begin cur_glue:=cur_glue-shrink(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+      cur_g:=round(glue_temp);
+      end;
+  end;
+rule_wd:=rule_wd+cur_g;
+if subtype(p)>=a_leaders then
+  @<(\pdfTeX) Output leaders in an hlist, |goto fin_rule| if a rule
+    or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in an hlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+  begin rule_ht:=height(leader_box); rule_dp:=depth(leader_box);
+  goto fin_rule;
+  end;
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then leader_wd:=width(leader_box)
+else
+  leader_wd:=height(leader_box)+depth(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+  begin
+  edge:=cur_h+rule_wd;
+  {TODO this double |case| is a hack, and not quite the proper
+   solution, but it produces the correct output for |xleaders|
+   in TRT mode, which is important for KASHIDAH fills.}
+  case box_direction(dvi_direction) of
+  dir_TR_,dir_RT_: begin
+    edge:=cur_h;
+    cur_h:=cur_h-rule_wd;
+    end;
+  end;
+  @<Let |cur_h| be the position of the first box, and set |leader_wd+lx|
+    to the spacing between corresponding parts of boxes@>;
+  while cur_h+leader_wd<=edge do
+    @<(\pdfTeX) Output a leader box at |cur_h|,
+      then advance |cur_h| by |leader_wd+lx|@>;
+  case box_direction(dvi_direction) of
+  dir_TR_,dir_RT_: cur_h:=cur_h-rule_wd;
+  end;
+  goto next_p;
+  end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_h|, ...@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(leader_box)])(dir_primary[dvi_direction]))
+  then begin
+  basepoint_vertical:=0;
+ if dir_opposite(dir_secondary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then begin
+    basepoint_horizontal:=width(leader_box)
+    end
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  if not (is_mirrored(box_dir(leader_box))) then
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(leader_box)
+    else
+      basepoint_horizontal:=depth(leader_box)
+  else
+    if dir_eq(dir_primary[box_dir(leader_box)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(leader_box)
+    else
+      basepoint_horizontal:=height(leader_box);
+  if dir_eq(dir_secondary[box_dir(leader_box)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:= -(width(leader_box) div 2)
+  else
+    basepoint_vertical:= (width(leader_box) div 2);
+  end;
+if not (is_mirrored(dvi_direction)) then
+  basepoint_vertical := basepoint_vertical + shift_amount(leader_box)
+    {shift the box `down'}
+else
+  basepoint_vertical := basepoint_vertical - shift_amount(leader_box);
+    {shift the box `up'}
+temp_ptr:=leader_box;
+edge_h:=cur_h; cur_h:=cur_h + basepoint_horizontal;
+edge_v:=cur_v; cur_v:=base_line + basepoint_vertical;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_h:=edge_h+leader_wd+lx; cur_v:=base_line;
+end
+
+@ The |pdf_vlist_out| routine is similar to |pdf_hlist_out|, but a bit simpler.
+@p procedure pdf_vlist_out; {output a |pdf_vlist_node| box}
+label move_past, fin_rule, next_p;
+var left_edge: scaled; {the left coordinate for this box}
+@!top_edge: scaled; {the top coordinate for this box}
+@!save_v: scaled; {what |cur_v| should pop to}
+@!this_box: pointer; {pointer to containing box}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!p:pointer; {current position in the vlist}
+@!leader_box:pointer; {the leader box being replicated}
+@!leader_ht:scaled; {height of leader box being replicated}
+@!lx:scaled; {extra space between leader boxes}
+@!outer_doing_leaders:boolean; {were we doing leaders?}
+@!edge:scaled; {bottom boundary of leader space}
+@!glue_temp:real; {glue value before rounding}
+@!cur_glue:real; {glue seen so far}
+@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
+@!save_direction: integer;
+@!effective_vertical: scaled;
+@!basepoint_horizontal: scaled;
+@!basepoint_vertical: scaled;
+@!edge_v: scaled;
+@!saving_v: scaled;
+@!saving_h: scaled;
+begin cur_g:=0; cur_glue:=float_constant(0);
+this_box:=temp_ptr; g_order:=glue_order(this_box);
+g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+{pdfassert(p<>0);}
+saving_v:=cur_v; saving_h:=cur_h;
+{|writeln(''); writeln('vlist_out: left edge: ', cur_h:1 , '');|}
+save_direction:=dvi_direction;
+dvi_direction:=box_dir(this_box);
+incr(cur_s);
+left_edge:=cur_h; cur_v:=cur_v-height(this_box); top_edge:=cur_v;
+@<Create thread for the current vbox if needed@>;
+while p<>null do
+    @<Output node |p| for |pdf_vlist_out| and move to the next node,
+    maintaining the condition |cur_h=left_edge|@>;
+cur_v:=saving_v; cur_h:=saving_h;
+decr(cur_s);
+dvi_direction:=save_direction;
+end;
+
+@ @<Create thread for the current vbox if needed@>=
+if (last_thread <> null) and is_running(pdf_thread_dp) and
+    (pdf_thread_level = cur_s) then
+    append_thread(this_box, left_edge, top_edge + height(this_box))
+
+@ @<Output node |p| for |pdf_vlist_out|...@>=
+begin if is_char_node(p) then confusion("pdfvlistout")
+@:this can't happen pdfvlistout}{\quad pdfvlistout@>
+else @<Output the non-|char_node| |p| for |pdf_vlist_out|@>;
+next_p:p:=vlink(p);
+end
+
+@ @<Output the non-|char_node| |p| for |pdf_vlist_out|@>=
+begin case type(p) of
+hlist_node,vlist_node:@<(\pdfTeX) Output a box in a vlist@>;
+rule_node: begin
+  if not (dir_orthogonal(dir_primary[rule_dir(p)])(dir_primary[dvi_direction]))
+    then begin
+    rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+    end
+  else begin
+    rule_ht:=width(p) div 2;
+    rule_dp:=width(p) div 2;
+    rule_wd:=height(p)+depth(p);
+    end;
+  goto fin_rule;
+  end;
+whatsit_node: @<Output the whatsit node |p| in |pdf_vlist_out|@>;
+glue_node: @<(\pdfTeX) Move down or output leaders@>;
+kern_node:cur_v:=cur_v+width(p);
+othercases do_nothing
+endcases;@/
+goto next_p;
+fin_rule: @<(\pdfTeX) Output a rule in a vlist, |goto next_p|@>;
+move_past: cur_v:=cur_v+rule_ht;
+end
+
+@ TODO: the direct test to switch between |width(p)| and |-width(p)|
+is definately wrong, because it does not nest properly. But at least
+it fixes a very obvious problem that otherwise occured with
+\.{\\pardir TLT} in a document with \.{\\bodydir TRT}, and so it
+will have to do for now.
+
+@<(\pdfTeX) Output a box in a vlist@>=
+begin
+if not (dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[dvi_direction]))
+  then begin
+  effective_vertical:=height(p)+depth(p);
+  if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then
+    basepoint_vertical:=depth(p)
+  else
+    basepoint_vertical:=height(p);
+  if dir_opposite(dir_secondary[box_dir(p)])(dir_secondary[dvi_direction]) then begin
+    if dvi_direction=dir_TL_ then
+      basepoint_horizontal:=width(p) 
+    else
+      basepoint_horizontal:=-width(p);
+    end
+  else
+    basepoint_horizontal:=0;
+  end
+else begin
+  effective_vertical:=width(p);
+  if not (is_mirrored(box_dir(p))) then
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=height(p)
+    else
+      basepoint_horizontal:=depth(p)
+  else
+    if dir_eq(dir_primary[box_dir(p)])(dir_secondary[dvi_direction]) then
+      basepoint_horizontal:=depth(p)
+    else
+      basepoint_horizontal:=height(p);
+  if dir_eq(dir_secondary[box_dir(p)])(dir_primary[dvi_direction]) then
+    basepoint_vertical:=0
+  else
+    basepoint_vertical:=width(p);
+  end;
+basepoint_horizontal := basepoint_horizontal + shift_amount(p);
+if list_ptr(p)=null then begin
+  cur_v:=cur_v+effective_vertical;
+  end
+else  begin 
+  edge_v:=cur_v;
+  cur_h:=left_edge + basepoint_horizontal;
+  cur_v:=cur_v + basepoint_vertical; 
+  temp_ptr:=p;
+  if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+  cur_h:=left_edge; cur_v:=edge_v + effective_vertical;
+  end
+end
+
+@ @<(\pdfTeX) Output a rule in a vlist...@>=
+if is_running(rule_wd) then rule_wd:=width(this_box);
+rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
+cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+  begin
+  case font_direction(dvi_direction) of
+  dir__LT: begin
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    {|pdf_dvicmd_left(rule_wd);|}
+    end;
+  dir__LB: begin
+    pdf_dvicmd_down(rule_ht);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+	pdf_dvicmd_left(rule_wd);
+    pdf_dvicmd_up(rule_ht);
+    end;
+  dir__RT: begin
+    pdf_dvicmd_left(rule_wd);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_left(rule_wd);
+    end;
+  dir__RB: begin
+    pdf_dvicmd_down(rule_ht);
+    pdf_dvicmd_left(rule_wd);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_up(rule_ht);
+    end;
+  dir__TL: begin
+    pdf_dvicmd_down(rule_wd);
+    pdf_dvicmd_left(rule_ht);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_up(rule_wd);
+    end;
+  dir__TR: begin
+    pdf_dvicmd_down(rule_wd);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_left(rule_wd);
+    pdf_dvicmd_up(rule_wd);
+    end;
+  dir__BL: begin
+    pdf_dvicmd_left(rule_ht);
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    end;
+  dir__BR: begin
+    pdf_set_rule(cur_h, cur_v, rule_wd, rule_ht);
+    pdf_dvicmd_left(rule_wd);
+    end;
+  end;
+  end;
+goto next_p
+
+@ @<(\pdfTeX) Move down or output leaders@>=
+begin g:=glue_ptr(p); rule_ht:=width(g)-cur_g;
+if g_sign<>normal then
+  begin if g_sign=stretching then
+    begin if stretch_order(g)=g_order then
+      begin cur_glue:=cur_glue+stretch(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+@^real multiplication@>
+      cur_g:=round(glue_temp);
+      end;
+    end
+  else if shrink_order(g)=g_order then
+      begin cur_glue:=cur_glue-shrink(g);
+      vet_glue(float(glue_set(this_box))*cur_glue);
+      cur_g:=round(glue_temp);
+      end;
+  end;
+rule_ht:=rule_ht+cur_g;
+if subtype(p)>=a_leaders then
+  @<(\pdfTeX) Output leaders in a vlist, |goto fin_rule| if a rule
+    or to |next_p| if done@>;
+goto move_past;
+end
+
+@ @<(\pdfTeX) Output leaders in a vlist...@>=
+begin leader_box:=leader_ptr(p);
+if type(leader_box)=rule_node then
+  begin rule_wd:=width(leader_box); rule_dp:=0;
+  goto fin_rule;
+  end;
+leader_ht:=height(leader_box)+depth(leader_box);
+if (leader_ht>0)and(rule_ht>0) then
+  begin rule_ht:=rule_ht+10; {compensate for floating-point rounding}
+  edge:=cur_v+rule_ht; lx:=0;
+  @<Let |cur_v| be the position of the first box, and set |leader_ht+lx|
+    to the spacing between corresponding parts of boxes@>;
+  while cur_v+leader_ht<=edge do
+    @<(\pdfTeX) Output a leader box at |cur_v|,
+      then advance |cur_v| by |leader_ht+lx|@>;
+  cur_v:=edge-10; goto next_p;
+  end;
+end
+
+@ @<(\pdfTeX) Output a leader box at |cur_v|, ...@>=
+begin cur_h:=left_edge+shift_amount(leader_box);
+cur_v:=cur_v+height(leader_box); save_v:=cur_v;
+temp_ptr:=leader_box;
+outer_doing_leaders:=doing_leaders; doing_leaders:=true;
+if type(leader_box)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+doing_leaders:=outer_doing_leaders;
+cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+
+@ |fix_pdfoutput| freezes |pdfoutput| when something has been written to
+the output.
+
+@p procedure fix_pdfoutput;
+begin
+    if not fixed_pdfoutput_set then begin
+        fixed_pdfoutput := pdf_output;
+        fixed_pdfoutput_set := true;
+    end
+    else if fixed_pdfoutput <> pdf_output then
+        pdf_error("setup",
+            "\pdfoutput can only be changed before anything is written to the output");
+    if fixed_pdfoutput_set then fix_pdf_draftmode;
+end;
+
+@ |fix_pdf_draftmode| freezes |pdfdraftmode| when something has been written to
+the output and also switches somes things off when draftmode is on.
+@p procedure fix_pdf_draftmode;
+begin
+    if not fixed_pdf_draftmode_set then begin
+        fixed_pdf_draftmode := pdf_draftmode;
+        fixed_pdf_draftmode_set := true;
+    end
+    else if fixed_pdf_draftmode <> pdf_draftmode then
+        pdf_error("setup",
+            "\pdfdraftmode can only be changed before anything is written to the output");
+    if fixed_pdf_draftmode_set and fixed_pdf_draftmode > 0 then begin
+        fixed_pdf_draftmode_set := true;
+        pdf_compress_level := 0;
+        fixed_pdf_objcompresslevel := 0;
+    end;
+end;
+
+@ |pdf_ship_out| is used instead of |ship_out| to shipout a box to PDF
+output. If |shipping_page| is not set then the output will be a Form object,
+otherwise it will be a Page object.
+
+@p procedure pdf_ship_out(p: pointer; shipping_page: boolean); {output the box |p|}
+label done, done1;
+var i,j,k:integer; {general purpose accumulators}
+save_font_list: pointer; {to save |pdf_font_list| during flushing pending forms}
+save_obj_list: pointer; {to save |pdf_obj_list|}
+save_ximage_list: pointer; {to save |pdf_ximage_list|}
+save_xform_list: pointer; {to save |pdf_xform_list|}
+save_image_procset: integer;  {to save |pdf_image_procset|}
+save_text_procset: integer;  {to save |pdf_text_procset|}
+save_cur_page_height: scaled; {to save |cur_page_height| during flushing pending forms}
+pdf_last_resources: integer; {pointer to most recently generated Resources object}
+pre_callback_id:integer;
+post_callback_id:integer;
+ret:boolean;
+begin 
+pre_callback_id:=callback_defined(start_page_number_callback);	
+post_callback_id:=callback_defined(stop_page_number_callback);	
+if (tracing_output>0)and(pre_callback_id=0) then
+  begin print_nl(""); print_ln;
+  print("Completed box being shipped out");
+@.Completed box...@>
+  end;
+if not init_pdf_output then begin
+    @<Initialize variables for \.{PDF} output@>;
+    init_pdf_output := true;
+end;
+is_shipping_page := shipping_page;
+if shipping_page then begin
+  if pre_callback_id>0 then 
+    ret:=run_callback(pre_callback_id,'->')
+  else begin
+    if term_offset>max_print_line-9 then print_ln
+    else if (term_offset>0)or(file_offset>0) then print_char(" ");
+    print_char("["); j:=9;
+    while (count(j)=0)and(j>0) do decr(j);
+    for k:=0 to j do
+      begin print_int(count(k));
+      if k<j then print_char(".");
+      end;
+    end;
+  update_terminal;
+end;
+if (tracing_output>0)and(post_callback_id=0) then
+  begin if shipping_page then print_char("]");
+  begin_diagnostic; show_box(p); end_diagnostic(true);
+  end;
+@<(\pdfTeX) Ship box |p| out@>;
+if (tracing_output<=0)and(post_callback_id=0) and shipping_page then
+  print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+if post_callback_id>0 then 
+  ret:=run_callback(post_callback_id,'->');
+end;
+
+@ @<(\pdfTeX) Ship box |p| out@>=
+@<Update the values of |max_h| and |max_v|; but if the page is too large,
+  |goto done|@>;
+@<Initialize variables as |pdf_ship_out| begins@>;
+if type(p)=vlist_node then pdf_vlist_out@+else pdf_hlist_out;
+if shipping_page then
+    incr(total_pages);
+cur_s:=-1;
+@<Finish shipping@>;
+done:
+
+@ @<Initialize variables as |pdf_ship_out| begins@>=
+fix_pdfoutput;
+temp_ptr:=p;
+prepare_mag;
+pdf_last_resources := pdf_new_objnum;
+@<Reset resource lists@>;
+dvi_direction:=page_direction;
+@<Calculate PDF page dimensions and margins@>;
+if not shipping_page then begin
+    pdf_begin_dict(pdf_cur_form, 0);
+    pdf_last_stream := pdf_cur_form;
+    @<Write out Form stream header@>;
+end
+else begin
+    pdf_last_page := get_obj(obj_type_page, total_pages + 1, 0);
+    obj_aux(pdf_last_page) := 1; {mark that this page has beed created}
+    pdf_new_dict(obj_type_others, 0, 0);
+    pdf_last_stream := obj_ptr;
+    @<Reset PDF mark lists@>;
+end;
+@<Start stream of page/form contents@>
+
+@ @<Reset resource lists@>=
+pdf_font_list := null;
+pdf_obj_list := null;
+pdf_xform_list := null;
+pdf_ximage_list := null;
+pdf_text_procset := false;
+pdf_image_procset := 0
+
+@ @<Reset PDF mark lists@>=
+pdf_annot_list := null;
+pdf_link_list := null;
+pdf_dest_list := null;
+pdf_bead_list := null;
+last_thread := null
+
+@ @<Calculate PDF page dimensions and margins@>=
+if is_shipping_page then begin
+    if page_width > 0 then
+        cur_page_width := page_width
+    else
+        cur_page_width := width(p) + 2 * pdf_h_offset;
+    if page_height > 0 then
+        cur_page_height := page_height
+    else
+        cur_page_height := height(p) + depth(p) + 2 * pdf_v_offset;
+    if page_bottom_offset <> 0 then
+        cur_bottom_offset := page_bottom_offset
+    else
+        cur_bottom_offset := one_inch;
+    if page_right_offset <> 0 then
+        cur_right_offset := page_right_offset
+    else
+        cur_right_offset :=  one_inch;
+    cur_h := pdf_h_offset;
+    cur_v := height(p) + pdf_v_offset;
+    case box_direction(dvi_direction) of
+        dir_TL_,dir_LT_: begin end;
+        dir_TR_,dir_RT_: begin cur_h:=cur_page_width-cur_right_offset; end;
+        dir_RB_,dir_BR_: begin cur_h:=cur_page_width-cur_right_offset; cur_v:=-cur_bottom_offset; end;
+        dir_BL_,dir_LB_: begin cur_v:=-cur_bottom_offset; end; 
+    end;
+end
+else begin
+   cur_page_width := width(p);
+   cur_page_height := height(p) + depth(p);
+   cur_h := 0;
+   cur_v := height(p);
+end;
+pdf_origin_h := 0;
+pdf_origin_v := cur_page_height;
+
+@ Here we write out the header for Form.
+
+@<Write out Form stream header@>=
+pdf_print_ln("/Type /XObject");
+pdf_print_ln("/Subtype /Form");
+if obj_xform_attr(pdf_cur_form) <> null then begin
+    pdf_print_toks_ln(obj_xform_attr(pdf_cur_form));
+    delete_toks(obj_xform_attr(pdf_cur_form));
+end;
+pdf_print("/BBox [");
+pdf_print("0 0 ");
+pdf_print_bp(cur_page_width); pdf_out(" ");
+pdf_print_bp(cur_page_height); pdf_print_ln("]");
+pdf_print_ln("/FormType 1");
+pdf_print_ln("/Matrix [1 0 0 1 0 0]");
+pdf_indirect_ln("Resources", pdf_last_resources)
+
+@ @<Start stream of page/form contents@>=
+pdf_begin_stream;
+if shipping_page then begin
+    @<Adjust transformation matrix for the magnification ratio@>;
+end;
+pdfshipoutbegin(shipping_page);
+if shipping_page then
+    pdf_out_colorstack_startpage;
+
+
+@ @<Adjust transformation matrix for the magnification ratio@>=
+prepare_mag;
+if mag <> 1000 then begin
+    pdf_print_real(mag, 3);
+    pdf_print(" 0 0 ");
+    pdf_print_real(mag, 3);
+    pdf_print_ln(" 0 0 cm");
+end
+
+@ @<Finish shipping@>=
+@<Finish stream of page/form contents@>;
+if shipping_page then begin
+    @<Write out page object@>;
+end;
+@<Write out resource lists@>;
+if shipping_page then begin
+    @<Write out pending PDF marks@>;
+end;
+@<Write out resources dictionary@>;
+@<Flush resource lists@>;
+if shipping_page then begin
+    @<Flush PDF mark lists@>;
+end
+
+@ @<Finish stream of page/form contents@>=
+pdf_end_text;
+pdfshipoutend(shipping_page);
+pdf_end_stream
+
+@ @<Write out resource lists@>=
+@<Write out pending raw objects@>;
+@<Write out pending forms@>;
+@<Write out pending images@>
+
+@ @<Write out resources dictionary@>=
+pdf_begin_dict(pdf_last_resources, 1);
+@<Print additional resources@>;
+@<Generate font resources@>;
+@<Generate XObject resources@>;
+@<Generate ProcSet@>;
+pdf_end_dict
+
+@ @<Print additional resources@>=
+if shipping_page then begin
+    if pdf_page_resources <> null then
+        pdf_print_toks_ln(pdf_page_resources);
+end
+else begin
+    if obj_xform_resources(pdf_cur_form) <> null then begin
+        pdf_print_toks_ln(obj_xform_resources(pdf_cur_form));
+        delete_toks(obj_xform_resources(pdf_cur_form));
+    end;
+end
+
+@ In the end of shipping out a page we reset all the lists holding objects
+have been created during the page shipping.
+
+@d delete_toks(#) == begin delete_token_ref(#); # := null; end
+
+@<Flush resource lists@>=
+flush_list(pdf_font_list);
+flush_list(pdf_obj_list);
+flush_list(pdf_xform_list);
+flush_list(pdf_ximage_list)
+
+@ @<Flush PDF mark lists@>=
+flush_list(pdf_annot_list);
+flush_list(pdf_link_list);
+flush_list(pdf_dest_list);
+flush_list(pdf_bead_list)
+
+@ @<Generate font resources@>=
+if pdf_font_list <> null then begin
+    pdf_print("/Font << ");
+    k := pdf_font_list;
+    while k <> null do begin
+        pdf_print("/F");
+        set_ff(info(k));
+        pdf_print_int(ff);
+        pdf_print_resname_prefix;
+        pdf_out(" ");
+        pdf_print_int(pdf_font_num(ff));
+        pdf_print(" 0 R ");
+        k := link(k);
+    end;
+    pdf_print_ln(">>");
+    pdf_text_procset := true;
+end
+
+@ @<Generate XObject resources@>=
+if (pdf_xform_list <> null) or (pdf_ximage_list <> null) then begin
+    pdf_print("/XObject << ");
+    k := pdf_xform_list;
+    while k <> null do begin
+        pdf_print("/Fm");
+        pdf_print_int(obj_info(info(k)));
+        pdf_print_resname_prefix;
+        pdf_out(" ");
+        pdf_print_int(info(k));
+        pdf_print(" 0 R ");
+        k := link(k);
+    end;
+    k := pdf_ximage_list;
+    while k <> null do begin
+        pdf_print("/Im");
+        pdf_print_int(image_index(obj_data_ptr(info(k))));
+        pdf_print_resname_prefix;
+        pdf_out(" ");
+        pdf_print_int(info(k));
+        pdf_print(" 0 R ");
+        update_image_procset(obj_data_ptr(info(k)));
+        k := link(k);
+    end;
+    pdf_print_ln(">>");
+end
+
+@ @<Generate ProcSet@>=
+pdf_print("/ProcSet [ /PDF");
+if pdf_text_procset then
+    pdf_print(" /Text");
+if check_image_b(pdf_image_procset) then
+    pdf_print(" /ImageB");
+if check_image_c(pdf_image_procset) then
+    pdf_print(" /ImageC");
+if check_image_i(pdf_image_procset) then
+    pdf_print(" /ImageI");
+pdf_print_ln(" ]")
+
+@ @<Write out page object@>=
+pdf_begin_dict(pdf_last_page, 1);
+pdf_print_ln("/Type /Page");
+pdf_indirect_ln("Contents", pdf_last_stream);
+pdf_indirect_ln("Resources", pdf_last_resources);
+pdf_print("/MediaBox [0 0 ");
+pdf_print_mag_bp(cur_page_width); pdf_out(" ");
+pdf_print_mag_bp(cur_page_height);
+pdf_print_ln("]");
+if pdf_page_attr <> null then
+    pdf_print_toks_ln(pdf_page_attr);
+@<Generate parent pages object@>;
+@<Generate array of annotations or beads in page@>;
+pdf_end_dict
+
+@ @<Generate parent pages object@>=
+if total_pages mod pages_tree_kids_max = 1 then begin
+    pdf_create_obj(obj_type_pages, pages_tree_kids_max);
+    pdf_last_pages := obj_ptr;
+end;
+pdf_indirect_ln("Parent", pdf_last_pages)
+
+@ @<Generate array of annotations or beads in page@>=
+if (pdf_annot_list <> null) or (pdf_link_list <> null) then begin
+    pdf_print("/Annots [ ");
+    k := pdf_annot_list;
+    while k <> null do begin
+        pdf_print_int(info(k));
+        pdf_print(" 0 R ");
+        k := link(k);
+    end;
+    k := pdf_link_list;
+    while k <> null do begin
+        pdf_print_int(info(k));
+        pdf_print(" 0 R ");
+        k := link(k);
+    end;
+    pdf_print_ln("]");
+end;
+if pdf_bead_list <> null then begin
+    k := pdf_bead_list;
+    pdf_print("/B [ ");
+    while k <> null do begin
+        pdf_print_int(info(k));
+        pdf_print(" 0 R ");
+        k := link(k);
+    end;
+    pdf_print_ln("]");
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_obj(n: integer); {write a raw PDF object}
+var s: str_number;
+    f: byte_file;
+    data_size:integer; {total size of the data file}
+    data_cur:integer; {index into |data_buffer|}
+    data_buffer:^real_eight_bits; {byte buffer for data files}
+    file_opened:boolean;
+    k:integer;
+    res:boolean;
+	fnam: str_number;
+    callback_id:integer;
+begin
+    s := tokens_to_string(obj_obj_data(n));
+    delete_toks(obj_obj_data(n));
+    if obj_obj_is_stream(n) > 0 then begin
+        pdf_begin_dict(n, 0);
+        if obj_obj_stream_attr(n) <> null then begin
+            pdf_print_toks_ln(obj_obj_stream_attr(n));
+            delete_toks(obj_obj_stream_attr(n));
+        end;
+        pdf_begin_stream;
+    end
+    else
+        pdf_begin_obj(n, 1);
+    if obj_obj_is_file(n) > 0 then begin
+        data_size:=0; data_cur:=0; data_buffer:=0;
+        pack_file_name(s,"","");
+	    callback_id:=callback_defined(find_data_file_callback);
+	    if callback_id>0 then begin
+    	  res := run_callback(callback_id,'S->s',stringcast(nameoffile+1),addressof(fnam));
+	      if (res)and(fnam<>0)and(length(fnam)>0) then begin
+	        @<Fixup |nameoffile| after callback@>;
+		 	end;
+          end;
+		callback_id:=callback_defined(read_data_file_callback);
+        if callback_id>0 then begin
+          file_opened := false;
+          res := run_callback(callback_id,'S->bSd',stringcast(nameoffile+1),
+                  addressof(file_opened), addressof(data_buffer),addressof(data_size));
+          if not file_opened then pdf_error("ext5", "cannot open file for embedding");
+          end
+        else begin
+          if not tex_b_open_in(f) then 
+             pdf_error("ext5", "cannot open file for embedding");
+          res := read_data_file(f,addressof(data_buffer),addressof(data_size));
+          b_close(f);
+        end;
+        if not data_size then pdf_error("ext5", "empty file for embedding");
+        if not res       then pdf_error("ext5", "error reading file for embedding");
+        print("<<");
+        print(s);
+        while data_cur<data_size do begin
+            pdf_out(data_buffer[data_cur]);
+            incr(data_cur);
+            end;
+	    if data_buffer<>0 then libcfree(data_buffer);
+        print(">>");
+    end
+    else if obj_obj_is_stream(n) > 0 then
+        pdf_print(s)
+    else
+        pdf_print_ln(s);
+    if obj_obj_is_stream(n) > 0 then
+        pdf_end_stream
+    else
+        pdf_end_obj;
+    flush_str(s);
+end;
+
+@ @<Write out pending raw objects@>=
+if pdf_obj_list <> null then begin
+    k := pdf_obj_list;
+    while k <> null do begin
+        if not is_obj_written(info(k)) then
+            pdf_write_obj(info(k));
+        k := link(k);
+    end;
+end
+
+@ When flushing pending forms we need to save and restore resource lists
+(|pdf_font_list|, |pdf_obj_list|, |pdf_xform_list| and |pdf_ximage_list|),
+which are also used by page shipping.
+Saving and restoring |cur_page_height| is needed for proper
+writing out pending PDF marks.
+
+@<Write out pending forms@>=
+if pdf_xform_list <> null then begin
+    k := pdf_xform_list;
+    while k <> null do begin
+        if not is_obj_written(info(k)) then begin
+            pdf_cur_form := info(k);
+            @<Save resource lists@>;
+            @<Reset resource lists@>;
+            save_cur_page_height := cur_page_height;
+            pdf_ship_out(obj_xform_box(pdf_cur_form), false);
+            cur_page_height := save_cur_page_height;
+            @<Restore resource lists@>;
+        end;
+        k := link(k);
+    end;
+end
+
+@ @<Save resource lists@>=
+save_font_list := pdf_font_list;
+save_obj_list := pdf_obj_list;
+save_xform_list := pdf_xform_list;
+save_ximage_list := pdf_ximage_list;
+save_text_procset := pdf_text_procset;
+save_image_procset := pdf_image_procset
+
+@ @<Restore resource lists@>=
+pdf_font_list := save_font_list;
+pdf_obj_list := save_obj_list;
+pdf_xform_list := save_xform_list;
+pdf_ximage_list := save_ximage_list;
+pdf_text_procset := save_text_procset;
+pdf_image_procset := save_image_procset
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_write_image(n: integer); {write an image}
+begin
+    pdf_begin_dict(n, 0);
+    if fixed_pdf_draftmode = 0 then write_image(obj_data_ptr(n));
+end;
+
+@ @<Write out pending images@>=
+if pdf_ximage_list <> null then begin
+    k := pdf_ximage_list;
+    while k <> null do begin
+        if not is_obj_written(info(k)) then
+            pdf_write_image(info(k));
+        k := link(k);
+    end;
+end
+
+@ @<Write out pending PDF marks@>=
+pdf_origin_h := 0;
+pdf_origin_v := cur_page_height;
+@<Write out PDF annotations@>;
+@<Write out PDF link annotations@>;
+@<Write out PDF mark destinations@>;
+@<Write out PDF bead rectangle specifications@>
+
+@ @<Write out PDF annotations@>=
+if pdf_annot_list <> null then begin
+    k := pdf_annot_list;
+    while k <> null do begin
+        i := obj_annot_ptr(info(k)); {|i| points to |pdf_annot_node|}
+        pdf_begin_dict(info(k), 1);
+        pdf_print_ln("/Type /Annot");
+        pdf_print_toks_ln(pdf_annot_data(i));
+        pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+        pdf_end_dict;
+        k := link(k);
+    end;
+end
+
+@ @<Write out PDF link annotations@>=
+if pdf_link_list <> null then begin
+k := pdf_link_list;
+while k <> null do begin
+    i := obj_annot_ptr(info(k));
+    pdf_begin_dict(info(k), 1);
+    pdf_print_ln("/Type /Annot");
+    if pdf_link_attr(i) <> null then
+        pdf_print_toks_ln(pdf_link_attr(i));
+    pdf_rectangle(pdf_left(i), pdf_top(i), pdf_right(i), pdf_bottom(i));
+    if pdf_action_type(pdf_link_action(i)) <> pdf_action_user
+    then begin
+        pdf_print_ln("/Subtype /Link");
+        pdf_print("/A ");
+    end;
+    write_action(pdf_link_action(i));
+    pdf_end_dict;
+    k := link(k);
+    end;
+    @<Flush |pdf_start_link_node|'s created by |append_link|@>;
+end
+
+@ @<Flush |pdf_start_link_node|'s created by |append_link|@>=
+k := pdf_link_list;
+while k <> null do begin
+    i := obj_annot_ptr(info(k));
+    {nodes with |subtype = pdf_link_data_node| were created by |append_link| and
+     must be flushed here, as they are not linked in any list}
+    if subtype(i) = pdf_link_data_node then
+        flush_node(i);
+    k := link(k);
+end
+
+@ @<Write out PDF mark destinations@>=
+if pdf_dest_list <> null then begin
+    k := pdf_dest_list;
+    while k <> null do begin
+        if is_obj_written(info(k)) then
+            pdf_error("ext5",
+                "destination has been already written (this shouldn't happen)")
+        else begin
+            i := obj_dest_ptr(info(k));
+            if pdf_dest_named_id(i) > 0 then begin
+                pdf_begin_dict(info(k), 1);
+                pdf_print("/D ");
+            end
+            else
+                pdf_begin_obj(info(k), 1);
+            pdf_out("["); pdf_print_int(pdf_last_page); pdf_print(" 0 R ");
+            case pdf_dest_type(i) of
+            pdf_dest_xyz: begin
+                pdf_print("/XYZ ");
+                pdf_print_mag_bp(pdf_x(pdf_left(i))); pdf_out(" ");
+                pdf_print_mag_bp(pdf_y(pdf_top(i))); pdf_out(" ");
+                if pdf_dest_xyz_zoom(i) = null then
+                    pdf_print("null")
+                else begin
+                    pdf_print_int(pdf_dest_xyz_zoom(i) div 1000);
+                    pdf_out(".");
+                    pdf_print_int((pdf_dest_xyz_zoom(i) mod 1000));
+                end;
+            end;
+            pdf_dest_fit:
+                pdf_print("/Fit");
+            pdf_dest_fith: begin
+                pdf_print("/FitH ");
+                pdf_print_mag_bp(pdf_y(pdf_top(i)));
+            end;
+            pdf_dest_fitv: begin
+                pdf_print("/FitV ");
+                pdf_print_mag_bp(pdf_x(pdf_left(i)));
+            end;
+            pdf_dest_fitb:
+                pdf_print("/FitB");
+            pdf_dest_fitbh: begin
+                pdf_print("/FitBH ");
+                pdf_print_mag_bp(pdf_y(pdf_top(i)));
+            end;
+            pdf_dest_fitbv: begin
+                pdf_print("/FitBV ");
+                pdf_print_mag_bp(pdf_x(pdf_left(i)));
+            end;
+            pdf_dest_fitr: begin
+                pdf_print("/FitR ");
+                pdf_print_rect_spec(i);
+            end;
+            othercases pdf_error("ext5", "unknown dest type");
+            endcases;
+            pdf_print_ln("]");
+            if pdf_dest_named_id(i) > 0 then
+                pdf_end_dict
+            else
+                pdf_end_obj;
+        end;
+        k := link(k);
+    end;
+end
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure pdf_print_rect_spec(r: pointer); {prints a rect spec}
+begin
+    pdf_print_mag_bp(pdf_x(pdf_left(r)));
+    pdf_out(" ");
+    pdf_print_mag_bp(pdf_y(pdf_bottom(r)));
+    pdf_out(" ");
+    pdf_print_mag_bp(pdf_x(pdf_right(r)));
+    pdf_out(" ");
+    pdf_print_mag_bp(pdf_y(pdf_top(r)));
+end;
+
+@ @<Write out PDF bead rectangle specifications@>=
+if pdf_bead_list <> null then begin
+    k := pdf_bead_list;
+    while k <> null do begin
+        pdf_new_obj(obj_type_others, 0, 1);
+        pdf_out("[");
+        i := obj_bead_data(info(k)); {pointer to a whatsit or whatsit-like node}
+        pdf_print_rect_spec(i);
+        if subtype(i) = pdf_thread_data_node then {thanh says it mis be destroyed here}
+            flush_node(i);
+        pdf_print_ln("]");
+        obj_bead_rect(info(k)) := obj_ptr; {rewrite |obj_bead_data|}
+        pdf_end_obj;
+        k := link(k);
+    end;
+end
+
+@ In the end we must flush PDF objects that cannot be written out
+immediately after shipping out pages.
+
+@ @<Output outlines@>=
+if pdf_first_outline <> 0 then begin
+    pdf_new_dict(obj_type_others, 0, 1);
+    outlines := obj_ptr;
+    l := pdf_first_outline; k := 0;
+    repeat
+        incr(k);
+        a := open_subentries(l);
+        if obj_outline_count(l) > 0 then
+            k := k + a;
+        obj_outline_parent(l) := obj_ptr;
+        l := obj_outline_next(l);
+    until l = 0;
+    pdf_print_ln("/Type /Outlines");
+    pdf_indirect_ln("First", pdf_first_outline);
+    pdf_indirect_ln("Last", pdf_last_outline);
+    pdf_int_entry_ln("Count", k);
+    pdf_end_dict;
+    @<Output PDF outline entries@>;
+end
+else
+    outlines := 0
+
+@ @<Output PDF outline entries@>=
+k := head_tab[obj_type_outline];
+while k <> 0 do begin
+    if obj_outline_parent(k) = pdf_parent_outline then begin
+        if obj_outline_prev(k) = 0 then
+            pdf_first_outline := k;
+        if obj_outline_next(k) = 0 then
+            pdf_last_outline := k;
+    end;
+    pdf_begin_dict(k, 1);
+    pdf_indirect_ln("Title", obj_outline_title(k));
+    pdf_indirect_ln("A", obj_outline_action_objnum(k));
+    if obj_outline_parent(k) <> 0 then
+        pdf_indirect_ln("Parent", obj_outline_parent(k));
+    if obj_outline_prev(k) <> 0 then
+        pdf_indirect_ln("Prev", obj_outline_prev(k));
+    if obj_outline_next(k) <> 0 then
+        pdf_indirect_ln("Next", obj_outline_next(k));
+    if obj_outline_first(k) <> 0 then
+        pdf_indirect_ln("First", obj_outline_first(k));
+    if obj_outline_last(k) <> 0 then
+        pdf_indirect_ln("Last", obj_outline_last(k));
+    if obj_outline_count(k) <> 0 then
+        pdf_int_entry_ln("Count", obj_outline_count(k));
+    if obj_outline_attr(k) <> 0 then begin
+        pdf_print_toks_ln(obj_outline_attr(k));
+        delete_toks(obj_outline_attr(k));
+    end;
+    pdf_end_dict;
+    k := obj_link(k);
+end
+
+@ @<Output article threads@>=
+if head_tab[obj_type_thread] <> 0 then begin
+    pdf_new_obj(obj_type_others, 0, 1);
+    threads := obj_ptr;
+    pdf_out("[");
+    k := head_tab[obj_type_thread];
+    while k <> 0 do begin
+        pdf_print_int(k);
+        pdf_print(" 0 R ");
+        k := obj_link(k);
+    end;
+    remove_last_space;
+    pdf_print_ln("]");
+    pdf_end_obj;
+    k := head_tab[obj_type_thread];
+    while k <> 0 do begin
+        out_thread(k);
+        k := obj_link(k);
+    end;
+end
+else
+    threads := 0
+
+@ Now we are ready to declare our new procedure |ship_out|.  It will call
+|pdf_ship_out| if the integer parameter |pdf_output| is positive; otherwise it
+will call |dvi_ship_out|, which is the \TeX\ original |ship_out|.
+
+@p procedure ship_out(p:pointer); {output the box |p|}
+begin
+    fix_pdfoutput;
+    if pdf_output > 0 then
+        pdf_ship_out(p, true)
+    else
+        dvi_ship_out(p);
+end;
+
+@ @<Initialize variables for \.{PDF} output@>=
+check_pdfminorversion;
+prepare_mag;
+fixed_decimal_digits := fix_int(pdf_decimal_digits, 0, 4);
+min_bp_val :=
+    divide_scaled(one_hundred_bp, ten_pow[fixed_decimal_digits + 2], 0);
+if pdf_pk_resolution = 0 then {if not set from format file or by user}
+    pdf_pk_resolution := pk_dpi; {take it from \.{texmf.cnf}}
+fixed_pk_resolution := fix_int(pdf_pk_resolution, 72, 8000);
+pk_scale_factor :=
+    divide_scaled(72, fixed_pk_resolution, 5 + fixed_decimal_digits);
+if not callback_defined(read_pk_file_callback) then begin
+  if pdf_pk_mode <> null then begin
+    kpseinitprog('PDFTEX', fixed_pk_resolution,
+                   makecstring(tokens_to_string(pdf_pk_mode)), nil);
+    flush_string;
+  end else
+    kpseinitprog('PDFTEX', fixed_pk_resolution, nil, nil);
+  if not kpsevarvalue('MKTEXPK') then
+     kpsesetprogramenabled (kpsepkformat, 1, kpsesrccmdline);
+  end;
+set_job_id(year, month, day, time);
+if (pdf_unique_resname > 0) and (pdf_resname_prefix = 0) then
+    pdf_resname_prefix := get_resname_prefix
+
+@ Finishing the PDF output file.
+
+The following procedures sort the table of destination names
+@p function str_less_str(s1, s2: str_number): boolean; {compare two strings}
+var c1, c2: pool_pointer;
+    l, i: integer;
+begin
+    c1 := str_start_macro(s1);
+    c2 := str_start_macro(s2);
+    if length(s1) < length(s2) then
+        l := length(s1)
+    else
+        l := length(s2);
+    i := 0;
+    while (i < l) and (str_pool[c1 + i] = str_pool[c2 + i]) do
+        incr(i);
+    if ((i < l) and (str_pool[c1 + i] < str_pool[c2 + i])) or
+        ((i = l) and (length(s1) < length(s2))) then
+        str_less_str := true
+    else
+        str_less_str := false;
+end;
+
+procedure sort_dest_names(l, r: integer); {sorts |dest_names| by names}
+var i, j: integer;
+    s: str_number;
+    e: dest_name_entry;
+begin
+    i := l;
+    j := r;
+    s := dest_names[(l + r) div 2].objname;
+    repeat
+        while str_less_str(dest_names[i].objname, s) do
+            incr(i);
+        while str_less_str(s, dest_names[j].objname) do
+            decr(j);
+        if i <= j then begin
+            e := dest_names[i];
+            dest_names[i] := dest_names[j];
+            dest_names[j] := e;
+            incr(i);
+            decr(j);
+        end;
+    until i > j;
+    if l < j then
+        sort_dest_names(l, j);
+    if i < r then
+        sort_dest_names(i, r);
+end;
+
+@  Now the finish of PDF output file. At this moment all Page objects
+are already written completely to PDF output file.
+
+@<Finish the PDF file@>=
+if total_pages=0 then begin
+	if callback_id=0 then
+      print_nl("No pages of output.")
+    else
+      res:=run_callback(callback_id,'->');
+  @.No pages of output@>
+    if pdf_gone > 0 then
+        garbage_warning;
+end
+else begin
+    if fixed_pdf_draftmode = 0 then begin
+    pdf_flush; {to make sure that the output file name has been already
+    created}
+    if total_pages mod pages_tree_kids_max <> 0 then
+        obj_info(pdf_last_pages) := total_pages mod pages_tree_kids_max;
+    {last pages object may have less than |pages_tree_kids_max| children}
+    flush_jbig2_page0_objects; {flush page 0 objects from JBIG2 images, if any}
+    @<Check for non-existing pages@>;
+    @<Reverse the linked list of Page and Pages objects@>;
+    @<Check for non-existing destinations@>;
+    @<Output fonts definition@>;
+    @<Output pages tree@>;
+    @<Output outlines@>;
+    @<Output name tree@>;
+    @<Output article threads@>;
+    @<Output the catalog object@>;
+    pdf_print_info; {last candidate for object stream}
+    if pdf_os_enable then begin
+        pdf_os_switch(true);
+        pdf_os_write_objstream;
+        pdf_flush;
+        pdf_os_switch(false);
+        @<Output the cross-reference stream dictionary@>;
+        pdf_flush;
+    end else begin
+        @<Output the |obj_tab|@>;
+    end;
+    @<Output the trailer@>;
+    pdf_flush;
+	if callback_id=0 then begin
+      print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+  @.Output written on x@>
+      print(" ("); print_int(total_pages); print(" page");
+      if total_pages<>1 then print_char("s");
+      print(", "); print_int(pdf_offset); print(" bytes).");
+      end
+    else
+      res:=run_callback(callback_id,'->');
+    end;
+    libpdffinish;
+    if fixed_pdf_draftmode = 0 then b_close(pdf_file)
+    else pdf_warning(0, "\pdfdraftmode enabled, not changing output pdf", true, true)
+end
+
+@ Destinations that have been referenced but don't exists have
+|obj_dest_ptr=null|. Leaving them undefined might cause troubles for
+PDF browsers, so we need to fix them.
+
+@p procedure pdf_fix_dest(k: integer);
+begin
+    if obj_dest_ptr(k) <> null then
+        return;
+    pdf_warning("dest", "", false, false);
+    if obj_info(k) < 0 then begin
+        print("name{");
+        print(-obj_info(k));
+        print("}");
+    end
+    else begin
+        print("num");
+        print_int(obj_info(k));
+    end;
+    print(" has been referenced but does not exist, replaced by a fixed one");
+    print_ln; print_ln;
+    pdf_begin_obj(k, 1);
+    pdf_out("[");
+    pdf_print_int(head_tab[obj_type_page]);
+    pdf_print_ln(" 0 R /Fit]");
+    pdf_end_obj;
+end;
+
+@ @<Check for non-existing destinations@>=
+k := head_tab[obj_type_dest];
+while k <> 0 do begin
+    pdf_fix_dest(k);
+    k := obj_link(k);
+end
+
+@ @<Check for non-existing pages@>=
+k := head_tab[obj_type_page];
+while obj_aux(k) = 0 do begin
+    pdf_warning("dest", "Page ", false, false);
+    print_int(obj_info(k));
+    print(" has been referenced but does not exist!");
+    print_ln; print_ln;
+    k := obj_link(k);
+end;
+head_tab[obj_type_page] := k
+
+@ @<Reverse the linked list of Page and Pages objects@>=
+k := head_tab[obj_type_page];
+l := 0;
+repeat
+    i := obj_link(k);
+    obj_link(k) := l;
+    l := k;
+    k := i;
+until k = 0;
+head_tab[obj_type_page] := l;
+k := head_tab[obj_type_pages];
+pages_tail := k;
+l := 0;
+repeat
+    i := obj_link(k);
+    obj_link(k) := l;
+    l := k;
+    k := i;
+until k = 0;
+head_tab[obj_type_pages] := l
+
+@ @<Output fonts definition@>=
+for k := 1 to max_font_id do
+    if font_used(k) and (pdf_font_num(k) < 0) then begin
+        i := -pdf_font_num(k);
+        pdfassert(pdf_font_num(i) > 0);
+        for j := font_bc(k) to font_ec(k) do
+            if pdf_char_marked(k, j) then
+                pdf_mark_char(i, j);
+        if (pdf_font_attr(i) = 0) and (pdf_font_attr(k) <> 0) then
+            set_pdf_font_attr(i, pdf_font_attr(k))
+        else if (pdf_font_attr(k) = 0) and (pdf_font_attr(i) <> 0) then
+            set_pdf_font_attr(k,pdf_font_attr(i))
+        else if (pdf_font_attr(i) <> 0) and (pdf_font_attr(k) <> 0) and
+           not str_eq_str(pdf_font_attr(i), pdf_font_attr(k)) then begin
+           pdf_warning("\pdffontattr", "fonts ", false, false);
+           print_font_identifier(i);
+           print(" and ");
+           print_font_identifier(k);
+           print(" has conflicting attributes"); print_ln; print_ln;
+        end;
+    end;
+fixed_gen_tounicode := pdf_gen_tounicode;
+k := head_tab[obj_type_font];
+while k <> 0 do begin
+    f := obj_info(k);
+    pdfassert(pdf_font_num(f) > 0);
+    do_pdf_font(k, f);
+    k := obj_link(k);
+end;
+write_fontstuff
+
+@ We will generate in each single step the parents of all Pages/Page objects in
+the previous level. These new generated Pages object will create a new level of
+Pages tree. We will repeat this until search only one Pages object. This one
+will be the Root object.
+
+@<Output pages tree@>=
+a := sys_obj_ptr + 1; {all Pages objects whose children are not Page objects
+                       should have index greater than |a|}
+l := head_tab[obj_type_pages]; {|l| is the index of current Pages object
+                                which is being output}
+k := head_tab[obj_type_page]; {|k| is the index of current child of |l|}
+b := 0;
+repeat
+    i := 0; {counter of Pages object in current level}
+    c := 0; {first Pages object in previous level}
+    if obj_link(l) = 0 then
+        is_root := true {only Pages object; total pages is
+                         not greater than |pages_tree_kids_max|}
+    else
+        is_root := false;
+    repeat
+        if not is_root then begin
+            if i mod pages_tree_kids_max = 0 then begin {create a new Pages object
+                                                         for next level}
+                pdf_last_pages := pdf_new_objnum;
+                if c = 0 then
+                    c := pdf_last_pages;
+                obj_link(pages_tail) := pdf_last_pages;
+                pages_tail := pdf_last_pages;
+                obj_link(pdf_last_pages) := 0;
+                obj_info(pdf_last_pages) := obj_info(l);
+            end
+            else
+                obj_info(pdf_last_pages) := obj_info(pdf_last_pages) +
+                    obj_info(l);
+        end;
+        @<Output the current Pages object in this level@>;
+        incr(i);
+        l := obj_link(l);
+    until (l = c);
+    b := c;
+    if l = 0 then
+        goto done;
+until false;
+done:
+
+@ @<Output the current Pages object in this level@>=
+pdf_begin_dict(l, 1);
+pdf_print_ln("/Type /Pages");
+pdf_int_entry_ln("Count", obj_info(l));
+if not is_root then
+    pdf_indirect_ln("Parent", pdf_last_pages);
+pdf_print("/Kids [");
+j := 0;
+repeat
+    pdf_print_int(k);
+    pdf_print(" 0 R ");
+    k := obj_link(k);
+    incr(j);
+until ((l < a) and (j = obj_info(l))) or
+    (k = 0) or ((k = b) and (b <> 0)) or
+    (j = pages_tree_kids_max);
+remove_last_space;
+pdf_print_ln("]");
+if k = 0 then begin
+    k := head_tab[obj_type_pages];
+    head_tab[obj_type_pages] := 0;
+end;
+if is_root and (pdf_pages_attr <> null) then
+    pdf_print_toks_ln(pdf_pages_attr);
+pdf_end_dict;
+
+@ The name tree is very similiar to Pages tree so its construction should be
+certain from Pages tree construction. For intermediate node |obj_info| will be
+the first name and |obj_link| will be the last name in \.{\\Limits} array.
+Note that |pdf_dest_names_ptr| will be less than |obj_ptr|, so we test if
+|k < pdf_dest_names_ptr| then |k| is index of leaf in |dest_names|; else
+|k| will be index in |obj_tab| of some intermediate node.
+
+@<Output name tree@>=
+if pdf_dest_names_ptr = 0 then begin
+    dests := 0;
+    goto done1;
+end;
+sort_dest_names(0, pdf_dest_names_ptr - 1);
+names_head := 0;
+names_tail := 0;
+k := 0; {index of current child of |l|; if |k < pdf_dest_names_ptr|
+         then this is pointer to |dest_names| array;
+         otherwise it is the pointer to |obj_tab| (object number)}
+is_names := true; {flag whether Names or Kids}
+b := 0;
+repeat
+    repeat
+        pdf_create_obj(obj_type_others, 0); {create a new node}
+        l := obj_ptr;
+        if b = 0 then
+            b := l; {first in this level}
+        if names_head = 0 then begin
+            names_head := l;
+            names_tail := l;
+        end else begin
+            obj_link(names_tail) := l;
+            names_tail := l;
+        end;
+        obj_link(names_tail) := 0;
+        @<Output the current node in this level@>;
+    until b = 0;
+    if k = l then begin
+        dests := l;
+        goto done1;
+    end;
+until false;
+done1:
+if (dests <> 0) or (pdf_names_toks <> null) then begin
+    pdf_new_dict(obj_type_others, 0, 1);
+    if (dests <> 0) then
+        pdf_indirect_ln("Dests", dests);
+    if pdf_names_toks <> null then begin
+        pdf_print_toks_ln(pdf_names_toks);
+        delete_toks(pdf_names_toks);
+    end;
+    pdf_end_dict;
+    names_tree := obj_ptr;
+end
+else
+    names_tree := 0
+
+@ @<Output the current node in this level@>=
+pdf_begin_dict(l, 1);
+j := 0;
+if is_names then begin
+    obj_info(l) := dest_names[k].objname;
+    pdf_print("/Names [");
+    repeat
+        pdf_print_str(dest_names[k].objname);
+        pdf_out(" ");
+        pdf_print_int(dest_names[k].objnum);
+        pdf_print(" 0 R ");
+        incr(j);
+        incr(k);
+    until (j = name_tree_kids_max) or (k = pdf_dest_names_ptr);
+    remove_last_space;
+    pdf_print_ln("]");
+    obj_aux(l) := dest_names[k - 1].objname;
+    if k = pdf_dest_names_ptr then begin
+        is_names := false;
+        k := names_head;
+        b := 0;
+    end;
+end
+else begin
+    obj_info(l) := obj_info(k);
+    pdf_print("/Kids [");
+    repeat
+        pdf_print_int(k);
+        pdf_print(" 0 R ");
+        incr(j);
+        obj_aux(l) := obj_aux(k);
+        k := obj_link(k);
+    until (j = name_tree_kids_max) or (k = b) or (obj_link(k) = 0);
+    remove_last_space;
+    pdf_print_ln("]");
+    if k = b then
+        b := 0;
+end;
+pdf_print("/Limits [");
+pdf_print_str(obj_info(l));
+pdf_out(" ");
+pdf_print_str(obj_aux(l));
+pdf_print_ln("]");
+pdf_end_dict;
+
+@ @<Output the catalog object@>=
+pdf_new_dict(obj_type_others, 0, 1);
+root := obj_ptr;
+pdf_print_ln("/Type /Catalog");
+pdf_indirect_ln("Pages", pdf_last_pages);
+if threads <> 0 then
+    pdf_indirect_ln("Threads", threads);
+if outlines <> 0 then
+    pdf_indirect_ln("Outlines", outlines);
+if names_tree <> 0 then
+    pdf_indirect_ln("Names", names_tree);
+if pdf_catalog_toks <> null then begin
+    pdf_print_toks_ln(pdf_catalog_toks);
+    delete_toks(pdf_catalog_toks);
+end;
+if pdf_catalog_openaction <> 0 then
+    pdf_indirect_ln("OpenAction", pdf_catalog_openaction);
+pdf_end_dict
+
+@ If the same keys in a dictionary are given several times, then it is not
+defined which value is choosen by an application.  Therefore the keys
+|/Producer| and |/Creator| are only set if the token list
+|pdf_info_toks| converted to a string does not contain these key strings.
+
+@p function substr_of_str(s, t: str_number):boolean;
+label continue,exit;
+var j, k, kk: pool_pointer; {running indices}
+begin
+    k:=str_start_macro(t);
+    while (k < str_start_macro(t+1) - length(s)) do begin
+        j:=str_start_macro(s);
+        kk:=k;
+        while (j < str_start_macro(s+1)) do begin
+            if str_pool[j] <> str_pool[kk] then
+                goto continue;
+            incr(j);
+            incr(kk);
+        end;
+        substr_of_str:=true;
+        return;
+        continue: incr(k);
+    end;
+    substr_of_str:=false;
+end;
+
+procedure pdf_print_info; {print info object}
+var s: str_number;
+    creator_given, producer_given, creationdate_given, moddate_given, trapped_given: boolean;
+begin
+    s:="";
+    pdf_new_dict(obj_type_others, 0, 3); {keep Info readable unless explicitely forced}
+    creator_given:=false;
+    producer_given:=false;
+    creationdate_given:=false;
+    moddate_given:=false;
+    trapped_given:=false;
+    if pdf_info_toks <> null then begin
+        s:=tokens_to_string(pdf_info_toks);
+        creator_given:=substr_of_str("/Creator", s);
+        producer_given:=substr_of_str("/Producer", s);
+        creationdate_given:=substr_of_str("/CreationDate", s);
+        moddate_given:=substr_of_str("/ModDate", s);
+        trapped_given:=substr_of_str("/Trapped", s);
+    end;
+    if not producer_given then begin
+        @<Print the Producer key@>;
+    end;
+    if pdf_info_toks <> null then begin
+        if length(s) > 0 then begin
+            pdf_print_ln(s);
+        end;
+        flush_str(s);
+        delete_toks(pdf_info_toks);
+    end;
+    if not creator_given then
+        pdf_str_entry_ln("Creator", "TeX");
+    if not creationdate_given then begin
+        @<Print the CreationDate key@>;
+    end;
+    if not moddate_given then begin
+        @<Print the ModDate key@>;
+    end;
+    if not trapped_given then begin
+        pdf_print_ln("/Trapped /False");
+    end;
+    pdf_str_entry_ln("PTEX.Fullbanner", pdftex_banner);
+    pdf_end_dict;
+end;
+
+@ @<Print the Producer key@>=
+pdf_print("/Producer (luaTeX-");
+pdf_print_int(luatex_version div 100);
+pdf_out(".");
+pdf_print_int(luatex_version mod 100);
+pdf_out(".");
+pdf_print(luatex_revision);
+pdf_print_ln(")")
+
+@ @<Print the CreationDate key@>=
+print_creation_date;
+
+@ @<Print the ModDate key@>=
+print_mod_date;
+
+@ @<Glob...@>=
+@!pdftex_banner: str_number;   {the complete banner}
+
+@ @<Output the |obj_tab|@>=
+l := 0;
+for k := 1 to sys_obj_ptr do
+    if obj_offset(k) = 0 then begin
+        obj_link(l) := k;
+        l := k;
+    end;
+obj_link(l) := 0;
+pdf_save_offset := pdf_offset;
+pdf_print_ln("xref");
+pdf_print("0 "); pdf_print_int_ln(obj_ptr + 1);
+pdf_print_fw_int(obj_link(0), 10);
+pdf_print_ln(" 65535 f ");
+for k := 1 to obj_ptr do begin
+    if obj_offset(k) = 0 then begin
+        pdf_print_fw_int(obj_link(k), 10);
+        pdf_print_ln(" 00000 f ");
+    end
+    else begin
+        pdf_print_fw_int(obj_offset(k), 10);
+        pdf_print_ln(" 00000 n ");
+    end;
+end
+
+@ @<Output the cross-reference stream dictionary@>=
+pdf_new_dict(obj_type_others, 0, 0);
+if obj_offset(sys_obj_ptr) > 16777215 then
+    xref_offset_width := 4
+else if obj_offset(sys_obj_ptr) > 65535 then
+    xref_offset_width := 3
+else if obj_offset(sys_obj_ptr) > 255 then
+    xref_offset_width := 2
+else
+    xref_offset_width := 1;
+l := 0;
+for k := 1 to sys_obj_ptr do
+    if obj_offset(k) = 0 then begin
+        obj_link(l) := k;
+        l := k;
+    end;
+obj_link(l) := 0;
+pdf_print_ln("/Type /XRef");
+pdf_print("/Index [0 ");
+pdf_print_int(obj_ptr);
+pdf_print_ln("]");
+pdf_int_entry_ln("Size", obj_ptr);
+pdf_print("/W [1 ");
+pdf_print_int(xref_offset_width);
+pdf_print_ln(" 1]");
+pdf_indirect_ln("Root", root);
+pdf_indirect_ln("Info", obj_ptr - 1);
+if pdf_trailer_toks <> null then begin
+    pdf_print_toks_ln(pdf_trailer_toks);
+    delete_toks(pdf_trailer_toks);
+end;
+print_ID(output_file_name);
+pdf_print_nl;
+pdf_begin_stream;
+for k := 0 to sys_obj_ptr do begin
+    if obj_offset(k) = 0 then begin {a free object}
+        pdf_out(0);
+        pdf_out_bytes(obj_link(k), xref_offset_width);
+        pdf_out(255);
+    end else begin
+        if obj_os_idx(k) = -1 then begin {object not in object stream}
+            pdf_out(1);
+            pdf_out_bytes(obj_offset(k), xref_offset_width);
+            pdf_out(0);
+        end else begin {object in object stream}
+            pdf_out(2);
+            pdf_out_bytes(obj_offset(k), xref_offset_width);
+            pdf_out(obj_os_idx(k));
+        end;
+    end;
+end;
+pdf_end_stream;
+
+@ @<Output the trailer@>=
+if not pdf_os_enable then begin
+    pdf_print_ln("trailer");
+    pdf_print("<< ");
+    pdf_int_entry_ln("Size", sys_obj_ptr + 1);
+    pdf_indirect_ln("Root", root);
+    pdf_indirect_ln("Info", sys_obj_ptr);
+    if pdf_trailer_toks <> null then begin
+        pdf_print_toks_ln(pdf_trailer_toks);
+        delete_toks(pdf_trailer_toks);
+    end;
+    print_ID(output_file_name);
+    pdf_print_ln(" >>");
+end;
+pdf_print_ln("startxref");
+if pdf_os_enable then
+    pdf_print_int_ln(obj_offset(sys_obj_ptr))
+else
+    pdf_print_int_ln(pdf_save_offset);
+pdf_print_ln("%%EOF")
+
+@* \[33] Packaging.
+We're essentially done with the parts of \TeX\ that are concerned with
+the input (|get_next|) and the output (|ship_out|). So it's time to
+get heavily into the remaining part, which does the real work of typesetting.
+
+After lists are constructed, \TeX\ wraps them up and puts them into boxes.
+Two major subroutines are given the responsibility for this task: |hpack|
+applies to horizontal lists (hlists) and |vpack| applies to vertical lists
+(vlists). The main duty of |hpack| and |vpack| is to compute the dimensions
+of the resulting boxes, and to adjust the glue if one of those dimensions
+is pre-specified. The computed sizes normally enclose all of the material
+inside the new box; but some items may stick out if negative glue is used,
+if the box is overfull, or if a \.{\\vbox} includes other boxes that have
+been shifted left.
+
+The subroutine call |hpack(p,w,m)| returns a pointer to an |hlist_node|
+for a box containing the hlist that starts at |p|. Parameter |w| specifies
+a width; and parameter |m| is either `|exactly|' or `|additional|'.  Thus,
+|hpack(p,w,exactly)| produces a box whose width is exactly |w|, while
+|hpack(p,w,additional)| yields a box whose width is the natural width plus
+|w|.  It is convenient to define a macro called `|natural|' to cover the
+most common case, so that we can say |hpack(p,natural)| to get a box that
+has the natural width of list |p|.
+
+Similarly, |vpack(p,w,m)| returns a pointer to a |vlist_node| for a
+box containing the vlist that starts at |p|. In this case |w| represents
+a height instead of a width; the parameter |m| is interpreted as in |hpack|.
+
+@d exactly=0 {a box dimension is pre-specified}
+@d additional=1 {a box dimension is increased from the natural one}
+@d natural==0,additional {shorthand for parameters to |hpack| and |vpack|}
+
+@<Glob...@>=
+pack_direction:integer;
+spec_direction:integer;
+
+@ The parameters to |hpack| and |vpack| correspond to \TeX's primitives
+like `\.{\\hbox} \.{to} \.{300pt}', `\.{\\hbox} \.{spread} \.{10pt}'; note
+that `\.{\\hbox}' with no dimension following it is equivalent to
+`\.{\\hbox} \.{spread} \.{0pt}'.  The |scan_spec| subroutine scans such
+constructions in the user's input, including the mandatory left brace that
+follows them, and it puts the specification onto |save_stack| so that the
+desired box can later be obtained by executing the following code:
+$$\vbox{\halign{#\hfil\cr
+|save_ptr:=save_ptr-2;|\cr
+|hpack(p,saved(1),saved(0)).|\cr}}$$
+Special care is necessary to ensure that the special |save_stack| codes
+are placed just below the new group code, because scanning can change
+|save_stack| when \.{\\csname} appears.
+
+@p procedure scan_spec(@!c:group_code;@!three_codes:boolean);
+  {scans a box specification and left brace}
+label found, continue;
+var @!s:integer; {temporarily saved value}
+i:integer; v:integer;
+@!spec_code:exactly..additional;
+attr_list:halfword; 
+begin s:=0;
+if attr_list_cache=cache_disabled then update_attribute_cache; 
+attr_list:=attr_list_cache;
+if three_codes then begin
+  s:=saved(0);
+continue:
+  if scan_keyword("attr") then begin
+    scan_register_num; i:=cur_val;
+    scan_optional_equals;
+    scan_int; v:=cur_val;
+	if (attr_list<>null) and (attr_list=attr_list_cache) then begin
+      attr_list:=copy_attribute_list(attr_list_cache);
+	  add_node_attr_ref(attr_list); {will be used once}
+      end;
+    attr_list:=do_set_attribute(attr_list,i,v);
+    goto continue;
+  end;
+  if scan_keyword("dir") then begin
+    scan_direction; spec_direction:=cur_val;
+    goto continue;
+    end;
+  end;
+if attr_list=attr_list_cache then begin add_node_attr_ref(attr_list); end;
+if scan_keyword("to") then spec_code:=exactly
+@.to@>
+else if scan_keyword("spread") then spec_code:=additional
+@.spread@>
+else  begin spec_code:=additional; cur_val:=0;
+  goto found;
+  end;
+scan_normal_dimen;
+found: if three_codes then begin 
+    saved(0):=s; 
+    saved(1):=spec_code;
+    saved(2):=cur_val;
+    saved(3):=spec_direction;
+    @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>;
+    saved(5):=attr_list;
+    save_ptr:=save_ptr+6;
+    new_save_level(c); scan_left_brace;
+    eq_word_define(dir_base+body_direction_code,spec_direction);
+    eq_word_define(dir_base+par_direction_code,spec_direction);
+    eq_word_define(dir_base+text_direction_code,spec_direction);
+    eq_word_define(int_base+level_local_dir_code,cur_level);
+    end 
+  else begin
+    saved(0):=spec_code; 
+    saved(1):=cur_val;
+    save_ptr:=save_ptr+2;
+    new_save_level(c); scan_left_brace;
+  end;
+spec_direction:=-1;
+end;
+
+@ To figure out the glue setting, |hpack| and |vpack| determine how much
+stretchability and shrinkability are present, considering all four orders
+of infinity. The highest order of infinity that has a nonzero coefficient
+is then used as if no other orders were present.
+
+For example, suppose that the given list contains six glue nodes with
+the respective stretchabilities 3pt, 8fill, 5fil, 6pt, $-3$fil, $-8$fill.
+Then the total is essentially 2fil; and if a total additional space of 6pt
+is to be achieved by stretching, the actual amounts of stretch will be
+0pt, 0pt, 15pt, 0pt, $-9$pt, and 0pt, since only `fil' glue will be
+considered. (The `fill' glue is therefore not really stretching infinitely
+with respect to `fil'; nobody would actually want that to happen.)
+
+The arrays |total_stretch| and |total_shrink| are used to determine how much
+glue of each kind is present. A global variable |last_badness| is used
+to implement \.{\\badness}.
+
+@<Glob...@>=
+@!total_stretch, @!total_shrink: array[glue_ord] of scaled;
+  {glue found by |hpack| or |vpack|}
+@!last_badness:integer; {badness of the most recently packaged box}
+
+@ If the global variable |adjust_tail| is non-null, the |hpack| routine
+also removes all occurrences of |ins_node|, |mark_node|, and |adjust_node|
+items and appends the resulting material onto the list that ends at
+location |adjust_tail|.
+
+@< Glob...@>=
+@!adjust_tail:pointer; {tail of adjustment list}
+
+@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
+
+@ @<Glob...@>=
+@!font_expand_ratio: integer; {current expansion ratio}
+@!last_leftmost_char: pointer;
+@!last_rightmost_char: pointer;
+
+@ @d cal_margin_kern_var(#) ==
+begin
+    character(cp) := character(#);
+    font(cp) := font(#);
+    do_subst_font(cp, 1000);
+    if font(cp) <> font(#) then
+        margin_kern_stretch := margin_kern_stretch + left_pw(#) - left_pw(cp);
+    font(cp) := font(#);
+    do_subst_font(cp, -1000);
+    if font(cp) <> font(#) then
+        margin_kern_shrink := margin_kern_shrink + left_pw(cp) - left_pw(#);
+end
+
+@ @<Glob...@>=
+next_char_p:pointer; {pointer to the next char of an implicit kern}
+prev_char_p:pointer; {pointer to the previous char of an implicit kern}
+
+@ This procedure is called repeatedly from inside the line break algorithm.
+
+@p procedure set_prev_char_p(p:pointer);
+begin prev_char_p:=p;
+end;
+
+@ Here is |hpack|, which is place where we do font substituting when
+font expansion is being used. We define some constants used when calling
+|hpack| to deal with font expansion.
+
+@d cal_expand_ratio    == 2 {calculate amount for font expansion after breaking
+                             paragraph into lines}
+@d subst_ex_font       == 3 {substitute fonts}
+
+@d substituted = 3 {|subtype| of kern nodes that should be substituted}
+
+@d left_pw(#) == char_pw(#, left_side)
+@d right_pw(#) == char_pw(#, right_side)
+
+@p function char_stretch(p:halfword): scaled;
+var k: internal_font_number;
+    dw: scaled;
+    ef: integer;
+    f: internal_font_number; 
+    c: integer;
+begin
+    f := font(p);
+    c := character(p);
+    char_stretch := 0;
+    k := pdf_font_stretch(f);
+    ef := get_ef_code(f, c);
+    if (k <> null_font) and (ef > 0) then begin
+        dw := char_width(k,c) - char_width(f,c);
+        if dw > 0 then
+            char_stretch := round_xn_over_d(dw, ef, 1000);
+    end;
+end;
+
+function char_shrink(p:halfword): scaled;
+var k: internal_font_number;
+    dw: scaled;
+    ef: integer;
+    f: internal_font_number; 
+    c: integer;
+begin
+    f := font(p);
+    c := character(p);
+    char_shrink := 0;
+    k := pdf_font_shrink(f);
+    ef := get_ef_code(f, c);
+    if (k <> null_font) and (ef > 0) then begin
+        dw := char_width(f,c) - char_width(k,c);
+        if dw > 0 then
+            char_shrink := round_xn_over_d(dw, ef, 1000);
+    end;
+end;
+
+function kern_stretch(p: pointer): scaled;
+var l, r: pointer;
+    d: scaled;
+begin
+    kern_stretch := 0;
+    if (prev_char_p = null) or (vlink(prev_char_p) <> p) or (vlink(p) = null)
+    then
+        return;
+    l := prev_char_p;
+    r := vlink(p);
+    if not (is_char_node(l) and is_char_node(r) and
+            (font(l) = font(r)) and
+            (pdf_font_stretch(font(l)) <> null_font))
+    then
+        return;
+    d := get_kern(pdf_font_stretch(font(l)), character(l), character(r));
+    kern_stretch := round_xn_over_d(d - width(p),
+                                    get_ef_code(font(l), character(l)), 1000);
+end;
+
+function kern_shrink(p: pointer): scaled;
+var l, r: pointer;
+    d: scaled;
+begin
+    kern_shrink := 0;
+    if (prev_char_p = null) or (vlink(prev_char_p) <> p) or (vlink(p) = null)
+    then
+        return;
+    l := prev_char_p;
+    r := vlink(p);
+    if not (is_char_node(l) and is_char_node(r) and
+            (font(l) = font(r)) and
+            (pdf_font_shrink(font(l)) <> null_font))
+    then
+        return;
+    d := get_kern(pdf_font_shrink(font(l)), character(l), character(r));
+    kern_shrink := round_xn_over_d(width(p) - d,
+                                    get_ef_code(font(l), character(l)), 1000);
+end;
+
+procedure do_subst_font(p: pointer; ex_ratio: integer);
+var f, k: internal_font_number;
+    r: pointer;
+    ef: integer;
+begin
+    if not is_char_node(p) and (type(p) = disc_node) then begin
+        r := vlink(pre_break(p));
+        while r <> null do begin
+            if is_char_node(r) then
+                do_subst_font(r, ex_ratio);
+            r := vlink(r);
+        end;
+        r := vlink(post_break(p));
+        while r <> null do begin
+            if is_char_node(r) then
+                do_subst_font(r, ex_ratio);
+            r := vlink(r);
+        end;
+        r := vlink(no_break(p));
+        while r <> null do begin
+            if is_char_node(r) then
+                do_subst_font(r, ex_ratio);
+            r := vlink(r);
+        end;
+        return;
+    end;
+    if is_char_node(p) then
+        r := p
+    else begin
+        {|short_display_n(p, 5);|}
+        pdf_error("font expansion", "invalid node type");
+	    return;
+    end;
+    f := font(r);
+    ef := get_ef_code(f, character(r));
+    if ef = 0 then
+        return;
+    if (pdf_font_expand_ratio(f)=0) and 
+       (pdf_font_stretch(f) <> null_font) and 
+       (ex_ratio > 0) then
+        k := expand_font(f, ext_xn_over_d(ex_ratio*ef,
+                                          pdf_font_expand_ratio(pdf_font_stretch(f)),
+                                          1000000))
+    else if (pdf_font_expand_ratio(f)=0) and 
+            (pdf_font_shrink(f) <> null_font) and (ex_ratio < 0) then
+        k := expand_font(f, ext_xn_over_d(ex_ratio*ef,
+                                          -pdf_font_expand_ratio(pdf_font_shrink(f)),
+                                          1000000))
+    else
+        k := f;
+    if k <> f then begin
+        font(r) := k;
+        if not is_char_node(p) then begin
+            r := lig_ptr(p);
+            while r <> null do begin
+                font(r) := k;
+                r := vlink(r);
+            end;
+        end;
+    end;
+end;
+
+function char_pw(p: pointer; side: small_number): scaled;
+var f: internal_font_number;
+    c: integer;
+begin
+    char_pw := 0;
+    if side = left_side then
+        last_leftmost_char := null
+    else
+        last_rightmost_char := null;
+    if p = null then
+        return;
+    if not is_char_node(p) then 
+        return;
+    f := font(p);
+    if side = left_side then begin
+        c := get_lp_code(f, character(p));
+        last_leftmost_char := p;
+    end
+    else begin
+        c := get_rp_code(f, character(p));
+        last_rightmost_char := p;
+    end;
+    if c = 0 then
+        return;
+    char_pw :=
+        round_xn_over_d(quad(f), c, 1000);
+end;
+
+function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer;
+var k,q: pointer;
+begin
+    k := new_node(margin_kern_node,side);
+    width(k) := w;
+    if p = null then
+        pdf_error("margin kerning", "invalid pointer to marginal char node");
+    q := new_char(font(p), character(p)); margin_char(k):=q;
+    new_margin_kern := k;
+end;
+
+function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch,common_ending,exit;
+var r:pointer; {the box node that will be returned}
+@!q:pointer; {trails behind |p|}
+@!h,@!d,@!x:scaled; {height, depth, and natural width}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+@!f:internal_font_number; {the font in a |char_node|}
+@!dir_tmp,dir_ptr:pointer; {for managing the direction stack}
+@!hpack_dir:integer; {the current direction}
+@!disc_level:integer;
+pack_interrupt:array[0..255] of halfword;
+font_stretch: scaled;
+font_shrink: scaled;
+k: scaled;
+begin last_badness:=0; r:=new_node(hlist_node,min_quarterword);
+if pack_direction=-1 then
+  box_dir(r):=text_direction
+else begin
+  box_dir(r):=pack_direction; pack_direction:=-1;
+  end;
+hpack_dir:=box_dir(r);
+dir_ptr:=null;
+push_dir(hpack_dir);
+q:=r+list_offset; vlink(q):=p;@/
+if m = cal_expand_ratio then begin
+    prev_char_p := null;
+    font_stretch := 0;
+    font_shrink := 0;
+    font_expand_ratio := 0;
+end;
+@{
+if m = subst_ex_font then begin
+  wterm_ln('replacing ', font_expand_ratio:1);
+end;
+@}
+h:=0; @<Clear dimensions to zero@>;
+disc_level:=0;
+reswitch:
+while (p<>null)or(disc_level>0) do begin
+  if p=null then begin
+     decr(disc_level);
+     p:=pack_interrupt[disc_level];
+     goto reswitch;
+     end;
+  @<Examine node |p| in the hlist, taking account of its effect
+  on the dimensions of the new box, or moving it to the adjustment list;
+  then advance |p| to the next node@>;
+  end;
+if adjust_tail<>null then vlink(adjust_tail):=null;
+if pre_adjust_tail<>null then vlink(pre_adjust_tail):=null;
+height(r):=h; depth(r):=d;@/
+@<Determine the value of |width(r)| and the appropriate glue setting;
+  then |return| or |goto common_ending|@>;
+common_ending: @<Finish issuing a diagnostic message
+      for an overfull or underfull hbox@>;
+exit: 
+if (m = cal_expand_ratio) and (font_expand_ratio <> 0) then begin
+    font_expand_ratio := fix_int(font_expand_ratio, -1000, 1000);
+    q := list_ptr(r);
+	list_ptr(r):=null; flush_node(r);
+    r:=hpack(q, w, subst_ex_font);
+end;
+while dir_ptr<>null do pop_dir_node;
+hpack:=r;
+end;
+
+function filtered_hpack(@!p:pointer;@!qt:pointer;@!w:scaled;@!m:small_number;@!grp:integer):pointer;
+var q:pointer;
+  d:integer; { a direction }
+begin
+  new_hyphenation(p,qt);
+  call_func(new_ligkern(p,qt)); {don't care about the tail in this case}
+  q:=vlink(p);
+  q:=lua_hpack_filter(q,w,m,grp);
+  filtered_hpack:=hpack(q,w,m);
+end;
+
+@ @<Clear dimensions to zero@>=
+d:=0; x:=0;
+total_stretch[normal]:=0; total_shrink[normal]:=0;
+total_stretch[sfi]:=0; total_shrink[sfi]:=0;
+total_stretch[fil]:=0; total_shrink[fil]:=0;
+total_stretch[fill]:=0; total_shrink[fill]:=0;
+total_stretch[filll]:=0; total_shrink[filll]:=0
+
+@ @<Examine node |p| in the hlist, taking account of its effect...@>=
+@^inner loop@>
+begin while is_char_node(p) do
+  @<Incorporate character dimensions into the dimensions of
+    the hbox that will contain~it, then move to the next node@>;
+if p<>null then
+  begin case type(p) of
+  hlist_node,vlist_node,rule_node,unset_node:
+    @<Incorporate box dimensions into the dimensions of
+      the hbox that will contain~it@>;
+  ins_node,mark_node,adjust_node: begin if adjust_tail<>null then
+    @<Transfer node |p| to the adjustment list@>; end;
+  whatsit_node:@<Incorporate a whatsit node into an hbox@>;
+  glue_node:@<Incorporate glue into the horizontal totals@>;
+    margin_kern_node: begin
+    if m = cal_expand_ratio then begin
+        f := font(margin_char(p));
+        do_subst_font(margin_char(p), 1000);
+        if f <> font(margin_char(p)) then
+            font_stretch := font_stretch - width(p) -
+                char_pw(margin_char(p), subtype(p));
+        font(margin_char(p)) := f;
+        do_subst_font(margin_char(p), -1000);
+        if f <> font(margin_char(p)) then
+            font_shrink := font_shrink - width(p) -
+                char_pw(margin_char(p), subtype(p));
+        font(margin_char(p)) := f;
+      end
+    else if m = subst_ex_font then begin
+            do_subst_font(margin_char(p), font_expand_ratio);
+            width(p) := -char_pw(margin_char(p), subtype(p));
+      end;
+    x := x + width(p);
+    end;
+  kern_node: begin
+    if subtype(p) = normal then begin
+        if m = cal_expand_ratio then begin
+            font_stretch := font_stretch + kern_stretch(p);
+            font_shrink := font_shrink + kern_shrink(p);
+        end
+        else if m = subst_ex_font then begin
+            if font_expand_ratio > 0 then
+                k := kern_stretch(p)
+            else if font_expand_ratio < 0 then
+                k := kern_shrink(p)
+            else
+                pdfassert(0);
+            if k <> 0 then
+               width(p) := get_kern(font(prev_char_p),
+                                    character(prev_char_p),
+                                    character(vlink(p)))
+        end;
+      end;
+    x := x + width(p);
+    end;
+  math_node: x:=x+surround(p);
+  disc_node:
+      begin
+      if m = subst_ex_font then do_subst_font(p, font_expand_ratio);
+      if vlink(no_break(p))<>null then begin
+        pack_interrupt[disc_level]:=vlink(p);
+        incr(disc_level);
+        p:=no_break(p);
+        end;
+      end;
+  othercases do_nothing
+  endcases;@/
+  p:=vlink(p);
+  end;
+end
+
+
+@ The code here implicitly uses the fact that running dimensions are
+indicated by |null_flag|, which will be ignored in the calculations
+because it is a highly negative number.
+
+@<Incorporate box dimensions into the dimensions of the hbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+  if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[hpack_dir]) then begin
+    x:=x+height(p)+depth(p);
+    s:=shift_amount(p);
+    if (width(p) div 2)-s>h then h:=(width(p) div 2)-s;
+    if (width(p) div 2)+s>d then d:=(width(p) div 2)+s;
+    end
+  else if (type(p)=hlist_node) and (is_mirrored(hpack_dir)) then begin
+    x:=x+width(p);
+    s:=shift_amount(p);
+    if depth(p)-s>h then h:=depth(p)-s;
+    if height(p)+s>d then d:=height(p)+s;
+    end
+  else begin
+    x:=x+width(p);
+    s:=shift_amount(p);
+    if height(p)-s>h then h:=height(p)-s;
+    if depth(p)+s>d then d:=depth(p)+s;
+    end
+  end
+else begin
+  x:=x+width(p);
+  if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+  if height(p)-s>h then h:=height(p)-s;
+  if depth(p)+s>d then d:=depth(p)+s;
+  end;
+end
+
+@ The following code is part of \TeX's inner loop; i.e., adding another
+character of text to the user's input will cause each of these instructions
+to be exercised one more time.
+@^inner loop@>
+
+@d add_char_stretch_end(#) == char_stretch(#)
+@d add_char_stretch(#) == # := # + add_char_stretch_end
+
+@d add_char_shrink_end(#) == char_shrink(#)
+@d add_char_shrink(#) == # := # + add_char_shrink_end
+
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin
+if m >= cal_expand_ratio then begin
+    prev_char_p := p;
+    case m of
+    cal_expand_ratio: begin
+        add_char_stretch(font_stretch)(p);
+        add_char_shrink(font_shrink)(p);
+    end;
+    subst_ex_font:
+        do_subst_font(p, font_expand_ratio);
+    endcases;
+end;
+f:=font(p);
+if is_rotated(hpack_dir) then begin
+  x:=x+glyph_height(p)+glyph_depth(p);@/
+  s:=glyph_width(p) div 2;@+if s>h then h:=s;@+if s>d then d:=s;
+  end
+else if dir_opposite(dir_tertiary[hpack_dir])(dir_tertiary[box_dir(r)])
+  then begin
+  x:=x+glyph_width(p);@/
+  s:=glyph_depth(p);@+if s>h then h:=s;
+  s:=glyph_height(p);@+if s>d then d:=s;
+  end
+else begin
+  x:=x+glyph_width(p);@/
+  s:=glyph_height(p);@+if s>h then h:=s;
+  s:=glyph_depth(p);@+if s>d then d:=s;
+  end;
+p:=vlink(p);
+end
+
+@ Although node |q| is not necessarily the immediate predecessor of node |p|,
+it always points to some node in the list preceding |p|. Thus, we can delete
+nodes by moving |q| when necessary. The algorithm takes linear time, and the
+extra computation does not intrude on the inner loop unless it is necessary
+to make a deletion.
+@^inner loop@>
+
+@<Glob...@>=
+@!pre_adjust_tail: pointer;
+
+@ @<Set init...@>=
+pre_adjust_tail := null;
+
+@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
+|pre_adjust_tail| instead of |adjust_tail|.
+
+@d update_adjust_list(#) == begin
+    vlink(#) := adjust_ptr(p);
+    while vlink(#) <> null do
+        # := vlink(#);
+end
+
+@<Transfer node |p| to the adjustment list@>=
+begin while vlink(q)<>p do q:=vlink(q);
+    if type(p) = adjust_node then begin
+        if adjust_pre(p) <> 0 then
+            update_adjust_list(pre_adjust_tail)
+        else
+            update_adjust_list(adjust_tail);
+        p := vlink(p); 
+        adjust_ptr(vlink(q)):=null; flush_node(vlink(q));
+    end
+else  begin vlink(adjust_tail):=p; adjust_tail:=p; p:=vlink(p);
+  end;
+vlink(q):=p; p:=q;
+end
+
+@ @<Incorporate glue into the horizontal totals@>=
+begin g:=glue_ptr(p); x:=x+width(g);@/
+o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
+o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
+if subtype(p)>=a_leaders then
+  begin g:=leader_ptr(p);
+  if height(g)>h then h:=height(g);
+  if depth(g)>d then d:=depth(g);
+  end;
+end
+
+@ When we get to the present part of the program, |x| is the natural width
+of the box being packaged.
+
+@<Determine the value of |width(r)| and the appropriate glue setting...@>=
+if m=additional then w:=x+w;
+width(r):=w; x:=w-x; {now |x| is the excess to be made up}
+if x=0 then
+  begin glue_sign(r):=normal; glue_order(r):=normal;
+  set_glue_ratio_zero(glue_set(r));
+  return;
+  end
+else if x>0 then @<Determine horizontal glue stretch setting, then |return|
+    or \hbox{|goto common_ending|}@>
+else @<Determine horizontal glue shrink setting, then |return|
+    or \hbox{|goto common_ending|}@>
+
+@ If |hpack| is called with |m=cal_expand_ratio| we calculate
+|font_expand_ratio| and return without checking for overfull or underfull box.
+
+@<Determine horizontal glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+if (m = cal_expand_ratio) and (o = normal) and (font_stretch > 0) then begin
+    font_expand_ratio := divide_scaled_n(x, font_stretch, 1000.0);
+    return;
+end;
+glue_order(r):=o; glue_sign(r):=stretching;
+if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
+@^real division@>
+else  begin glue_sign(r):=normal;
+  set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
+  end;
+if o=normal then if list_ptr(r)<>null then
+  @<Report an underfull hbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+return;
+end
+
+@ @<Determine the stretch order@>=
+if total_stretch[filll]<>0 then o:=filll
+else if total_stretch[fill]<>0 then o:=fill
+else if total_stretch[fil]<>0 then o:=fil
+else if total_stretch[sfi]<>0 then o:=sfi
+else o:=normal
+
+@ @<Report an underfull hbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(x,total_stretch[normal]);
+if last_badness>hbadness then
+  begin print_ln;
+  if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
+  print(" \hbox (badness "); print_int(last_badness);
+@.Underfull \\hbox...@>
+@.Loose \\hbox...@>
+  goto common_ending;
+  end;
+end
+
+@ In order to provide a decent indication of where an overfull or underfull
+box originated, we use a global variable |pack_begin_line| that is
+set nonzero only when |hpack| is being called by the paragraph builder
+or the alignment finishing routine.
+
+@<Glob...@>=
+@!pack_begin_line:integer; {source file line where the current paragraph
+  or alignment began; a negative value denotes alignment}
+
+@ @<Set init...@>=
+pack_begin_line:=0;
+
+@ @<Finish issuing a diagnostic message for an overfull or underfull hbox@>=
+if output_active then print(") has occurred while \output is active")
+else  begin if pack_begin_line<>0 then
+    begin if pack_begin_line>0 then print(") in paragraph at lines ")
+    else print(") in alignment at lines ");
+    print_int(abs(pack_begin_line));
+    print("--");
+    end
+  else print(") detected at line ");
+  print_int(line);
+  end;
+print_ln;@/
+font_in_short_display:=null_font; short_display(list_ptr(r)); print_ln;@/
+begin_diagnostic; show_box(r); end_diagnostic(true)
+
+@ @<Determine horizontal glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+if (m = cal_expand_ratio) and (o = normal) and (font_shrink > 0) then begin
+    font_expand_ratio := divide_scaled_n(x, font_shrink, 1000.0);
+    return;
+end;
+glue_order(r):=o; glue_sign(r):=shrinking;
+if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
+@^real division@>
+else  begin glue_sign(r):=normal;
+  set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
+  end;
+if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
+  begin last_badness:=1000000;
+  set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
+  @<Report an overfull hbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+  end
+else if o=normal then if list_ptr(r)<>null then
+  @<Report a tight hbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+return;
+end
+
+@ @<Determine the shrink order@>=
+if total_shrink[filll]<>0 then o:=filll
+else if total_shrink[fill]<>0 then o:=fill
+else if total_shrink[fil]<>0 then o:=fil
+else if total_shrink[sfi]<>0 then o:=sfi
+else o:=normal
+
+@ @<Report an overfull hbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>hfuzz)or(hbadness<100) then
+  begin if (overfull_rule>0)and(-x-total_shrink[normal]>hfuzz) then
+    begin while vlink(q)<>null do q:=vlink(q);
+    vlink(q):=new_rule;  rule_dir(vlink(q)):=box_dir(r);
+    width(vlink(q)):=overfull_rule;
+    end;
+  print_ln; print_nl("Overfull \hbox (");
+@.Overfull \\hbox...@>
+  print_scaled(-x-total_shrink[normal]); print("pt too wide");
+  goto common_ending;
+  end
+
+@ @<Report a tight hbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(-x,total_shrink[normal]);
+if last_badness>hbadness then
+  begin print_ln; print_nl("Tight \hbox (badness "); print_int(last_badness);
+@.Tight \\hbox...@>
+  goto common_ending;
+  end;
+end
+
+@ The |vpack| subroutine is actually a special case of a slightly more
+general routine called |vpackage|, which has four parameters. The fourth
+parameter, which is |max_dimen| in the case of |vpack|, specifies the
+maximum depth of the page box that is constructed. The depth is first
+computed by the normal rules; if it exceeds this limit, the reference
+point is simply moved down until the limiting depth is attained.
+
+@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
+
+@p function vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled):
+  pointer;
+label common_ending, exit;
+var r:pointer; {the box node that will be returned}
+@!w,@!d,@!x:scaled; {width, depth, and natural height}
+@!s:scaled; {shift amount}
+@!g:pointer; {points to a glue specification}
+@!o:glue_ord; {order of infinity}
+begin last_badness:=0; 
+{pdfassert(p<>0);}
+r:=new_node(vlist_node,0);
+if pack_direction=-1 then
+  box_dir(r):=body_direction
+else begin
+  box_dir(r):=pack_direction; pack_direction:=-1;
+  end;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+list_ptr(r):=p;@/
+w:=0; @<Clear dimensions to zero@>;
+while p<>null do @<Examine node |p| in the vlist, taking account of its effect
+  on the dimensions of the new box; then advance |p| to the next node@>;
+width(r):=w;
+if d>l then
+  begin x:=x+d-l; depth(r):=l;
+  end
+else depth(r):=d;
+@<Determine the value of |height(r)| and the appropriate glue setting;
+  then |return| or |goto common_ending|@>;
+common_ending: @<Finish issuing a diagnostic message
+      for an overfull or underfull vbox@>;
+exit: vpackage:=r;
+end;
+
+function filtered_vpackage(@!p:pointer;@!h:scaled;@!m:small_number;@!l:scaled;@!grp:integer):pointer;
+var q:pointer;
+begin
+  q:=p;
+  q:=lua_vpack_filter(q,h,m,l,grp);
+  filtered_vpackage:=vpackage(q,h,m,l);
+end;
+
+@ @<Examine node |p| in the vlist, taking account of its effect...@>=
+begin if is_char_node(p) then confusion("vpack")
+@:this can't happen vpack}{\quad vpack@>
+else  case type(p) of
+  hlist_node,vlist_node,rule_node,unset_node:
+    @<Incorporate box dimensions into the dimensions of
+      the vbox that will contain~it@>;
+  whatsit_node:@<Incorporate a whatsit node into a vbox@>;
+  glue_node: @<Incorporate glue into the vertical totals@>;
+  kern_node: begin x:=x+d+width(p); d:=0;
+    end;
+  othercases do_nothing
+  endcases;
+p:=vlink(p);
+end
+
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+begin
+if (type(p)=hlist_node) or (type(p)=vlist_node) then begin
+  if dir_orthogonal(dir_primary[box_dir(p)])(dir_primary[box_dir(r)]) then begin
+    x:=x+d+(width(p) div 2); d:=width(p) div 2;
+    s:=shift_amount(p);
+    if depth(p)+height(p)+s>w then w:=depth(p)+height(p)+s;
+    end
+  else if (type(p)=hlist_node) and (is_mirrored(box_dir(p))) then begin
+    x:=x+d+depth(p); d:=height(p);
+    s:=shift_amount(p);
+    if width(p)+s>w then w:=width(p)+s;
+    end
+  else begin
+    x:=x+d+height(p); d:=depth(p);
+    s:=shift_amount(p);
+    if width(p)+s>w then w:=width(p)+s;
+    end
+  end  
+else
+  begin x:=x+d+height(p); d:=depth(p);
+  if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p);
+  if width(p)+s>w then w:=width(p)+s;
+  end;
+end
+
+@ @<Incorporate glue into the vertical totals@>=
+begin x:=x+d; d:=0;@/
+g:=glue_ptr(p); x:=x+width(g);@/
+o:=stretch_order(g); total_stretch[o]:=total_stretch[o]+stretch(g);
+o:=shrink_order(g); total_shrink[o]:=total_shrink[o]+shrink(g);
+if subtype(p)>=a_leaders then
+  begin g:=leader_ptr(p);
+  if width(g)>w then w:=width(g);
+  end;
+end
+
+@ When we get to the present part of the program, |x| is the natural height
+of the box being packaged.
+
+@<Determine the value of |height(r)| and the appropriate glue setting...@>=
+if m=additional then h:=x+h;
+height(r):=h; x:=h-x; {now |x| is the excess to be made up}
+if x=0 then
+  begin glue_sign(r):=normal; glue_order(r):=normal;
+  set_glue_ratio_zero(glue_set(r));
+  return;
+  end
+else if x>0 then @<Determine vertical glue stretch setting, then |return|
+    or \hbox{|goto common_ending|}@>
+else @<Determine vertical glue shrink setting, then |return|
+    or \hbox{|goto common_ending|}@>
+
+@ @<Determine vertical glue stretch setting...@>=
+begin @<Determine the stretch order@>;
+glue_order(r):=o; glue_sign(r):=stretching;
+if total_stretch[o]<>0 then glue_set(r):=unfloat(x/total_stretch[o])
+@^real division@>
+else  begin glue_sign(r):=normal;
+  set_glue_ratio_zero(glue_set(r)); {there's nothing to stretch}
+  end;
+if o=normal then if list_ptr(r)<>null then
+  @<Report an underfull vbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+return;
+end
+
+@ @<Report an underfull vbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(x,total_stretch[normal]);
+if last_badness>vbadness then
+  begin print_ln;
+  if last_badness>100 then print_nl("Underfull")@+else print_nl("Loose");
+  print(" \vbox (badness "); print_int(last_badness);
+@.Underfull \\vbox...@>
+@.Loose \\vbox...@>
+  goto common_ending;
+  end;
+end
+
+@ @<Finish issuing a diagnostic message for an overfull or underfull vbox@>=
+if output_active then print(") has occurred while \output is active")
+else  begin if pack_begin_line<>0 then {it's actually negative}
+    begin print(") in alignment at lines ");
+    print_int(abs(pack_begin_line));
+    print("--");
+    end
+  else print(") detected at line ");
+  print_int(line);
+  print_ln;@/
+  end;
+begin_diagnostic; show_box(r); end_diagnostic(true)
+
+@ @<Determine vertical glue shrink setting...@>=
+begin @<Determine the shrink order@>;
+glue_order(r):=o; glue_sign(r):=shrinking;
+if total_shrink[o]<>0 then glue_set(r):=unfloat((-x)/total_shrink[o])
+@^real division@>
+else  begin glue_sign(r):=normal;
+  set_glue_ratio_zero(glue_set(r)); {there's nothing to shrink}
+  end;
+if (total_shrink[o]<-x)and(o=normal)and(list_ptr(r)<>null) then
+  begin last_badness:=1000000;
+  set_glue_ratio_one(glue_set(r)); {use the maximum shrinkage}
+  @<Report an overfull vbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+  end
+else if o=normal then if list_ptr(r)<>null then
+  @<Report a tight vbox and |goto common_ending|, if this box
+    is sufficiently bad@>;
+return;
+end
+
+@ @<Report an overfull vbox and |goto common_ending|, if...@>=
+if (-x-total_shrink[normal]>vfuzz)or(vbadness<100) then
+  begin print_ln; print_nl("Overfull \vbox (");
+@.Overfull \\vbox...@>
+  print_scaled(-x-total_shrink[normal]); print("pt too high");
+  goto common_ending;
+  end
+
+@ @<Report a tight vbox and |goto common_ending|, if...@>=
+begin last_badness:=badness(-x,total_shrink[normal]);
+if last_badness>vbadness then
+  begin print_ln; print_nl("Tight \vbox (badness "); print_int(last_badness);
+@.Tight \\vbox...@>
+  goto common_ending;
+  end;
+end
+
+@ When a box is being appended to the current vertical list, the
+baselineskip calculation is handled by the |append_to_vlist| routine.
+
+@p procedure append_to_vlist(@!b:pointer);
+var d:scaled; {deficiency of space between baselines}
+@!p:pointer; {a new glue specification}
+begin if prev_depth>ignore_depth then
+  begin
+  if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then
+    d:=width(baseline_skip)-prev_depth-depth(b)
+  else
+    d:=width(baseline_skip)-prev_depth-height(b);
+  if d<line_skip_limit then p:=new_param_glue(line_skip_code)
+  else  begin p:=new_skip_param(baseline_skip_code);
+    width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
+    end;
+  vlink(tail):=p; tail:=p;
+  end;
+vlink(tail):=b; tail:=b;
+if (type(b)=hlist_node) and (is_mirrored(box_dir(b))) then 
+  prev_depth:=height(b)
+else
+  prev_depth:=depth(b);
+end;
+
+@* \[34] Data structures for math mode.
+When \TeX\ reads a formula that is enclosed between \.\$'s, it constructs an
+{\sl mlist}, which is essentially a tree structure representing that
+formula.  An mlist is a linear sequence of items, but we can regard it as
+a tree structure because mlists can appear within mlists. For example, many
+of the entries can be subscripted or superscripted, and such ``scripts''
+are mlists in their own right.
+
+An entire formula is parsed into such a tree before any of the actual
+typesetting is done, because the current style of type is usually not
+known until the formula has been fully scanned. For example, when the
+formula `\.{\$a+b \\over c+d\$}' is being read, there is no way to tell
+that `\.{a+b}' will be in script size until `\.{\\over}' has appeared.
+
+During the scanning process, each element of the mlist being built is
+classified as a relation, a binary operator, an open parenthesis, etc.,
+or as a construct like `\.{\\sqrt}' that must be built up. This classification
+appears in the mlist data structure.
+
+After a formula has been fully scanned, the mlist is converted to an hlist
+so that it can be incorporated into the surrounding text. This conversion is
+controlled by a recursive procedure that decides all of the appropriate
+styles by a ``top-down'' process starting at the outermost level and working
+in towards the subformulas. The formula is ultimately pasted together using
+combinations of horizontal and vertical boxes, with glue and penalty nodes
+inserted as necessary.
+
+An mlist is represented internally as a linked list consisting chiefly
+of ``noads'' (pronounced ``no-adds''), to distinguish them from the somewhat
+similar ``nodes'' in hlists and vlists. Certain kinds of ordinary nodes are
+allowed to appear in mlists together with the noads; \TeX\ tells the difference
+by means of the |type| field, since a noad's |type| is always greater than
+that of a node. An mlist does not contain character nodes, hlist nodes, vlist
+nodes, math nodes or unset nodes; in particular, each mlist item appears in the
+variable-size part of |mem|, so the |type| field is always present.
+
+@ Each noad is five or more words long. The first word contains the
+|type| and |subtype| and |link| fields that are already so familiar to
+us; the second contains the attribute list pointer, and the third,
+fourth an fifth words are called the noad's |nucleus|, |subscr|, and
+|supscr| fields. (This use of a combined attribute list is temporary. 
+Eventually, each of fields need their own list)
+
+Consider, for example, the simple formula `\.{\$x\^2\$}', which would be
+parsed into an mlist containing a single element called an |ord_noad|.
+The |nucleus| of this noad is a representation of `\.x', the |subscr| is
+empty, and the |supscr| is a representation of `\.2'.
+
+The |nucleus|, |subscr|, and |supscr| fields are further broken into
+subfields. If |p| points to a noad, and if |q| is one of its principal
+fields (e.g., |q=subscr(p)|), there are several possibilities for the
+subfields, depending on the |math_type| of |q|.
+
+\yskip\hang|math_type(q)=math_char| means that |fam(q)| refers to one of
+the sixteen font families, and |character(q)| is the number of a character
+within a font of that family, as in a character node.
+
+\yskip\hang|math_type(q)=math_text_char| is similar, but the character is
+unsubscripted and unsuperscripted and it is followed immediately by another
+character from the same font. (This |math_type| setting appears only
+briefly during the processing; it is used to suppress unwanted italic
+corrections.)
+
+\yskip\hang|math_type(q)=empty| indicates a field with no value (the
+corresponding attribute of noad |p| is not present).
+
+\yskip\hang|math_type(q)=sub_box| means that |vinfo(q)| points to a box
+node (either an |hlist_node| or a |vlist_node|) that should be used as the
+value of the field.  The |shift_amount| in the subsidiary box node is the
+amount by which that box will be shifted downward.
+
+\yskip\hang|math_type(q)=sub_mlist| means that |vinfo(q)| points to
+an mlist; the mlist must be converted to an hlist in order to obtain
+the value of this field.
+
+\yskip\noindent In the latter case, we might have |vinfo(q)=null|. This
+is not the same as |math_type(q)=empty|; for example, `\.{\$P\_\{\}\$}'
+and `\.{\$P\$}' produce different results (the former will not have the
+``italic correction'' added to the width of |P|, but the ``script skip''
+will be added).
+
+The definitions of subfields given here are a little wasteful of space,
+since a quarterword is being used for the |math_type| although only three
+bits would be needed. However, there are hardly ever many noads present at
+once, since they are soon converted to nodes that take up even more space,
+so we can afford to represent them in whatever way simplifies the
+programming.
+
+I tried exchanging |mcharacter()| and |math_type()| so that a character 
+could use the full Unicode range, but for some reason that does not work
+properly. TH
+
+@d noad_size=5 {number of words in a normal noad}
+@d nucleus(#)==#+2 {the |nucleus| field of a noad}
+@d supscr(#)==#+3 {the |supscr| field of a noad}
+@d subscr(#)==#+4 {the |subscr| field of a noad}
+@d math_type==vlink {a |quarterword| in |mem|}
+@d fam(#)==type(#) {a |quarterword| in |mem|}
+@d mcharacter(#)==subtype(#)
+@d math_char=1 {|math_type| when the attribute is simple}
+@d sub_box=2 {|math_type| when the attribute is a box}
+@d sub_mlist=3 {|math_type| when the attribute is a formula}
+@d math_text_char=4 {|math_type| when italic correction is dubious}
+
+@ Each portion of a formula is classified as Ord, Op, Bin, Rel, Ope,
+Clo, Pun, or Inn, for purposes of spacing and line breaking. An
+|ord_noad|, |op_noad|, |bin_noad|, |rel_noad|, |open_noad|, |close_noad|,
+|punct_noad|, or |inner_noad| is used to represent portions of the various
+types. For example, an `\.=' sign in a formula leads to the creation of a
+|rel_noad| whose |nucleus| field is a representation of an equals sign
+(usually |fam=0|, |character=@'75|).  A formula preceded by \.{\\mathrel}
+also results in a |rel_noad|.  When a |rel_noad| is followed by an
+|op_noad|, say, and possibly separated by one or more ordinary nodes (not
+noads), \TeX\ will insert a penalty node (with the current |rel_penalty|)
+just after the formula that corresponds to the |rel_noad|, unless there
+already was a penalty immediately following; and a ``thick space'' will be
+inserted just before the formula that corresponds to the |op_noad|.
+
+A noad of type |ord_noad|, |op_noad|, \dots, |inner_noad| usually
+has a |subtype=normal|. The only exception is that an |op_noad| might
+have |subtype=limits| or |no_limits|, if the normal positioning of
+limits has been overridden for this operator.
+
+@d ord_noad=unset_node+3 {|type| of a noad classified Ord}
+@d op_noad=ord_noad+1 {|type| of a noad classified Op}
+@d bin_noad=ord_noad+2 {|type| of a noad classified Bin}
+@d rel_noad=ord_noad+3 {|type| of a noad classified Rel}
+@d open_noad=ord_noad+4 {|type| of a noad classified Ope}
+@d close_noad=ord_noad+5 {|type| of a noad classified Clo}
+@d punct_noad=ord_noad+6 {|type| of a noad classified Pun}
+@d inner_noad=ord_noad+7 {|type| of a noad classified Inn}
+@d limits=1 {|subtype| of |op_noad| whose scripts are to be above, below}
+@d no_limits=2 {|subtype| of |op_noad| whose scripts are to be normal}
+
+@ A |radical_noad| is five words long; the fifth word is the |left_delimiter|
+field, which usually represents a square root sign.
+
+A |fraction_noad| is six words long; it has a |right_delimiter| field
+as well as a |left_delimiter|.
+
+Delimiter fields are of type |four_quarters|, and they have four subfields
+called |small_fam|, |small_char|, |large_fam|, |large_char|. These subfields
+represent variable-size delimiters by giving the ``small'' and ``large''
+starting characters, as explained in Chapter~17 of {\sl The \TeX book}.
+@:TeXbook}{\sl The \TeX book@>
+
+A |fraction_noad| is actually quite different from all other noads. Not
+only does it have six words, it has |thickness|, |denominator|, and
+|numerator| fields instead of |nucleus|, |subscr|, and |supscr|. The
+|thickness| is a scaled value that tells how thick to make a fraction
+rule; however, the special value |default_code| is used to stand for the
+|default_rule_thickness| of the current size. The |numerator| and
+|denominator| point to mlists that define a fraction; we always have
+$$\hbox{|math_type(numerator)=math_type(denominator)=sub_mlist|}.$$ The
+|left_delimiter| and |right_delimiter| fields specify delimiters that will
+be placed at the left and right of the fraction. In this way, a
+|fraction_noad| is able to represent all of \TeX's operators \.{\\over},
+\.{\\atop}, \.{\\above}, \.{\\overwithdelims}, \.{\\atopwithdelims}, and
+ \.{\\abovewithdelims}.
+
+@d left_delimiter(#)==#+5 {first delimiter field of a noad}
+@d right_delimiter(#)==#+6 {second delimiter field of a fraction noad}
+@d radical_noad=inner_noad+1 {|type| of a noad for square roots}
+@d radical_noad_size=6 {number of |mem| words in a radical noad}
+@d fraction_noad=radical_noad+1 {|type| of a noad for generalized fractions}
+@d fraction_noad_size=7 {number of |mem| words in a fraction noad}
+@d small_fam(#)==vmem(#).qqqq.b0 {|fam| for ``small'' delimiter}
+@d small_char(#)==vmem(#).qqqq.b1 {|character| for ``small'' delimiter}
+@d large_fam(#)==vmem(#).qqqq.b2 {|fam| for ``large'' delimiter}
+@d large_char(#)==vmem(#).qqqq.b3 {|character| for ``large'' delimiter}
+@d thickness(#)==vmem(#+2).sc {|thickness| field in a fraction noad}
+@d default_code==@'10000000000 {denotes |default_rule_thickness|}
+@d numerator==supscr {|numerator| field in a fraction noad}
+@d denominator==subscr {|denominator| field in a fraction noad}
+
+@ The global variable |empty_field| is set up for initialization of empty
+fields in new noads. Similarly, |null_delimiter| is for the initialization
+of delimiter fields.
+
+@<Glob...@>=
+@!empty_field:two_halves;
+@!null_delimiter:four_quarters;
+
+@ @<Set init...@>=
+empty_field.rh:=empty; empty_field.lh:=null;@/
+null_delimiter.b0:=0; null_delimiter.b1:=min_quarterword;@/
+null_delimiter.b2:=0; null_delimiter.b3:=min_quarterword;
+
+@ The |new_noad| function creates an |ord_noad| that is completely null.
+
+@p function new_noad:pointer;
+var p:pointer;
+begin p:=new_node(ord_noad,normal);
+vmem(nucleus(p)).hh:=empty_field;
+vmem(subscr(p)).hh:=empty_field;
+vmem(supscr(p)).hh:=empty_field;
+new_noad:=p;
+end;
+
+@ A few more kinds of noads will complete the set: An |under_noad| has its
+nucleus underlined; an |over_noad| has it overlined. An |accent_noad| places
+an accent over its nucleus; the accent character appears as
+|fam(accent_chr(p))| and |mcharacter(accent_chr(p))|. A |vcenter_noad|
+centers its nucleus vertically with respect to the axis of the formula;
+in such noads we always have |math_type(nucleus(p))=sub_box|.
+
+And finally, we have |left_noad| and |right_noad| types, to implement
+\TeX's \.{\\left} and \.{\\right} as well as \eTeX's \.{\\middle}.
+The |nucleus| of such noads is
+replaced by a |delimiter| field; thus, for example, `\.{\\left(}' produces
+a |left_noad| such that |delimiter(p)| holds the family and character
+codes for all left parentheses. A |left_noad| never appears in an mlist
+except as the first element, and a |right_noad| never appears in an mlist
+except as the last element; furthermore, we either have both a |left_noad|
+and a |right_noad|, or neither one is present. The |subscr| and |supscr|
+fields are always |empty| in a |left_noad| and a |right_noad|.
+
+@d under_noad=fraction_noad+1 {|type| of a noad for underlining}
+@d over_noad=under_noad+1 {|type| of a noad for overlining}
+@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
+@d accent_noad_size=6 {number of |mem| words in an accent noad}
+@d accent_chr(#)==#+5 {the |accent_chr| field of an accent noad}
+@d vcenter_noad=accent_noad+1 {|type| of a noad for \.{\\vcenter}}
+@d left_noad=vcenter_noad+1 {|type| of a noad for \.{\\left}}
+@d right_noad=left_noad+1 {|type| of a noad for \.{\\right}}
+@d delimiter==nucleus {|delimiter| field in left and right noads}
+@d middle_noad==1 {|subtype| of right noad representing \.{\\middle}}
+@d scripts_allowed(#)==(type(#)>=ord_noad)and(type(#)<left_noad)
+
+@ Math formulas can also contain instructions like \.{\\textstyle} that
+override \TeX's normal style rules. A |style_node| is inserted into the
+data structure to record such instructions; it is three words long, so it
+is considered a node instead of a noad. The |subtype| is either |display_style|
+or |text_style| or |script_style| or |script_script_style|. The
+second and third words of a |style_node| are not used, but they are
+present because a |choice_node| is converted to a |style_node|.
+
+\TeX\ uses even numbers 0, 2, 4, 6 to encode the basic styles
+|display_style|, \dots, |script_script_style|, and adds~1 to get the
+``cramped'' versions of these styles. This gives a numerical order that
+is backwards from the convention of Appendix~G in {\sl The \TeX book\/};
+i.e., a smaller style has a larger numerical value.
+@:TeXbook}{\sl The \TeX book@>
+
+@d style_node=unset_node+1 {|type| of a style node}
+@d style_node_size=4 {number of words in a style node}
+@d display_style=0 {|subtype| for \.{\\displaystyle}}
+@d text_style=2 {|subtype| for \.{\\textstyle}}
+@d script_style=4 {|subtype| for \.{\\scriptstyle}}
+@d script_script_style=6 {|subtype| for \.{\\scriptscriptstyle}}
+@d cramped=1 {add this to an uncramped style if you want to cramp it}
+
+@p function new_style(@!s:small_number):pointer; {create a style node}
+var p:pointer; {the new node}
+begin p:=new_node(style_node,s);
+new_style:=p;
+end;
+
+@ Finally, the \.{\\mathchoice} primitive creates a |choice_node|, which
+has special subfields |display_mlist|, |text_mlist|, |script_mlist|,
+and |script_script_mlist| pointing to the mlists for each style.
+
+@d choice_node=unset_node+2 {|type| of a choice node}
+@d display_mlist(#)==vinfo(#+2) {mlist to be used in display style}
+@d text_mlist(#)==vlink(#+2) {mlist to be used in text style}
+@d script_mlist(#)==vinfo(#+3) {mlist to be used in script style}
+@d script_script_mlist(#)==vlink(#+3) {mlist to be used in scriptscript style}
+
+@p function new_choice:pointer; {create a choice node}
+var p:pointer; {the new node}
+begin p:=new_node(choice_node,0); {the |subtype| is not used}
+new_choice:=p;
+end;
+
+@ Let's consider now the previously unwritten part of |show_node_list|
+that displays the things that can only be present in mlists; this
+program illustrates how to access the data structures just defined.
+
+In the context of the following program, |p| points to a node or noad that
+should be displayed, and the current string contains the ``recursion history''
+that leads to this point. The recursion history consists of a dot for each
+outer level in which |p| is subsidiary to some node, or in which |p| is
+subsidiary to the |nucleus| field of some noad; the dot is replaced by
+`\.\_' or `\.\^' or `\./' or `\.\\' if |p| is descended from the |subscr|
+or |supscr| or |denominator| or |numerator| fields of noads. For example,
+the current string would be `\.{.\^.\_/}' if |p| points to the |ord_noad| for
+|x| in the (ridiculous) formula
+`\.{\$\\sqrt\{a\^\{\\mathinner\{b\_\{c\\over x+y\}\}\}\}\$}'.
+
+@<Cases of |show_node_list| that arise...@>=
+style_node:print_style(subtype(p));
+choice_node:@<Display choice node |p|@>;
+ord_noad,op_noad,bin_noad,rel_noad,open_noad,close_noad,punct_noad,inner_noad,
+  radical_noad,over_noad,under_noad,vcenter_noad,accent_noad,
+  left_noad,right_noad:@<Display normal noad |p|@>;
+fraction_noad:@<Display fraction noad |p|@>;
+
+@ Here are some simple routines used in the display of noads.
+
+@<Declare procedures needed for displaying the elements of mlists@>=
+procedure print_fam_and_char(@!p:pointer); {prints family and character}
+begin print_esc("fam"); print_int(fam(p)); print_char(" ");
+print(qo(mcharacter(p)));
+end;
+@#
+procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value}
+{TH: FIX to do: print 48-bit integer where needed!}
+var a:integer; {accumulator}
+begin a:=small_fam(p)*256+qo(small_char(p));
+a:=a*@"1000+large_fam(p)*256+qo(large_char(p));
+if a<0 then print_int(a) {this should never happen}
+else print_hex(a);
+end;
+
+@ The next subroutine will descend to another level of recursion when a
+subsidiary mlist needs to be displayed. The parameter |c| indicates what
+character is to become part of the recursion history. An empty mlist is
+distinguished from a field with |math_type(p)=empty|, because these are
+not equivalent (as explained above).
+@^recursion@>
+
+@<Declare procedures needed for displaying...@>=
+procedure@?show_info; forward;@t\2@>@?{|show_node_list(vinfo(temp_ptr))|}
+procedure print_subsidiary_data(@!p:pointer;@!c:ASCII_code);
+  {display a noad field}
+begin if cur_length>=depth_threshold then
+  begin if math_type(p)<>empty then print(" []");
+  end
+else  begin append_char(c); {include |c| in the recursion history}
+  temp_ptr:=p; {prepare for |show_info| if recursion is needed}
+  case math_type(p) of
+  math_char: begin print_ln; print_current_string; print_fam_and_char(p);
+    end;
+  sub_box: show_info; {recursive call}
+  sub_mlist: if vinfo(p)=null then
+      begin print_ln; print_current_string; print("{}");
+      end
+    else show_info; {recursive call}
+  othercases do_nothing {|empty|}
+  endcases;@/
+  flush_char; {remove |c| from the recursion history}
+  end;
+end;
+
+@ The inelegant introduction of |show_info| in the code above seems better
+than the alternative of using \PASCAL's strange |forward| declaration for a
+procedure with parameters. The \PASCAL\ convention about dropping parameters
+from a post-|forward| procedure is, frankly, so intolerable to the author
+of \TeX\ that he would rather stoop to communication via a global temporary
+variable. (A similar stoopidity occurred with respect to |hlist_out| and
+|vlist_out| above, and it will occur with respect to |mlist_to_hlist| below.)
+@^Knuth, Donald Ervin@>
+@:PASCAL}{\PASCAL@>
+
+@p procedure show_info; {the reader will kindly forgive this}
+begin show_node_list(vinfo(temp_ptr));
+end;
+
+@ @<Declare procedures needed for displaying...@>=
+procedure print_style(@!c:integer);
+begin case c div 2 of
+0: print_esc("displaystyle"); {|display_style=0|}
+1: print_esc("textstyle"); {|text_style=2|}
+2: print_esc("scriptstyle"); {|script_style=4|}
+3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
+othercases print("Unknown style!")
+endcases;
+end;
+
+@ @<Display choice node |p|@>=
+begin print_esc("mathchoice");
+append_char("D"); show_node_list(display_mlist(p)); flush_char;
+append_char("T"); show_node_list(text_mlist(p)); flush_char;
+append_char("S"); show_node_list(script_mlist(p)); flush_char;
+append_char("s"); show_node_list(script_script_mlist(p)); flush_char;
+end
+
+@ @<Display normal noad |p|@>=
+begin case type(p) of
+ord_noad: print_esc("mathord");
+op_noad: print_esc("mathop");
+bin_noad: print_esc("mathbin");
+rel_noad: print_esc("mathrel");
+open_noad: print_esc("mathopen");
+close_noad: print_esc("mathclose");
+punct_noad: print_esc("mathpunct");
+inner_noad: print_esc("mathinner");
+over_noad: print_esc("overline");
+under_noad: print_esc("underline");
+vcenter_noad: print_esc("vcenter");
+radical_noad: begin
+  {TH: TODO print oradical where needed and fix otherwise} 
+  print_esc("radical"); print_delimiter(left_delimiter(p));
+  end;
+accent_noad: begin print_esc("accent"); print_fam_and_char(accent_chr(p));
+  end;
+left_noad: begin print_esc("left"); print_delimiter(nucleus(p));
+  end;
+right_noad: begin if subtype(p)=normal then print_esc("right")
+  else print_esc("middle");
+  print_delimiter(nucleus(p));
+  end;
+end;
+if type(p)<left_noad then
+  begin if subtype(p)<>normal then
+    if subtype(p)=limits then print_esc("limits")
+    else print_esc("nolimits");
+  print_subsidiary_data(nucleus(p),".");
+  end;
+print_subsidiary_data(supscr(p),"^");
+print_subsidiary_data(subscr(p),"_");
+end
+
+@ @<Display fraction noad |p|@>=
+begin print_esc("fraction, thickness ");
+if thickness(p)=default_code then print("= default")
+else print_scaled(thickness(p));
+if (small_fam(left_delimiter(p))<>0)or@+
+  (small_char(left_delimiter(p))<>min_quarterword)or@|
+  (large_fam(left_delimiter(p))<>0)or@|
+  (large_char(left_delimiter(p))<>min_quarterword) then
+  begin print(", left-delimiter "); print_delimiter(left_delimiter(p));
+  end;
+if (small_fam(right_delimiter(p))<>0)or@|
+  (small_char(right_delimiter(p))<>min_quarterword)or@|
+  (large_fam(right_delimiter(p))<>0)or@|
+  (large_char(right_delimiter(p))<>min_quarterword) then
+  begin print(", right-delimiter "); print_delimiter(right_delimiter(p));
+  end;
+print_subsidiary_data(numerator(p),"\");
+print_subsidiary_data(denominator(p),"/");
+end
+
+@* \[35] Subroutines for math mode.
+In order to convert mlists to hlists, i.e., noads to nodes, we need several
+subroutines that are conveniently dealt with now.
+
+Let us first introduce the macros that make it easy to get at the parameters and
+other font information. A size code, which is a multiple of 16, is added to a
+family number to get an index into the table of internal font numbers
+for each combination of family and size.  (Be alert: Size codes get
+larger as the type gets smaller.)
+
+@<Basic printing procedures@>=
+procedure print_size(@!s:integer);
+begin if s=0 then print_esc("textfont")
+else if s=script_size then print_esc("scriptfont")
+else print_esc("scriptscriptfont");
+end;
+
+@ Before an mlist is converted to an hlist, \TeX\ makes sure that
+the fonts in family~2 have enough parameters to be math-symbol
+fonts, and that the fonts in family~3 have enough parameters to be
+math-extension fonts. The math-symbol parameters are referred to by using the
+following macros, which take a size code as their parameter; for example,
+|num1(cur_size)| gives the value of the |num1| parameter for the current size.
+@^parameters for symbols@>
+@^font parameters@>
+
+@d mathsy_end(#)==
+@d mathsy(#)==font_param(fam_fnt(2+cur_size),#) mathsy_end
+@d math_x_height==mathsy(5) {height of `\.x'}
+@d math_quad==mathsy(6) {\.{18mu}}
+@d num1==mathsy(8) {numerator shift-up in display styles}
+@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}}
+@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}}
+@d denom1==mathsy(11) {denominator shift-down in display styles}
+@d denom2==mathsy(12) {denominator shift-down in non-display styles}
+@d sup1==mathsy(13) {superscript shift-up in uncramped display style}
+@d sup2==mathsy(14) {superscript shift-up in uncramped non-display}
+@d sup3==mathsy(15) {superscript shift-up in cramped styles}
+@d sub1==mathsy(16) {subscript shift-down if superscript is absent}
+@d sub2==mathsy(17) {subscript shift-down if superscript is present}
+@d sup_drop==mathsy(18) {superscript baseline below top of large box}
+@d sub_drop==mathsy(19) {subscript baseline below bottom of large box}
+@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters
+  in display styles}
+@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays}
+@d axis_height==mathsy(22) {height of fraction lines above the baseline}
+@d total_mathsy_params=22
+
+@ The math-extension parameters have similar macros, but the size code is
+omitted (since it is always |cur_size| when we refer to such parameters).
+@^parameters for symbols@>
+@^font parameters@>
+
+@d mathex(#)==font_param(fam_fnt(3+cur_size),#)
+@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars}
+@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op}
+@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op}
+@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op}
+@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op}
+@d big_op_spacing5==mathex(13) {padding above and below displayed limits}
+@d total_mathex_params=13
+
+@ We also need to compute the change in style between mlists and their
+subsidiaries. The following macros define the subsidiary style for
+an overlined nucleus (|cramped_style|), for a subscript or a superscript
+(|sub_style| or |sup_style|), or for a numerator or denominator (|num_style|
+or |denom_style|).
+
+@d cramped_style(#)==2*(# div 2)+cramped {cramp the style}
+@d sub_style(#)==2*(# div 4)+script_style+cramped {smaller and cramped}
+@d sup_style(#)==2*(# div 4)+script_style+(# mod 2) {smaller}
+@d num_style(#)==#+2-2*(# div 6) {smaller unless already script-script}
+@d denom_style(#)==2*(# div 2)+cramped+2-2*(# div 6) {smaller, cramped}
+
+@ When the style changes, the following piece of program computes associated
+information:
+
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
+begin if cur_style<script_style then cur_size:=text_size
+else cur_size:=script_size*((cur_style-text_style) div 2);
+cur_mu:=x_over_n(math_quad(cur_size),18);
+end
+
+@ Here is a function that returns a pointer to a rule node having a given
+thickness |t|. The rule will extend horizontally to the boundary of the vlist
+that eventually contains it.
+
+@p function fraction_rule(@!t:scaled):pointer;
+  {construct the bar for a fraction}
+var p:pointer; {the new node}
+begin p:=new_rule; rule_dir(p):=math_direction;
+height(p):=t; depth(p):=0; fraction_rule:=p;
+end;
+
+@ The |overbar| function returns a pointer to a vlist box that consists of
+a given box |b|, above which has been placed a kern of height |k| under a
+fraction rule of thickness |t| under additional space of height |t|.
+
+@p function overbar(@!b:pointer;@!k,@!t:scaled):pointer;
+var p,@!q:pointer; {nodes being constructed}
+begin p:=new_kern(k); vlink(p):=b; q:=fraction_rule(t); vlink(q):=p;
+p:=new_kern(t); vlink(p):=q;
+pack_direction:=math_direction; overbar:=vpack(p,natural);
+end;
+
+@ The |var_delimiter| function, which finds or constructs a sufficiently
+large delimiter, is the most interesting of the auxiliary functions that
+currently concern us. Given a pointer |d| to a delimiter field in some noad,
+together with a size code |s| and a vertical distance |v|, this function
+returns a pointer to a box that contains the smallest variant of |d| whose
+height plus depth is |v| or more. (And if no variant is large enough, it
+returns the largest available variant.) In particular, this routine will
+construct arbitrarily large delimiters from extensible components, if
+|d| leads to such characters.
+
+The value returned is a box whose |shift_amount| has been set so that
+the box is vertically centered with respect to the axis in the given size.
+If a built-up symbol is returned, the height of the box before shifting
+will be the height of its topmost component.
+
+@p@t\4@>@<Declare subprocedures for |var_delimiter|@>
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: integer; {best-so-far and tentative character codes}
+@!cc: integer; { a temporary character code for extensibles }
+@!m,@!n: integer; {the number of extensible pieces}
+@!u: scaled; {height-plus-depth of a tentative character}
+@!w: scaled; {largest height-plus-depth so far}
+@!z: integer; {runs through font family members}
+@!large_attempt: boolean; {are we trying the ``large'' variant?}
+begin f:=null_font; c:=0; w:=0; large_attempt:=false;
+z:=small_fam(d); x:=small_char(d);
+loop@+  begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
+    a better character is found; |goto found| as soon as a
+    large enough variant is encountered@>;
+  if large_attempt then goto found; {there were none large enough}
+  large_attempt:=true; z:=large_fam(d); x:=large_char(d);
+  end;
+found: if f<>null_font then
+  @<Make variable |b| point to a box for |(f,c)|@>
+else  begin b:=new_null_box;
+  width(b):=null_delimiter_space; {use this width if no delimiter was found}
+  end;
+z:=cur_size; cur_size:=s;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(cur_size);
+cur_size:=z;
+var_delimiter:=b;
+end;
+
+@ The search process is complicated slightly by the facts that some of the
+characters might not be present in some of the fonts, and they might not
+be probed in increasing order of height.
+
+@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
+if (z<>0)or(x<>min_quarterword) then
+  begin z:=z+s+script_size;
+  repeat z:=z-script_size; g:=fam_fnt(z);
+  if g<>null_font then
+    @<Look at the list of characters starting with |x| in
+      font |g|; set |f| and |c| whenever
+      a better character is found; |goto found| as soon as a
+      large enough variant is encountered@>;
+  until z<script_size;
+  end
+
+@ @<Look at the list of characters starting with |x|...@>=
+begin y:=x;
+if (y>=font_bc(g))and(y<=font_ec(g)) then
+  begin continue:
+  if char_exists(g,y) then
+    begin if char_tag(g,y)=ext_tag then
+      begin f:=g; c:=y; goto found;
+      end;
+    u:=char_height(g,y)+char_depth(g,y);
+    if u>w then
+      begin f:=g; c:=y; w:=u;
+      if u>=v then goto found;
+      end;
+    if char_tag(g,y)=list_tag then
+      begin y:=char_remainder(g,y); goto continue;
+      end;
+    end;
+  end;
+end
+
+@ Here is a subroutine that creates a new box, whose list contains a
+single character, and whose width includes the italic correction for
+that character. The height or depth of the box will be negative, if
+the height or depth of the character is negative; thus, this routine
+may deliver a slightly different result than |hpack| would produce.
+
+@<Declare subprocedures for |var_delimiter|@>=
+function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
+var @!b,@!p:pointer; {the new box and its character node}
+begin 
+b:=new_null_box; ci:=char_info_short(f,c);
+width(b):=charinfo_width(ci)+char_italic(f,c);
+height(b):=charinfo_height(ci); depth(b):=charinfo_depth(ci);
+p:=new_char(f,c); list_ptr(b):=p; char_box:=b;
+end;
+
+@ When the following code is executed, |char_tag(q)| will be equal to
+|ext_tag| if and only if a built-up symbol is supposed to be returned.
+
+@<Make variable |b| point to a box for |(f,c)|@>=
+if char_tag(f,c)=ext_tag then
+  @<Construct an extensible character in a new box |b|,
+    using recipe |rem_byte(q)| and font |f|@>
+else b:=char_box(f,c)
+
+@ When we build an extensible character, it's handy to have the
+following subroutine, which puts a given character on top
+of the characters already in box |b|:
+
+@<Declare subprocedures for |var_delimiter|@>=
+procedure stack_into_box(@!b:pointer;@!f:internal_font_number;
+  @!c:quarterword);
+var p:pointer; {new node placed into |b|}
+begin p:=char_box(f,c); vlink(p):=list_ptr(b); list_ptr(b):=p;
+height(b):=height(p);
+end;
+
+@ Another handy subroutine computes the height plus depth of
+a given character:
+
+@<Declare subprocedures for |var_delimiter|@>=
+function height_plus_depth(@!f:internal_font_number;@!c:quarterword):scaled;
+begin
+height_plus_depth:=char_height(f,c)+char_depth(f,c);
+end;
+
+@ @<Construct an extensible...@>=
+begin b:=new_null_box;
+type(b):=vlist_node;
+@<Compute the minimum suitable height, |w|, and the corresponding
+  number of extension steps, |n|; also set |width(b)|@>;
+cc:=ext_bot(f,c);
+if cc<>min_quarterword then stack_into_box(b,f,cc);
+cc:=ext_rep(f,c);
+for m:=1 to n do stack_into_box(b,f,cc);
+cc:=ext_mid(f,c);
+if cc<>min_quarterword then
+  begin stack_into_box(b,f,cc); cc:=ext_rep(f,c);
+  for m:=1 to n do stack_into_box(b,f,cc);
+  end;
+cc:=ext_top(f,c);
+if cc<>min_quarterword then stack_into_box(b,f,cc);
+depth(b):=w-height(b);
+end
+
+@ The width of an extensible character is the width of the repeatable
+module. If this module does not have positive height plus depth,
+we don't use any copies of it, otherwise we use as few as possible
+(in groups of two if there is a middle part).
+
+@<Compute the minimum suitable height, |w|, and...@>=
+cc:=ext_rep(f,c); u:=height_plus_depth(f,cc);
+w:=0; width(b):=char_width(f,cc)+char_italic(f,cc);@/
+cc:=ext_bot(f,c);@+if cc<>min_quarterword then w:=w+height_plus_depth(f,cc);
+cc:=ext_mid(f,c);@+if cc<>min_quarterword then w:=w+height_plus_depth(f,cc);
+cc:=ext_top(f,c);@+if cc<>min_quarterword then w:=w+height_plus_depth(f,cc);
+n:=0;
+if u>0 then while w<v do
+  begin w:=w+u; incr(n);
+  if (ext_mid(f,c))<>min_quarterword then w:=w+u;
+  end
+
+@ The next subroutine is much simpler; it is used for numerators and
+denominators of fractions as well as for displayed operators and
+their limits above and below. It takes a given box~|b| and
+changes it so that the new box is centered in a box of width~|w|.
+The centering is done by putting \.{\\hss} glue at the left and right
+of the list inside |b|, then packaging the new box; thus, the
+actual box might not really be centered, if it already contains
+infinite glue.
+
+The given box might contain a single character whose italic correction
+has been added to the width of the box; in this case a compensating
+kern is inserted.
+
+@p function rebox(@!b:pointer;@!w:scaled):pointer;
+var p,q:pointer; {temporary registers for list manipulation}
+@!f:internal_font_number; {font in a one-character box}
+@!v:scaled; {width of a character without italic correction}
+begin if (width(b)<>w)and(list_ptr(b)<>null) then
+  begin if type(b)=vlist_node then b:=hpack(b,natural);
+  p:=list_ptr(b);
+  if (is_char_node(p))and(vlink(p)=null) then
+    begin f:=font(p); v:=char_width(f,character(p));
+    if v<>width(b) then begin 
+       q:=new_kern(width(b)-v); vlink(p):=q;
+       end;
+    end;
+  list_ptr(b):=null; flush_node(b);
+  b:=new_glue(ss_glue); vlink(b):=p;
+  while vlink(p)<>null do p:=vlink(p);
+  q:=new_glue(ss_glue); vlink(p):=q;
+  rebox:=hpack(b,w,exactly);
+  end
+else  begin width(b):=w; rebox:=b;
+  end;
+end;
+
+@ Here is a subroutine that creates a new glue specification from another
+one that is expressed in `\.{mu}', given the value of the math unit.
+
+@d mu_mult(#)==nx_plus_y(n,#,xn_over_d(#,f,@'200000))
+
+@p function math_glue(@!g:pointer;@!m:scaled):pointer;
+var p:pointer; {the new glue specification}
+@!n:integer; {integer part of |m|}
+@!f:scaled; {fraction part of |m|}
+begin n:=x_over_n(m,@'200000); f:=remainder;@/
+if f<0 then
+  begin decr(n); f:=f+@'200000;
+  end;
+p:=new_node(glue_spec_node,0);
+width(p):=mu_mult(width(g)); {convert \.{mu} to \.{pt}}
+stretch_order(p):=stretch_order(g);
+if stretch_order(p)=normal then stretch(p):=mu_mult(stretch(g))
+else stretch(p):=stretch(g);
+shrink_order(p):=shrink_order(g);
+if shrink_order(p)=normal then shrink(p):=mu_mult(shrink(g))
+else shrink(p):=shrink(g);
+math_glue:=p;
+end;
+
+@ The |math_kern| subroutine removes |mu_glue| from a kern node, given
+the value of the math unit.
+
+@p procedure math_kern(@!p:pointer;@!m:scaled);
+var @!n:integer; {integer part of |m|}
+@!f:scaled; {fraction part of |m|}
+begin if subtype(p)=mu_glue then
+  begin n:=x_over_n(m,@'200000); f:=remainder;@/
+  if f<0 then
+    begin decr(n); f:=f+@'200000;
+    end;
+  width(p):=mu_mult(width(p)); subtype(p):=explicit;
+  end;
+end;
+
+@ Sometimes it is necessary to destroy an mlist. The following
+subroutine empties the current list, assuming that |abs(mode)=mmode|.
+
+@p procedure flush_math;
+begin flush_node_list(vlink(head)); flush_node_list(incompleat_noad);
+vlink(head):=null; tail:=head; incompleat_noad:=null;
+end;
+
+@* \[36] Typesetting math formulas.
+\TeX's most important routine for dealing with formulas is called
+|mlist_to_hlist|.  After a formula has been scanned and represented as an
+mlist, this routine converts it to an hlist that can be placed into a box
+or incorporated into the text of a paragraph. There are three implicit
+parameters, passed in global variables: |cur_mlist| points to the first
+node or noad in the given mlist (and it might be |null|); |cur_style| is a
+style code; and |mlist_penalties| is |true| if penalty nodes for potential
+line breaks are to be inserted into the resulting hlist. After
+|mlist_to_hlist| has acted, |vlink(temp_head)| points to the translated hlist.
+
+Since mlists can be inside mlists, the procedure is recursive. And since this
+is not part of \TeX's inner loop, the program has been written in a manner
+that stresses compactness over efficiency.
+@^recursion@>
+
+@<Glob...@>=
+@!cur_mlist:pointer; {beginning of mlist to be translated}
+@!cur_style:integer; {style code at current place in the list}
+@!cur_size:integer; {size code corresponding to |cur_style|}
+@!cur_mu:scaled; {the math unit width corresponding to |cur_size|}
+@!mlist_penalties:boolean; {should |mlist_to_hlist| insert penalties?}
+
+@ The recursion in |mlist_to_hlist| is due primarily to a subroutine
+called |clean_box| that puts a given noad field into a box using a given
+math style; |mlist_to_hlist| can call |clean_box|, which can call
+|mlist_to_hlist|.
+@^recursion@>
+
+The box returned by |clean_box| is ``clean'' in the
+sense that its |shift_amount| is zero.
+
+@p procedure@?mlist_to_hlist; forward;@t\2@>@/
+function clean_box(@!p:pointer;@!s:integer):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:integer; {|cur_style| to be restored}
+@!x:pointer; {box to be returned}
+@!r:pointer; {temporary pointer}
+begin 
+case math_type(p) of
+math_char: begin cur_mlist:=new_noad; vmem(nucleus(cur_mlist)):=vmem(p);
+  end;
+sub_box: begin q:=vinfo(p); goto found;
+  end;
+sub_mlist: cur_mlist:=vinfo(p);
+othercases begin q:=new_null_box; goto found;
+  end
+endcases;@/
+save_style:=cur_style; cur_style:=s; mlist_penalties:=false;@/
+mlist_to_hlist; q:=vlink(temp_head); {recursive call}
+cur_style:=save_style; {restore the style}
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+found: if is_char_node(q)or(q=null) then x:=hpack(q,natural)
+  else if (vlink(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then
+    x:=q {it's already clean}
+  else x:=hpack(q,natural);
+@<Simplify a trivial box@>;
+clean_box:=x;
+end;
+
+@ Here we save memory space in a common case.
+
+@<Simplify a trivial box@>=
+q:=list_ptr(x);
+if is_char_node(q) then
+  begin r:=vlink(q);
+  if r<>null then if vlink(r)=null then if not is_char_node(r) then
+   if type(r)=kern_node then {unneeded italic correction}
+    begin flush_node(r); vlink(q):=null;
+    end;
+  end
+
+@ It is convenient to have a procedure that converts a |math_char|
+field to an ``unpacked'' form. The |fetch| routine sets |cur_f| and |cur_c|
+to the font code and character code of a given noad field. 
+It also takes care of issuing error messages for
+nonexistent characters; in such cases, |char_exists(cur_f,cur_c)| will be |false|
+after |fetch| has acted, and the field will also have been reset to |empty|.
+
+@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
+begin cur_c:=mcharacter(a); cur_f:=fam_fnt(fam(a)+cur_size);
+if cur_f=null_font then
+  @<Complain about an undefined family@>
+else  begin 
+  if not(char_exists(cur_f,cur_c)) then
+    begin char_warning(cur_f,qo(cur_c));
+    math_type(a):=empty;
+    end;
+  end;
+end;
+
+@ @<Complain about an undefined family@>=
+begin print_err(""); print_size(cur_size); print_char(" ");
+print_int(fam(a)); print(" is undefined (character ");
+print(qo(cur_c)); print_char(")");
+help4("Somewhere in the math formula just ended, you used the")@/
+("stated character from an undefined font family. For example,")@/
+("plain TeX doesn't allow \it or \sl in subscripts. Proceed,")@/
+("and I'll try to forget that I needed that character.");
+error; math_type(a):=empty;
+end
+
+@ The outputs of |fetch| are placed in global variables.
+
+@<Glob...@>=
+@!cur_f:internal_font_number; {the |font| field of a |math_char|}
+@!cur_c:quarterword; {the |character| field of a |math_char|}
+
+@ We need to do a lot of different things, so |mlist_to_hlist| makes two
+passes over the given mlist.
+
+The first pass does most of the processing: It removes ``mu'' spacing from
+glue, it recursively evaluates all subsidiary mlists so that only the
+top-level mlist remains to be handled, it puts fractions and square roots
+and such things into boxes, it attaches subscripts and superscripts, and
+it computes the overall height and depth of the top-level mlist so that
+the size of delimiters for a |left_noad| and a |right_noad| will be known.
+The hlist resulting from each noad is recorded in that noad's |new_hlist|
+field, an integer field that replaces the |nucleus| or |thickness|.
+@^recursion@>
+
+The second pass eliminates all noads and inserts the correct glue and
+penalties between nodes.
+
+@d new_hlist(#)==vmem(nucleus(#)).int {the translation of an mlist}
+
+@ Here is the overall plan of |mlist_to_hlist|, and the list of its
+local variables.
+
+@d done_with_noad=80 {go here when a noad has been fully translated}
+@d done_with_node=81 {go here when a node has been fully converted}
+@d check_dimensions=82 {go here to update |max_h| and |max_d|}
+@d delete_q=83 {go here to delete |q| and move to the next node}
+
+@p@t\4@>@<Declare math construction procedures@>
+procedure mlist_to_hlist;
+label reswitch, check_dimensions, done_with_noad, done_with_node, delete_q,
+  done;
+var mlist:pointer; {beginning of the given list}
+@!penalties:boolean; {should penalty nodes be inserted?}
+@!style:integer; {the given style}
+@!save_style:integer; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:integer; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:integer; {the effective |type| of noad |q| during the second pass}
+@!p,@!x,@!y,@!z: pointer; {temporary registers for list construction}
+@!pen:integer; {a penalty to be inserted}
+@!s:integer; {the size of a noad to be deleted}
+@!max_hl,@!max_d:scaled; {maximum height and depth of the list translated so far}
+@!delta:scaled; {offset between subscript and superscript}
+begin mlist:=cur_mlist; penalties:=mlist_penalties;
+style:=cur_style; {tuck global parameters away as local variables}
+q:=mlist; r:=null; r_type:=op_noad; max_hl:=0; max_d:=0; x:=null; p:=null;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+while q<>null do @<Process node-or-noad |q| as much as possible in preparation
+    for the second pass of |mlist_to_hlist|, then move to the next
+    item in the mlist@>;
+@<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
+@<Make a second pass over the mlist, removing all noads and inserting the
+  proper spacing and penalties@>;
+end;
+
+@ We use the fact that no character nodes appear in an mlist, hence
+the field |type(q)| is always present.
+
+@<Process node-or-noad...@>=
+begin @<Do first-pass processing based on |type(q)|; |goto done_with_noad|
+  if a noad has been fully processed, |goto check_dimensions| if it
+  has been translated into |new_hlist(q)|, or |goto done_with_node|
+  if a node has been fully processed@>;
+check_dimensions: z:=hpack(new_hlist(q),natural);
+if height(z)>max_hl then max_hl:=height(z);
+if depth(z)>max_d then max_d:=depth(z);
+list_ptr(z):=null; flush_node(z);
+done_with_noad: r:=q; r_type:=type(r);
+if r_type=right_noad then
+  begin r_type:=left_noad; cur_style:=style; @<Set up the values...@>;
+  end;
+done_with_node: q:=vlink(q);
+end
+
+@ One of the things we must do on the first pass is change a |bin_noad| to
+an |ord_noad| if the |bin_noad| is not in the context of a binary operator.
+The values of |r| and |r_type| make this fairly easy.
+
+@<Do first-pass processing...@>=
+reswitch: delta:=0;
+case type(q) of
+bin_noad: case r_type of
+  bin_noad,op_noad,rel_noad,open_noad,punct_noad,left_noad:
+    begin type(q):=ord_noad; goto reswitch;
+    end;
+  othercases do_nothing
+  endcases;
+rel_noad,close_noad,punct_noad,right_noad: begin@t@>@;@/
+  @<Convert \(a)a final |bin_noad| to an |ord_noad|@>;
+  if type(q)=right_noad then goto done_with_noad;
+  end;
+@t\4@>@<Cases for noads that can follow a |bin_noad|@>@;
+@t\4@>@<Cases for nodes that can appear in an mlist, after which we
+  |goto done_with_node|@>@;
+othercases confusion("mlist1")
+@:this can't happen mlist1}{\quad mlist1@>
+endcases;@/
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>
+
+@ @<Convert \(a)a final |bin_noad| to an |ord_noad|@>=
+if r_type=bin_noad then type(r):=ord_noad
+
+@ @<Cases for nodes that can appear in an mlist...@>=
+style_node: begin cur_style:=subtype(q);
+  @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+  goto done_with_node;
+  end;
+choice_node: @<Change this node to a style node followed by the correct choice,
+   then |goto done_with_node|@>;
+ins_node,mark_node,adjust_node,
+  whatsit_node,penalty_node,disc_node: goto done_with_node;
+rule_node: begin if height(q)>max_hl then max_hl:=height(q);
+  if depth(q)>max_d then max_d:=depth(q); goto done_with_node;
+  end;
+glue_node: begin @<Convert \(m)math glue to ordinary glue@>;
+  goto done_with_node;
+  end;
+kern_node: begin math_kern(q,cur_mu); goto done_with_node;
+  end;
+
+@ @d choose_mlist(#)==begin p:=#(q); #(q):=null;@+end
+
+@<Change this node to a style node...@>=
+begin case cur_style div 2 of
+0: choose_mlist(display_mlist); {|display_style=0|}
+1: choose_mlist(text_mlist); {|text_style=2|}
+2: choose_mlist(script_mlist); {|script_style=4|}
+3: choose_mlist(script_script_mlist); {|script_script_style=6|}
+end; {there are no other cases}
+flush_node_list(display_mlist(q));
+flush_node_list(text_mlist(q));
+flush_node_list(script_mlist(q));
+flush_node_list(script_script_mlist(q));@/
+type(q):=style_node; subtype(q):=cur_style; width(q):=0; depth(q):=0;
+if p<>null then
+  begin z:=vlink(q); vlink(q):=p;
+  while vlink(p)<>null do p:=vlink(p);
+  vlink(p):=z;
+  end;
+goto done_with_node;
+end
+
+@ Conditional math glue (`\.{\\nonscript}') results in a |glue_node|
+pointing to |zero_glue|, with |subtype(q)=cond_math_glue|; in such a case
+the node following will be eliminated if it is a glue or kern node and if the
+current size is different from |text_size|. Unconditional math glue
+(`\.{\\muskip}') is converted to normal glue by multiplying the dimensions
+by |cur_mu|.
+@!@:non_script_}{\.{\\nonscript} primitive@>
+
+@<Convert \(m)math glue to ordinary glue@>=
+if subtype(q)=mu_glue then
+  begin x:=glue_ptr(q);
+  y:=math_glue(x,cur_mu); delete_glue_ref(x); glue_ptr(q):=y;
+  subtype(q):=normal;
+  end
+else if (cur_size<>text_size)and(subtype(q)=cond_math_glue) then
+  begin p:=vlink(q);
+  if p<>null then if (type(p)=glue_node)or(type(p)=kern_node) then
+      begin vlink(q):=vlink(p); vlink(p):=null; flush_node_list(p);
+      end;
+  end
+
+@ @<Cases for noads that can follow a |bin_noad|@>=
+left_noad: goto done_with_noad;
+fraction_noad: begin make_fraction(q); goto check_dimensions;
+  end;
+op_noad: begin delta:=make_op(q);
+  if subtype(q)=limits then goto check_dimensions;
+  end;
+ord_noad: make_ord(q);
+open_noad,inner_noad: do_nothing;
+radical_noad: make_radical(q);
+over_noad: make_over(q);
+under_noad: make_under(q);
+accent_noad: make_math_accent(q);
+vcenter_noad: make_vcenter(q);
+
+@ Most of the actual construction work of |mlist_to_hlist| is done
+by procedures with names
+like |make_fraction|, |make_radical|, etc. To illustrate
+the general setup of such procedures, let's begin with a couple of
+simple ones.
+
+@<Declare math...@>=
+procedure make_over(@!q:pointer);
+var p:pointer;
+begin p:=overbar(clean_box(nucleus(q),cramped_style(cur_style)),@|
+  	  3*default_rule_thickness,default_rule_thickness);
+vinfo(nucleus(q)):=p;
+math_type(nucleus(q)):=sub_box;
+end;
+
+@ @<Declare math...@>=
+procedure make_under(@!q:pointer);
+var p,@!x,@!y,@!r: pointer; {temporary registers for box construction}
+@!delta:scaled; {overall height plus depth}
+begin x:=clean_box(nucleus(q),cur_style);
+p:=new_kern(3*default_rule_thickness); vlink(x):=p;
+r:=fraction_rule(default_rule_thickness); vlink(p):=r;
+pack_direction:=math_direction; y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+vinfo(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+end;
+
+@ @<Declare math...@>=
+procedure make_vcenter(@!q:pointer);
+var v:pointer; {the box that should be centered vertically}
+@!delta:scaled; {its height plus depth}
+begin v:=vinfo(nucleus(q));
+if type(v)<>vlist_node then confusion("vcenter");
+@:this can't happen vcenter}{\quad vcenter@>
+delta:=height(v)+depth(v);
+height(v):=axis_height(cur_size)+half(delta);
+depth(v):=delta-height(v);
+end;
+
+@ According to the rules in the \.{DVI} file specifications, we ensure alignment
+@^square roots@>
+between a square root sign and the rule above its nucleus by assuming that the
+baseline of the square-root symbol is the same as the bottom of the rule. The
+height of the square-root symbol will be the thickness of the rule, and the
+depth of the square-root symbol should exceed or equal the height-plus-depth
+of the nucleus plus a certain minimum clearance~|clr|. The symbol will be
+placed so that the actual clearance is |clr| plus half the excess.
+
+@<Declare math...@>=
+procedure make_radical(@!q:pointer);
+var x,@!y,@!p:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+  clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else  begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+  end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+  default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+p:=overbar(x,clr,height(y)); vlink(y):=p;
+p:=hpack(y,natural); vinfo(nucleus(q)):=p; 
+math_type(nucleus(q)):=sub_box;
+end;
+
+@ Slants are not considered when placing accents in math mode. The accenter is
+centered over the accentee, and the accent width is treated as zero with
+respect to the size of the final box.
+
+@<Declare math...@>=
+procedure make_math_accent(@!q:pointer);
+label done;
+var p,@!x,@!y:pointer; {temporary registers for box construction}
+@!c:quarterword; {accent character}
+@!f:internal_font_number; {its font}
+@!s:scaled; {amount to skew the accent to the right}
+@!h:scaled; {height of character being accented}
+@!delta:scaled; {space to remove between accent and accentee}
+@!w:scaled; {width of the accentee, not including sub/superscripts}
+begin fetch(accent_chr(q));
+if char_exists(cur_f,cur_c) then
+  begin c:=cur_c; f:=cur_f;@/
+  @<Compute the amount of skew@>;
+  x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
+  @<Switch to a larger accent if available and appropriate@>;
+  if h<x_height(f) then delta:=h@+else delta:=x_height(f);
+  if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
+    if math_type(nucleus(q))=math_char then
+      @<Swap the subscript and superscript into box |x|@>;
+  y:=char_box(f,c);
+  shift_amount(y):=s+half(w-width(y));
+  width(y):=0; p:=new_kern(-delta); vlink(p):=x; vlink(y):=p;
+  pack_direction:=math_direction;
+  y:=vpack(y,natural); width(y):=width(x);
+  if height(y)<h then @<Make the height of box |y| equal to |h|@>;
+  vinfo(nucleus(q)):=y;
+  math_type(nucleus(q)):=sub_box;
+  end;
+end;
+
+@ @<Make the height of box |y|...@>=
+begin p:=new_kern(h-height(y)); vlink(p):=list_ptr(y); list_ptr(y):=p;
+height(y):=h;
+end
+
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+  begin if char_tag(f,c)<>list_tag then goto done;
+  y:=char_remainder(f,c);
+  if not char_exists(f,y) then goto done;
+  if char_width(f,y)>w then goto done;
+  c:=y;
+  end;
+done:
+
+@ @<Compute the amount of skew@>=
+s:=0;
+if math_type(nucleus(q))=math_char then
+  begin fetch(nucleus(q));
+  s := get_kern(cur_f,cur_c,skew_char(cur_f));
+  end
+
+@ @<Swap the subscript and superscript into box |x|@>=
+begin flush_node_list(x); x:=new_noad;
+vmem(nucleus(x)):=vmem(nucleus(q));
+vmem(supscr(x)):=vmem(supscr(q));
+vmem(subscr(x)):=vmem(subscr(q));@/
+vmem(supscr(q)).hh:=empty_field;
+vmem(subscr(q)).hh:=empty_field;@/
+math_type(nucleus(q)):=sub_mlist; vinfo(nucleus(q)):=x;
+x:=clean_box(nucleus(q),cur_style); delta:=delta+height(x)-h; h:=height(x);
+end
+
+@ The |make_fraction| procedure is a bit different because it sets
+|new_hlist(q)| directly rather than making a sub-box.
+
+@<Declare math...@>=
+procedure make_fraction(@!q:pointer);
+var p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!delta,@!delta1,@!delta2,@!shift_up,@!shift_down,@!clr:scaled;
+  {dimensions for box calculations}
+begin if thickness(q)=default_code then thickness(q):=default_rule_thickness;
+@<Create equal-width boxes |x| and |z| for the numerator and denominator,
+  and compute the default amounts |shift_up| and |shift_down| by which they
+  are displaced from the baseline@>;
+if thickness(q)=0 then @<Adjust \(s)|shift_up| and |shift_down| for the case
+  of no fraction line@>
+else @<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>;
+@<Construct a vlist box for the fraction, according to |shift_up| and
+  |shift_down|@>;
+@<Put the \(f)fraction into a box with its delimiters, and make |new_hlist(q)|
+  point to it@>;
+end;
+
+@ @<Create equal-width boxes |x| and |z| for the numerator and denom...@>=
+x:=clean_box(numerator(q),num_style(cur_style)); 
+z:=clean_box(denominator(q),denom_style(cur_style));
+vinfo(numerator(q)):=null;
+vinfo(denominator(q)):=null;
+if width(x)<width(z) then x:=rebox(x,width(z))
+else z:=rebox(z,width(x));
+if cur_style<text_style then {display style}
+  begin shift_up:=num1(cur_size); shift_down:=denom1(cur_size);
+  end
+else  begin shift_down:=denom2(cur_size);
+  if thickness(q)<>0 then shift_up:=num2(cur_size)
+  else shift_up:=num3(cur_size);
+  end
+
+@ The numerator and denominator must be separated by a certain minimum
+clearance, called |clr| in the following program. The difference between
+|clr| and the actual clearance is |2delta|.
+
+@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
+begin if cur_style<text_style then clr:=7*default_rule_thickness
+else clr:=3*default_rule_thickness;
+delta:=half(clr-((shift_up-depth(x))-(height(z)-shift_down)));
+if delta>0 then
+  begin shift_up:=shift_up+delta;
+  shift_down:=shift_down+delta;
+  end;
+end
+
+@ In the case of a fraction line, the minimum clearance depends on the actual
+thickness of the line.
+
+@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
+begin if cur_style<text_style then clr:=3*thickness(q)
+else clr:=thickness(q);
+delta:=half(thickness(q));
+delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
+delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+if delta1>0 then shift_up:=shift_up+delta1;
+if delta2>0 then shift_down:=shift_down+delta2;
+end
+
+@ @<Construct a vlist box for the fraction...@>=
+v:=new_null_box; type(v):=vlist_node;
+height(v):=shift_up+height(x); depth(v):=depth(z)+shift_down;
+width(v):=width(x); {this also equals |width(z)|}
+if thickness(q)=0 then
+  begin p:=new_kern((shift_up-depth(x))-(height(z)-shift_down));
+  vlink(p):=z;
+  end
+else  begin y:=fraction_rule(thickness(q));@/
+  p:=new_kern((axis_height(cur_size)-delta)-@|(height(z)-shift_down));@/
+  vlink(y):=p; vlink(p):=z;@/
+  p:=new_kern((shift_up-depth(x))-(axis_height(cur_size)+delta));
+  vlink(p):=y;
+  end;
+vlink(x):=p; list_ptr(v):=x
+
+@ @<Put the \(f)fraction into a box with its delimiters...@>=
+if cur_style<text_style then delta:=delim1(cur_size)
+else delta:=delim2(cur_size);
+x:=var_delimiter(left_delimiter(q), cur_size, delta); vlink(x):=v;@/
+z:=var_delimiter(right_delimiter(q), cur_size, delta); vlink(v):=z;@/
+y:=hpack(x,natural); 
+new_hlist(q):=y
+
+@ If the nucleus of an |op_noad| is a single character, it is to be
+centered vertically with respect to the axis, after first being enlarged
+(via a character list in the font) if we are in display style.  The normal
+convention for placing displayed limits is to put them above and below the
+operator in display style.
+
+The italic correction is removed from the character if there is a subscript
+and the limits are not being displayed. The |make_op|
+routine returns the value that should be used as an offset between
+subscript and superscript.
+
+After |make_op| has acted, |subtype(q)| will be |limits| if and only if
+the limits have been set above and below the operator. In that case,
+|new_hlist(q)| will already contain the desired final box.
+
+@<Declare math...@>=
+function make_op(@!q:pointer):scaled;
+var delta:scaled; {offset between subscript and superscript}
+@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!c:quarterword; {register for character examination}
+@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
+begin if (subtype(q)=normal)and(cur_style<text_style) then
+  subtype(q):=limits;
+if math_type(nucleus(q))=math_char then
+  begin fetch(nucleus(q));
+  if (cur_style<text_style)and(char_tag(cur_f,cur_c)=list_tag) then {make it larger}
+    begin c:=char_remainder(cur_f,cur_c);
+    if char_exists(cur_f,c) then
+      begin cur_c:=c; mcharacter(nucleus(q)):=c;
+      end;
+    end;
+  delta:=char_italic(cur_f,cur_c); x:=clean_box(nucleus(q),cur_style);
+  if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
+    width(x):=width(x)-delta; {remove italic correction}
+  shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
+    {center vertically}
+  math_type(nucleus(q)):=sub_box; vinfo(nucleus(q)):=x;
+  end
+else delta:=0;
+if subtype(q)=limits then
+  @<Construct a box with limits above and below it, skewed by |delta|@>;
+make_op:=delta;
+end;
+
+@ The following program builds a vlist box |v| for displayed limits. The
+width of the box is not affected by the fact that the limits may be skewed.
+
+@<Construct a box with limits above and below it...@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+y:=clean_box(nucleus(q),cur_style);
+z:=clean_box(subscr(q),sub_style(cur_style));
+v:=new_null_box; type(v):=vlist_node; width(v):=width(y);
+if width(x)>width(v) then width(v):=width(x);
+if width(z)>width(v) then width(v):=width(z);
+x:=rebox(x,width(v)); y:=rebox(y,width(v)); z:=rebox(z,width(v));@/
+shift_amount(x):=half(delta); shift_amount(z):=-shift_amount(x);
+height(v):=height(y); depth(v):=depth(y);
+@<Attach the limits to |y| and adjust |height(v)|, |depth(v)| to
+  account for their presence@>;
+new_hlist(q):=v;
+end
+
+@ We use |shift_up| and |shift_down| in the following program for the
+amount of glue between the displayed operator |y| and its limits |x| and
+|z|. The vlist inside box |v| will consist of |x| followed by |y| followed
+by |z|, with kern nodes for the spaces between and around them.
+
+@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
+if math_type(supscr(q))=empty then
+  begin list_ptr(x):=null; flush_node(x); list_ptr(v):=y;
+  end
+else  begin shift_up:=big_op_spacing3-depth(x);
+  if shift_up<big_op_spacing1 then shift_up:=big_op_spacing1;
+  p:=new_kern(shift_up); vlink(p):=y; vlink(x):=p;@/
+  p:=new_kern(big_op_spacing5); vlink(p):=x; list_ptr(v):=p;
+  height(v):=height(v)+big_op_spacing5+height(x)+depth(x)+shift_up;
+  end;
+if math_type(subscr(q))=empty then begin list_ptr(z):=null; flush_node(z); end
+else  begin shift_down:=big_op_spacing4-height(z);
+  if shift_down<big_op_spacing2 then shift_down:=big_op_spacing2;
+  p:=new_kern(shift_down); vlink(y):=p; vlink(p):=z;@/
+  p:=new_kern(big_op_spacing5); vlink(z):=p;
+  depth(v):=depth(v)+big_op_spacing5+height(z)+depth(z)+shift_down;
+  end
+
+@ A ligature found in a math formula does not create a ligature, because
+there is no question of hyphenation afterwards; the ligature will simply be
+stored in an ordinary |glyph_node|, after residing in an |ord_noad|.
+
+The |math_type| is converted to |math_text_char| here if we would not want to
+apply an italic correction to the current character unless it belongs
+to a math font (i.e., a font with |space=0|).
+
+No boundary characters enter into these ligatures.
+
+@<Declare math...@>=
+procedure make_ord(@!q:pointer);
+label restart,exit;
+var a:integer; { the left-side character for lig/kern testing }
+@!p,@!r:pointer; {temporary registers for list manipulation}
+k:scaled; { a kern }
+lig:liginfo; { a ligature }
+begin restart:@t@>@;@/
+if math_type(subscr(q))=empty then if math_type(supscr(q))=empty then
+ if math_type(nucleus(q))=math_char then
+  begin p:=vlink(q);
+  if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then
+    if math_type(nucleus(p))=math_char then
+    if fam(nucleus(p))=fam(nucleus(q)) then
+      begin math_type(nucleus(q)):=math_text_char;
+      fetch(nucleus(q)); a:=cur_c;
+      if (has_kern(cur_f,a))or(has_lig(cur_f,a)) then
+        begin cur_c:=mcharacter(nucleus(p));
+          @<If character |a| has a kern with |cur_c|, attach
+            the kern after~|q|; or if it has a ligature with |cur_c|, combine
+            noads |q| and~|p| appropriately; then |return| if the cursor has
+            moved past a noad, or |goto restart|@>;
+        end;
+      end;
+  end;
+exit:end;
+
+@ Note that a ligature between an |ord_noad| and another kind of noad
+is replaced by an |ord_noad|, when the two noads collapse into one.
+But we could make a parenthesis (say) change shape when it follows
+certain letters. Presumably a font designer will define such
+ligatures only when this convention makes sense.
+
+\chardef\?='174 % vertical line to indicate character retention
+
+@<If character |a| has a kern with |cur_c|, ...@>=
+begin
+if disable_lig=0 and has_lig(cur_f,a) then begin
+  lig:=get_ligature(cur_f,a,cur_c);
+  if is_valid_ligature(lig) then begin
+	check_interrupt; {allow a way out of infinite ligature loop}
+    case lig_type(lig) of
+    qi(1),qi(5): mcharacter(nucleus(q)):=lig_replacement(lig); {\.{=:\?}, \.{=:\?>}}
+    qi(2),qi(6): mcharacter(nucleus(p)):=lig_replacement(lig); {\.{\?=:}, \.{\?=:>}}
+    qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}}
+      mcharacter(nucleus(r)):=lig_replacement(lig);
+      fam(nucleus(r)):=fam(nucleus(q));@/
+      vlink(q):=r; vlink(r):=p;
+      if lig_type(lig)<qi(11) then math_type(nucleus(r)):=math_char
+      else math_type(nucleus(r)):=math_text_char; {prevent combination}
+      end;
+    othercases begin vlink(q):=vlink(p);
+      mcharacter(nucleus(q)):=lig_replacement(lig); {\.{=:}}
+      vmem(subscr(q)):=vmem(subscr(p)); vmem(supscr(q)):=vmem(supscr(p));@/
+      flush_node(p);
+      end
+    endcases;
+    if lig_type(lig)>qi(3) then return;
+    math_type(nucleus(q)):=math_char; goto restart;
+    end;
+  end;
+if disable_kern=0 and has_kern(cur_f,a) then begin
+  k:=get_kern(cur_f,a,cur_c);
+  if k<>0 then begin 
+    p:=new_kern(k); vlink(p):=vlink(q); vlink(q):=p; return;
+	end;
+  end;
+end
+
+@ When we get to the following part of the program, we have ``fallen through''
+from cases that did not lead to |check_dimensions| or |done_with_noad| or
+|done_with_node|. Thus, |q|~points to a noad whose nucleus may need to be
+converted to an hlist, and whose subscripts and superscripts need to be
+appended if they are present.
+
+If |nucleus(q)| is not a |math_char|, the variable |delta| is the amount
+by which a superscript should be moved right with respect to a subscript
+when both are present.
+@^subscripts@>
+@^superscripts@>
+
+@<Convert \(n)|nucleus(q)| to an hlist and attach the sub/superscripts@>=
+case math_type(nucleus(q)) of
+math_char, math_text_char:
+  @<Create a character node |p| for |nucleus(q)|, possibly followed
+  by a kern node for the italic correction, and set |delta| to the
+  italic correction if a subscript is present@>;
+empty: p:=null;
+sub_box: p:=vinfo(nucleus(q));
+sub_mlist: begin cur_mlist:=vinfo(nucleus(q)); save_style:=cur_style;
+  mlist_penalties:=false; mlist_to_hlist; {recursive call}
+@^recursion@>
+  cur_style:=save_style; @<Set up the values...@>;
+  p:=hpack(vlink(temp_head),natural);
+  end;
+othercases confusion("mlist2")
+@:this can't happen mlist2}{\quad mlist2@>
+endcases;@/
+new_hlist(q):=p;
+if (math_type(subscr(q))=empty)and(math_type(supscr(q))=empty) then
+  goto check_dimensions;
+make_scripts(q,delta)
+
+@ @<Create a character node |p| for |nucleus(q)|...@>=
+begin fetch(nucleus(q));
+if char_exists(cur_f,cur_c) then
+  begin delta:=char_italic(cur_f,cur_c); p:=new_glyph(cur_f,cur_c);
+  if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
+    delta:=0; {no italic correction in mid-word of text font}
+  if (math_type(subscr(q))=empty)and(delta<>0) then
+    begin x:=new_kern(delta); vlink(p):=x; delta:=0;
+    end;
+  end
+else p:=null;
+end
+
+@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or
+superscript of noad |q| to the list that starts at |new_hlist(q)|,
+given that subscript and superscript aren't both empty. The superscript
+will appear to the right of the subscript by a given distance |delta|.
+
+We set |shift_down| and |shift_up| to the minimum amounts to shift the
+baseline of subscripts and superscripts based on the given nucleus.
+
+@<Declare math...@>=
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
+@!t:integer; {subsidiary size code}
+begin p:=new_hlist(q);
+if is_char_node(p) then
+  begin shift_up:=0; shift_down:=0;
+  end
+else  begin z:=hpack(p,natural);
+  t:=cur_size;
+  if cur_style<script_style
+  then cur_size:=script_size@+else cur_size:=script_script_size;
+  shift_up:=height(z)-sup_drop(cur_size);
+  shift_down:=depth(z)+sub_drop(cur_size);
+  cur_size:=t;
+  list_ptr(z):=null; flush_node(z);
+  end;
+if math_type(supscr(q))=empty then
+  @<Construct a subscript box |x| when there is no superscript@>
+else  begin @<Construct a superscript box |x|@>;
+  if math_type(subscr(q))=empty then shift_amount(x):=-shift_up
+  else @<Construct a sub/superscript combination box |x|, with the
+    superscript offset by |delta|@>;
+  end;
+if new_hlist(q)=null then new_hlist(q):=x
+else  begin p:=new_hlist(q);
+  while vlink(p)<>null do p:=vlink(p);
+  vlink(p):=x;
+  end;
+end;
+
+@ When there is a subscript without a superscript, the top of the subscript
+should not exceed the baseline plus four-fifths of the x-height.
+
+@<Construct a subscript box |x| when there is no superscript@>=
+begin x:=clean_box(subscr(q),sub_style(cur_style));
+width(x):=width(x)+script_space;
+if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
+clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
+if shift_down<clr then shift_down:=clr;
+shift_amount(x):=shift_down;
+end
+
+@ The bottom of a superscript should never descend below the baseline plus
+one-fourth of the x-height.
+
+@<Construct a superscript box |x|@>=
+begin x:=clean_box(supscr(q),sup_style(cur_style));
+width(x):=width(x)+script_space;
+if odd(cur_style) then clr:=sup3(cur_size)
+else if cur_style<text_style then clr:=sup1(cur_size)
+else clr:=sup2(cur_size);
+if shift_up<clr then shift_up:=clr;
+clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
+if shift_up<clr then shift_up:=clr;
+end
+
+@ When both subscript and superscript are present, the subscript must be
+separated from the superscript by at least four times |default_rule_thickness|.
+If this condition would be violated, the subscript moves down, after which
+both subscript and superscript move up so that the bottom of the superscript
+is at least as high as the baseline plus four-fifths of the x-height.
+
+@<Construct a sub/superscript combination box |x|...@>=
+begin y:=clean_box(subscr(q),sub_style(cur_style));
+width(y):=width(y)+script_space;
+if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
+clr:=4*default_rule_thickness-
+  ((shift_up-depth(x))-(height(y)-shift_down));
+if clr>0 then
+  begin shift_down:=shift_down+clr;
+  clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
+  if clr>0 then
+    begin shift_up:=shift_up+clr;
+    shift_down:=shift_down-clr;
+    end;
+  end;
+shift_amount(x):=delta; {superscript is |delta| to the right of the subscript}
+p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); vlink(x):=p; vlink(p):=y;
+pack_direction:=math_direction;
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+end
+
+@ We have now tied up all the loose ends of the first pass of |mlist_to_hlist|.
+The second pass simply goes through and hooks everything together with the
+proper glue and penalties. It also handles the |left_noad| and |right_noad| that
+might be present, since |max_hl| and |max_d| are now known. Variable |p| points
+to a node at the current end of the final hlist.
+
+@<Make a second pass over the mlist, ...@>=
+p:=temp_head; vlink(p):=null; q:=mlist; r_type:=0; cur_style:=style;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+while q<>null do
+  begin @<If node |q| is a style node, change the style and |goto delete_q|;
+    otherwise if it is not a noad, put it into the hlist,
+    advance |q|, and |goto done|; otherwise set |s| to the size
+    of noad |q|, set |t| to the associated type (|ord_noad..
+    inner_noad|), and set |pen| to the associated penalty@>;
+  @<Append inter-element spacing based on |r_type| and |t|@>;
+  @<Append any |new_hlist| entries for |q|, and any appropriate penalties@>;
+  if type(q)=right_noad then t:=open_noad;
+  r_type:=t;
+  delete_q: r:=q; q:=vlink(q); 
+  flush_node(r); {|r| had better be a noad-like thing }
+  done: end
+
+@ Just before doing the big |case| switch in the second pass, the program
+sets up default values so that most of the branches are short.
+
+@<If node |q| is a style node, change the style...@>=
+t:=ord_noad; s:=noad_size; pen:=inf_penalty;
+case type(q) of
+op_noad,open_noad,close_noad,punct_noad,inner_noad: t:=type(q);
+bin_noad: begin t:=bin_noad; pen:=bin_op_penalty;
+  end;
+rel_noad: begin t:=rel_noad; pen:=rel_penalty;
+  end;
+ord_noad,vcenter_noad,over_noad,under_noad: do_nothing;
+radical_noad: s:=radical_noad_size;
+accent_noad: s:=accent_noad_size;
+fraction_noad: begin t:=inner_noad; s:=fraction_noad_size;
+  end;
+left_noad,right_noad: t:=make_left_right(q,style,max_d,max_hl);
+style_node: @<Change the current style and |goto delete_q|@>;
+whatsit_node,penalty_node,rule_node,disc_node,adjust_node,ins_node,mark_node,
+ glue_node,kern_node:@t@>@;@/
+  begin vlink(p):=q; p:=q; q:=vlink(q); vlink(p):=null; goto done;
+  end;
+othercases confusion("mlist3")
+@:this can't happen mlist3}{\quad mlist3@>
+endcases
+
+@ The |make_left_right| function constructs a left or right delimiter of
+the required size and returns the value |open_noad| or |close_noad|. The
+|right_noad| and |left_noad| will both be based on the original |style|,
+so they will have consistent sizes.
+
+We use the fact that |right_noad-left_noad=close_noad-open_noad|.
+
+@<Declare math...@>=
+function make_left_right(@!q:pointer;@!style:integer;
+  @!max_d,@!max_hv:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+tmp:pointer;
+begin cur_style:=style; @<Set up the values...@>;
+delta2:=max_d+axis_height(cur_size);
+delta1:=max_hv+max_d-delta2;
+if delta2>delta1 then delta1:=delta2; {|delta1| is max distance from axis}
+delta:=(delta1 div 500)*delimiter_factor;
+delta2:=delta1+delta1-delimiter_shortfall;
+if delta<delta2 then delta:=delta2;
+tmp:=var_delimiter(delimiter(q),cur_size,delta);
+new_hlist(q):=tmp; 
+make_left_right:=type(q)-(left_noad-open_noad); {|open_noad| or |close_noad|}
+end;
+
+@ @<Change the current style and |goto delete_q|@>=
+begin cur_style:=subtype(q); s:=style_node_size;
+@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+goto delete_q;
+end
+
+@ The inter-element spacing in math formulas depends on a $8\times8$ table that
+\TeX\ preloads as a 64-digit string. The elements of this string have the
+following significance:
+$$\vbox{\halign{#\hfil\cr
+\.0 means no space;\cr
+\.1 means a conditional thin space (\.{\\nonscript\\mskip\\thinmuskip});\cr
+\.2 means a thin space (\.{\\mskip\\thinmuskip});\cr
+\.3 means a conditional medium space
+  (\.{\\nonscript\\mskip\\medmuskip});\cr
+\.4 means a conditional thick space
+  (\.{\\nonscript\\mskip\\thickmuskip});\cr
+\.* means an impossible case.\cr}}$$
+This is all pretty cryptic, but {\sl The \TeX book\/} explains what is
+supposed to happen, and the string makes it happen.
+@:TeXbook}{\sl The \TeX book@>
+
+A global variable |magic_offset| is computed so that if |a| and |b| are
+in the range |ord_noad..inner_noad|, then |str_pool[a*8+b+magic_offset]|
+is the digit for spacing between noad types |a| and |b|.
+
+If \PASCAL\ had provided a good way to preload constant arrays, this part of
+the program would not have been so strange.
+@:PASCAL}{\PASCAL@>
+
+@d math_spacing=@;@/
+@t\hskip-35pt@>
+"0234000122*4000133**3**344*0400400*000000234000111*1111112341011"
+@t$ \hskip-35pt$@>
+
+@<Glob...@>=
+@!magic_offset:integer; {used to find inter-element spacing}
+
+@ @<Compute the magic offset@>=
+magic_offset:=str_start_macro(math_spacing)-9*ord_noad
+
+@ @<Append inter-element spacing based on |r_type| and |t|@>=
+if r_type>0 then {not the first noad}
+  begin case so(str_pool[r_type*8+t+magic_offset]) of
+  "0": x:=0;
+  "1": if cur_style<script_style then x:=thin_mu_skip_code@+else x:=0;
+  "2": x:=thin_mu_skip_code;
+  "3": if cur_style<script_style then x:=med_mu_skip_code@+else x:=0;
+  "4": if cur_style<script_style then x:=thick_mu_skip_code@+else x:=0;
+  othercases confusion("mlist4")
+@:this can't happen mlist4}{\quad mlist4@>
+  endcases;
+  if x<>0 then
+    begin y:=math_glue(glue_par(x),cur_mu);
+    z:=new_glue(y); glue_ref_count(y):=null; vlink(p):=z; p:=z;@/
+    subtype(z):=x+1; {store a symbolic subtype}
+    end;
+  end
+
+@ We insert a penalty node after the hlist entries of noad |q| if |pen|
+is not an ``infinite'' penalty, and if the node immediately following |q|
+is not a penalty node or a |rel_noad| or absent entirely.
+
+@<Append any |new_hlist| entries for |q|, and any appropriate penalties@>=
+if new_hlist(q)<>null then
+  begin vlink(p):=new_hlist(q);
+  repeat p:=vlink(p);
+  until vlink(p)=null;
+  end;
+if penalties then if vlink(q)<>null then if pen<inf_penalty then
+  begin r_type:=type(vlink(q));
+  if r_type<>penalty_node then if r_type<>rel_noad then
+    begin z:=new_penalty(pen); vlink(p):=z; p:=z;
+    end;
+  end
+
+@* \[37] Alignment.
+It's sort of a miracle whenever \.{\\halign} and \.{\\valign} work, because
+they cut across so many of the control structures of \TeX.
+
+Therefore the
+present page is probably not the best place for a beginner to start reading
+this program; it is better to master everything else first.
+
+Let us focus our thoughts on an example of what the input might be, in order
+to get some idea about how the alignment miracle happens. The example doesn't
+do anything useful, but it is sufficiently general to indicate all of the
+special cases that must be dealt with; please do not be disturbed by its
+apparent complexity and meaninglessness.
+$$\vbox{\halign{\.{#}\hfil\cr
+{}\\tabskip 2pt plus 3pt\cr
+{}\\halign to 300pt\{u1\#v1\&\cr
+\hskip 50pt\\tabskip 1pt plus 1fil u2\#v2\&\cr
+\hskip 50pt u3\#v3\\cr\cr
+\hskip 25pt a1\&\\omit a2\&\\vrule\\cr\cr
+\hskip 25pt \\noalign\{\\vskip 3pt\}\cr
+\hskip 25pt b1\\span b2\\cr\cr
+\hskip 25pt \\omit\&c2\\span\\omit\\cr\}\cr}}$$
+Here's what happens:
+
+\yskip
+(0) When `\.{\\halign to 300pt\{}' is scanned, the |scan_spec| routine
+places the 300pt dimension onto the |save_stack|, and an |align_group|
+code is placed above it. This will make it possible to complete the alignment
+when the matching `\.\}' is found.
+
+(1) The preamble is scanned next. Macros in the preamble are not expanded,
+@^preamble@>
+except as part of a tabskip specification. For example, if \.{u2} had been
+a macro in the preamble above, it would have been expanded, since \TeX\
+must look for `\.{minus...}' as part of the tabskip glue. A ``preamble list''
+is constructed based on the user's preamble; in our case it contains the
+following seven items:
+$$\vbox{\halign{\.{#}\hfil\qquad&(#)\hfil\cr
+{}\\glue 2pt plus 3pt&the tabskip preceding column 1\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 1\cr
+{}\\glue 2pt plus 3pt&the tabskip between columns 1 and 2\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 2\cr
+{}\\glue 1pt plus 1fil&the tabskip between columns 2 and 3\cr
+{}\\alignrecord, width $-\infty$&preamble info for column 3\cr
+{}\\glue 1pt plus 1fil&the tabskip following column 3\cr}}$$
+These ``alignrecord'' entries have the same size as an |unset_node|,
+since they will later be converted into such nodes. These alignrecord
+nodes have no |depth| field; this is split into |u_part| and |v_part|,
+and they point to token lists for the templates of the alignment. For
+example, the |u_part| field in the first alignrecord points to the
+token list `\.{u1}', i.e., the template preceding the `\.\#' for
+column~1.  Furthermore, They have a |span_ptr| instead of a |node_attr|
+field, and these |span_ptr| fields are initially set to the value
+|end_span|, for reasons explained below.
+
+(2) \TeX\ now looks at what follows the \.{\\cr} that ended the preamble.
+It is not `\.{\\noalign}' or `\.{\\omit}', so this input is put back to
+be read again, and the template `\.{u1}' is fed to the scanner. Just
+before reading `\.{u1}', \TeX\ goes into restricted horizontal mode.
+Just after reading `\.{u1}', \TeX\ will see `\.{a1}', and then (when the
+{\.\&} is sensed) \TeX\ will see `\.{v1}'. Then \TeX\ scans an |endv|
+token, indicating the end of a column. At this point an |unset_node| is
+created, containing the contents of the current hlist (i.e., `\.{u1a1v1}').
+The natural width of this unset node replaces the |width| field of the
+alignrecord for column~1; in general, the alignrecords will record the
+maximum natural width that has occurred so far in a given column.
+
+(3) Since `\.{\\omit}' follows the `\.\&', the templates for column~2
+are now bypassed. Again \TeX\ goes into restricted horizontal mode and
+makes an |unset_node| from the resulting hlist; but this time the
+hlist contains simply `\.{a2}'. The natural width of the new unset box
+is remembered in the |width| field of the alignrecord for column~2.
+
+(4) A third |unset_node| is created for column 3, using essentially the
+mechanism that worked for column~1; this unset box contains `\.{u3\\vrule
+v3}'. The vertical rule in this case has running dimensions that will later
+extend to the height and depth of the whole first row, since each |unset_node|
+in a row will eventually inherit the height and depth of its enclosing box.
+
+(5) The first row has now ended; it is made into a single unset box
+comprising the following seven items:
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: u1a1v1\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: a2\cr
+{}\\glue 1pt plus 1fil\cr
+{}\\unsetbox for 1 column: u3\\vrule v3\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+The width of this unset row is unimportant, but it has the correct height
+and depth, so the correct baselineskip glue will be computed as the row
+is inserted into a vertical list.
+
+(6) Since `\.{\\noalign}' follows the current \.{\\cr}, \TeX\ appends
+additional material (in this case \.{\\vskip 3pt}) to the vertical list.
+While processing this material, \TeX\ will be in internal vertical
+mode, and |no_align_group| will be on |save_stack|.
+
+(7) The next row produces an unset box that looks like this:
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 2 columns: u1b1v1u2b2v2\cr
+{}\\glue 1pt plus 1fil\cr
+{}\\unsetbox for 1 column: {\rm(empty)}\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+The natural width of the unset box that spans columns 1~and~2 is stored
+in a ``span node,'' which we will explain later; the |span_ptr| field of the
+alignrecord for column~1 now points to the new span node, and the |span_ptr|
+of the span node points to |end_span|.
+
+(8) The final row produces the unset box
+$$\vbox{\halign{\hbox to 325pt{\qquad\.{#}\hfil}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 1 column: {\rm(empty)}\cr
+{}\\glue 2pt plus 3pt\cr
+{}\\unsetbox for 2 columns: u2c2v2\cr
+{}\\glue 1pt plus 1fil\cr}}$$
+A new span node is attached to the alignrecord for column 2.
+
+(9) The last step is to compute the true column widths and to change all the
+unset boxes to hboxes, appending the whole works to the vertical list that
+encloses the \.{\\halign}. The rules for deciding on the final widths of
+each unset column box will be explained below.
+
+\yskip\noindent
+Note that as \.{\\halign} is being processed, we fearlessly give up control
+to the rest of \TeX. At critical junctures, an alignment routine is
+called upon to step in and do some little action, but most of the time
+these routines just lurk in the background. It's something like
+post-hypnotic suggestion.
+
+@ We have mentioned that alignrecords contain no |height| or |depth| fields.
+Their |glue_sign| and |glue_order| are pre-empted as well, since it
+is necessary to store information about what to do when a template ends.
+This information is called the |extra_info| field.
+
+@d align_record_node=34
+@d u_part(#)==vlink(#+depth_offset) {pointer to \<u_j> token list}
+@d v_part(#)==vinfo(#+depth_offset) {pointer to \<v_j> token list}
+@d span_ptr(#)==vinfo(#+1) {column spanning list}
+@d extra_info(#)==vinfo(#+list_offset) {info to remember during template}
+
+@ Alignments can occur within alignments, so a small stack is used to access
+the alignrecord information. At each level we have a |preamble| pointer,
+indicating the beginning of the preamble list; a |cur_align| pointer,
+indicating the current position in the preamble list; a |cur_span| pointer,
+indicating the value of |cur_align| at the beginning of a sequence of
+spanned columns; a |cur_loop| pointer, indicating the tabskip glue before
+an alignrecord that should be copied next if the current list is extended;
+and the |align_state| variable, which indicates the nesting of braces so
+that \.{\\cr} and \.{\\span} and tab marks are properly intercepted.
+There also are pointers |cur_head| and |cur_tail| to the head and tail
+of a list of adjustments being moved out from horizontal mode to
+vertical~mode, and alike |cur_pre_head| and |cur_pre_tail| for pre-adjust 
+lists.
+
+The current values of these nine quantities appear in global variables;
+when they have to be pushed down, they are stored in 6-word nodes, and
+|align_ptr| points to the topmost such node.
+
+@d preamble==vlink(align_head) {the current preamble list}
+@d align_stack_node=47 
+
+@<Glob...@>=
+@!cur_align:pointer; {current position in preamble list}
+@!cur_span:pointer; {start of currently spanned columns in preamble list}
+@!cur_loop:pointer; {place to copy when extending a periodic preamble}
+@!align_ptr:pointer; {most recently pushed-down alignment stack node}
+@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
+@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
+
+@ The |align_state| and |preamble| variables are initialized elsewhere.
+
+@<Set init...@>=
+align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null;
+cur_head:=null; cur_tail:=null;
+cur_pre_head:=null; cur_pre_tail:=null;
+
+@ Alignment stack maintenance is handled by a pair of trivial routines
+called |push_alignment| and |pop_alignment|.
+
+@p procedure push_alignment;
+var p:pointer; {the new alignment stack node}
+begin p:=new_node(align_stack_node,0);
+vinfo(p+1):=align_ptr;       vlink(p+1):=cur_align;
+vinfo(p+2):=preamble;        vlink(p+2):=cur_span;
+vinfo(p+3):=cur_loop;        vlink(p+3):=align_state;
+vinfo(p+4):=cur_head;        vlink(p+4):=cur_tail;
+vinfo(p+5):=cur_pre_head;    vlink(p+5):=cur_pre_tail;
+align_ptr:=p;
+cur_head:=new_node(temp_node,0);
+end;
+@#
+procedure pop_alignment;
+var p:pointer; {the top alignment stack node}
+begin flush_node(cur_head); 
+p:=align_ptr;
+cur_pre_tail:=vlink(p+5); cur_pre_head:=vinfo(p+5);
+cur_tail    :=vlink(p+4); cur_head    :=vinfo(p+4);
+align_state :=vlink(p+3); cur_loop    :=vinfo(p+3);
+cur_span    :=vlink(p+2); preamble    :=vinfo(p+2);
+cur_align   :=vlink(p+1); align_ptr   :=vinfo(p+1);
+flush_node(p);
+end;
+
+@ \TeX\ has eight procedures that govern alignments: |init_align| and
+|fin_align| are used at the very beginning and the very end; |init_row| and
+|fin_row| are used at the beginning and end of individual rows; |init_span|
+is used at the beginning of a sequence of spanned columns (possibly involving
+only one column); |init_col| and |fin_col| are used at the beginning and
+end of individual columns; and |align_peek| is used after \.{\\cr} to see
+whether the next item is \.{\\noalign}.
+
+We shall consider these routines in the order they are first used during
+the course of a complete \.{\\halign}, namely |init_align|, |align_peek|,
+|init_row|, |init_span|, |init_col|, |fin_col|, |fin_row|, |fin_align|.
+
+@ When \.{\\halign} or \.{\\valign} has been scanned in an appropriate
+mode, \TeX\ calls |init_align|, whose task is to get everything off to a
+good start. This mostly involves scanning the preamble and putting its
+information into the preamble list.
+@^preamble@>
+
+@p @t\4@>@<Declare the procedure called |get_preamble_token|@>@t@>@/
+procedure@?align_peek; forward;@t\2@>@/
+procedure@?normal_paragraph; forward;@t\2@>@/
+procedure init_align;
+label done, done1, done2, continue;
+var save_cs_ptr:pointer; {|warning_index| value for error messages}
+@!p,r:pointer; {for short-term temporary use}
+begin save_cs_ptr:=cur_cs; {\.{\\halign} or \.{\\valign}, usually}
+push_alignment; align_state:=-1000000; {enter a new alignment level}
+@<Check for improper alignment in displayed math@>;
+push_nest; {enter a new semantic level}
+@<Change current mode to |-vmode| for \.{\\halign}, |-hmode| for \.{\\valign}@>;
+scan_spec(align_group,false);@/
+@<Scan the preamble and record it in the |preamble| list@>;
+new_save_level(align_group);
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+align_peek; {look for \.{\\noalign} or \.{\\omit}}
+end;
+
+@ In vertical modes, |prev_depth| already has the correct value. But
+if we are in |mmode| (displayed formula mode), we reach out to the
+enclosing vertical mode for the |prev_depth| value that produces the
+correct baseline calculations.
+
+@<Change current mode...@>=
+if mode=mmode then
+  begin mode:=-vmode; prev_depth:=nest[nest_ptr-2].aux_field.sc;
+  end
+else if mode>0 then negate(mode)
+
+@ When \.{\\halign} is used as a displayed formula, there should be
+no other pieces of mlists present.
+
+@<Check for improper alignment in displayed math@>=
+if (mode=mmode)and((tail<>head)or(incompleat_noad<>null)) then
+  begin print_err("Improper "); print_esc("halign"); print(" inside $$'s");
+@.Improper \\halign...@>
+  help3("Displays can use special alignments (like \eqalignno)")@/
+  ("only if nothing but the alignment itself is between $$'s.")@/
+  ("So I've deleted the formulas that preceded this alignment.");
+  error; flush_math;
+  end
+
+@ @<Scan the preamble and record it in the |preamble| list@>=
+preamble:=null; cur_align:=align_head; cur_loop:=null; scanner_status:=aligning;
+warning_index:=save_cs_ptr; align_state:=-1000000;
+  {at this point, |cur_cmd=left_brace|}
+loop@+  begin @<Append the current tabskip glue to the preamble list@>;
+  if cur_cmd=car_ret then goto done; {\.{\\cr} ends the preamble}
+  @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|,
+    looking for changes in the tabskip glue; append an
+    alignrecord to the preamble list@>;
+  end;
+done: scanner_status:=normal
+
+@ @<Append the current tabskip glue to the preamble list@>=
+r:=new_param_glue(tab_skip_code); vlink(cur_align):=r;
+cur_align:=vlink(cur_align)
+
+@ @<Scan preamble text until |cur_cmd| is |tab_mark| or |car_ret|...@>=
+@<Scan the template \<u_j>, putting the resulting token list in |hold_token_head|@>;
+r:=new_node(align_record_node,0); vlink(cur_align):=r;
+cur_align:=vlink(cur_align); {a new alignrecord}
+span_ptr(cur_align):=end_span; width(cur_align):=null_flag;
+u_part(cur_align):=link(hold_token_head);
+@<Scan the template \<v_j>, putting the resulting token list in |hold_token_head|@>;
+v_part(cur_align):=link(hold_token_head)
+
+@ We enter `\.{\\span}' into |eqtb| with |tab_mark| as its command code,
+and with |span_code| as the command modifier. This makes \TeX\ interpret it
+essentially the same as an alignment delimiter like `\.\&', yet it is
+recognizably different when we need to distinguish it from a normal delimiter.
+It also turns out to be useful to give a special |cr_code| to `\.{\\cr}',
+and an even larger |cr_cr_code| to `\.{\\crcr}'.
+
+The end of a template is represented by two ``frozen'' control sequences
+called \.{\\endtemplate}. The first has the command code |end_template|, which
+is |>outer_call|, so it will not easily disappear in the presence of errors.
+The |get_x_token| routine converts the first into the second, which has |endv|
+as its command code.
+
+@d span_code=special_char {distinct from any character}
+@d cr_code=span_code+1 {distinct from |span_code| and from any character}
+@d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}}
+@d end_template_token==cs_token_flag+frozen_end_template
+
+@<Put each of \TeX's primitives into the hash table@>=
+primitive("span",tab_mark,span_code);@/
+@!@:span_}{\.{\\span} primitive@>
+primitive("cr",car_ret,cr_code);
+@!@:cr_}{\.{\\cr} primitive@>
+text(frozen_cr):="cr"; eqtb[frozen_cr]:=eqtb[cur_val];@/
+primitive("crcr",car_ret,cr_cr_code);
+@!@:cr_cr_}{\.{\\crcr} primitive@>
+text(frozen_end_template):="endtemplate"; text(frozen_endv):="endtemplate";
+eq_type(frozen_endv):=endv; equiv(frozen_endv):=null_list;
+eq_level(frozen_endv):=level_one;@/
+eqtb[frozen_end_template]:=eqtb[frozen_endv];
+eq_type(frozen_end_template):=end_template;
+
+@ @<Cases of |print_cmd_chr|...@>=
+tab_mark: if chr_code=span_code then print_esc("span")
+  else chr_cmd("alignment tab character ");
+car_ret: if chr_code=cr_code then print_esc("cr")
+  else print_esc("crcr");
+
+@ The preamble is copied directly, except that \.{\\tabskip} causes a change
+to the tabskip glue, thereby possibly expanding macros that immediately
+follow it. An appearance of \.{\\span} also causes such an expansion.
+
+Note that if the preamble contains `\.{\\global\\tabskip}', the `\.{\\global}'
+token survives in the preamble and the `\.{\\tabskip}' defines new
+tabskip glue (locally).
+
+@<Declare the procedure called |get_preamble_token|@>=
+procedure get_preamble_token;
+label restart;
+begin restart: get_token;
+while (cur_chr=span_code)and(cur_cmd=tab_mark) do
+  begin get_token; {this token will be expanded once}
+  if cur_cmd>max_command then
+    begin expand; get_token;
+    end;
+  end;
+if cur_cmd=endv then
+  fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+if (cur_cmd=assign_glue)and(cur_chr=glue_base+tab_skip_code) then
+  begin scan_optional_equals; scan_glue(glue_val);
+  if global_defs>0 then geq_define(glue_base+tab_skip_code,glue_ref,cur_val)
+  else eq_define(glue_base+tab_skip_code,glue_ref,cur_val);
+  goto restart;
+  end;
+end;
+
+@ Spaces are eliminated from the beginning of a template.
+
+@<Scan the template \<u_j>...@>=
+p:=hold_token_head; link(p):=null;
+loop@+  begin get_preamble_token;
+  if cur_cmd=mac_param then goto done1;
+  if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
+   if (p=hold_token_head)and(cur_loop=null)and(cur_cmd=tab_mark)
+    then cur_loop:=cur_align
+   else  begin print_err("Missing # inserted in alignment preamble");
+@.Missing \# inserted...@>
+    help3("There should be exactly one # between &'s, when an")@/
+    ("\halign or \valign is being set up. In this case you had")@/
+    ("none, so I've put one in; maybe that will work.");
+    back_error; goto done1;
+    end
+  else if (cur_cmd<>spacer)or(p<>hold_token_head) then
+    begin r:=get_avail; link(p):=r; p:=link(p); info(p):=cur_tok;
+    end;
+  end;
+done1:
+
+@ @<Scan the template \<v_j>...@>=
+p:=hold_token_head; link(p):=null;
+loop@+  begin continue: get_preamble_token;
+  if (cur_cmd<=car_ret)and(cur_cmd>=tab_mark)and(align_state=-1000000) then
+    goto done2;
+  if cur_cmd=mac_param then
+    begin print_err("Only one # is allowed per tab");
+@.Only one \# is allowed...@>
+    help3("There should be exactly one # between &'s, when an")@/
+    ("\halign or \valign is being set up. In this case you had")@/
+    ("more than one, so I'm ignoring all but the first.");
+    error; goto continue;
+    end;
+  r:=get_avail; link(p):=r; p:=link(p); info(p):=cur_tok;
+  end;
+done2: r:=get_avail; link(p):=r; p:=link(p);
+info(p):=end_template_token {put \.{\\endtemplate} at the end}
+
+@ The tricky part about alignments is getting the templates into the
+scanner at the right time, and recovering control when a row or column
+is finished.
+
+We usually begin a row after each \.{\\cr} has been sensed, unless that
+\.{\\cr} is followed by \.{\\noalign} or by the right brace that terminates
+the alignment. The |align_peek| routine is used to look ahead and do
+the right thing; it either gets a new row started, or gets a \.{\\noalign}
+started, or finishes off the alignment.
+
+@<Declare the procedure called |align_peek|@>=
+procedure align_peek;
+label restart;
+begin restart: align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+if cur_cmd=no_align then
+  begin scan_left_brace; new_save_level(no_align_group);
+  if mode=-vmode then normal_paragraph;
+  end
+else if cur_cmd=right_brace then fin_align
+else if (cur_cmd=car_ret)and(cur_chr=cr_cr_code) then
+  goto restart {ignore \.{\\crcr}}
+else  begin init_row; {start a new row}
+  init_col; {start a new column and replace what we peeked at}
+  end;
+end;
+
+@ To start a row (i.e., a `row' that rhymes with `dough' but not with `bough'),
+we enter a new semantic level, copy the first tabskip glue, and change
+from internal vertical mode to restricted horizontal mode or vice versa.
+The |space_factor| and |prev_depth| are not used on this semantic level,
+but we clear them to zero just to be tidy.
+
+@p @t\4@>@<Declare the procedure called |init_span|@>@t@>@/
+procedure init_row;
+begin push_nest; mode:=(-hmode-vmode)-mode;
+if mode=-hmode then space_factor:=0 @+else prev_depth:=0;
+tail_append(new_glue(glue_ptr(preamble)));
+subtype(tail):=tab_skip_code+1;@/
+cur_align:=vlink(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
+init_span(cur_align);
+end;
+
+@ The parameter to |init_span| is a pointer to the alignrecord where the
+next column or group of columns will begin. A new semantic level is
+entered, so that the columns will generate a list for subsequent packaging.
+
+@<Declare the procedure called |init_span|@>=
+procedure init_span(@!p:pointer);
+begin push_nest;
+if mode=-hmode then space_factor:=1000
+else  begin prev_depth:=ignore_depth; normal_paragraph;
+  end;
+cur_span:=p;
+end;
+
+@ When a column begins, we assume that |cur_cmd| is either |omit| or else
+the current token should be put back into the input until the \<u_j>
+template has been scanned.  (Note that |cur_cmd| might be |tab_mark| or
+|car_ret|.)  We also assume that |align_state| is approximately 1000000 at
+this time.  We remain in the same mode, and start the template if it is
+called for.
+
+@p procedure init_col;
+begin extra_info(cur_align):=cur_cmd;
+if cur_cmd=omit then align_state:=0
+else  begin back_input; begin_token_list(u_part(cur_align),u_template);
+  end; {now |align_state=1000000|}
+end;
+
+@ The scanner sets |align_state| to zero when the \<u_j> template ends. When
+a subsequent \.{\\cr} or \.{\\span} or tab mark occurs with |align_state=0|,
+the scanner activates the following code, which fires up the \<v_j> template.
+We need to remember the |cur_chr|, which is either |cr_cr_code|, |cr_code|,
+|span_code|, or a character code, depending on how the column text has ended.
+
+This part of the program had better not be activated when the preamble
+to another alignment is being scanned, or when no alignment preamble is active.
+
+@p procedure insert_vj_template;
+begin if (scanner_status=aligning) or (cur_align=null) then
+  fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+cur_cmd:=extra_info(cur_align); extra_info(cur_align):=cur_chr;
+if cur_cmd=omit then begin_token_list(omit_template,v_template)
+else begin_token_list(v_part(cur_align),v_template);
+align_state:=1000000;
+end;
+
+@ The token list |omit_template| just referred to is a constant token
+list that contains the special control sequence \.{\\endtemplate} only.
+
+@<Initialize the special...@>=
+info(omit_template):=end_template_token; {|link(omit_template)=null|}
+
+@ When the |endv| command at the end of a \<v_j> template comes through the
+scanner, things really start to happen; and it is the |fin_col| routine
+that makes them happen. This routine returns |true| if a row as well as a
+column has been finished.
+
+@p function fin_col:boolean;
+label exit;
+var p:pointer; {the alignrecord after the current one}
+@!q,@!r:pointer; {temporary pointers for list manipulation}
+@!s:pointer; {a new span node}
+@!u:pointer; {a new unset box}
+@!w:scaled; {natural width}
+@!o:glue_ord; {order of infinity}
+@!n:halfword; {span counter}
+begin if cur_align=null then confusion("endv");
+q:=vlink(cur_align);@+if q=null then confusion("endv");
+@:this can't happen endv}{\quad endv@>
+if align_state<500000 then
+  fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+p:=vlink(q);
+@<If the preamble list has been traversed, check that the row has ended@>;
+if extra_info(cur_align)<>span_code then
+  begin unsave; new_save_level(align_group);@/
+  @<Package an unset box for the current column and record its width@>;
+  @<Copy the tabskip glue between columns@>;
+  if extra_info(cur_align)>=cr_code then
+    begin fin_col:=true; return;
+    end;
+  init_span(p);
+  end;
+align_state:=1000000;
+repeat get_x_or_protected;
+until cur_cmd<>spacer;
+cur_align:=p;
+init_col; fin_col:=false;
+exit: end;
+
+@ @<If the preamble list has been traversed, check that the row has ended@>=
+if (p=null)and(extra_info(cur_align)<cr_code) then
+ if cur_loop<>null then @<Lengthen the preamble periodically@>
+ else  begin print_err("Extra alignment tab has been changed to ");
+@.Extra alignment tab...@>
+  print_esc("cr");
+  help3("You have given more \span or & marks than there were")@/
+  ("in the preamble to the \halign or \valign now in progress.")@/
+  ("So I'll assume that you meant to type \cr instead.");
+  extra_info(cur_align):=cr_code; error;
+  end
+
+@ @<Lengthen the preamble...@>=
+begin r:=new_node(align_record_node,0); vlink(q):=r; p:=vlink(q); {a new alignrecord}
+span_ptr(p):=end_span; width(p):=null_flag; cur_loop:=vlink(cur_loop);
+@<Copy the templates from node |cur_loop| into node |p|@>;
+cur_loop:=vlink(cur_loop);
+r:=new_glue(glue_ptr(cur_loop)); vlink(p):=r;
+end
+
+@ @<Copy the templates from node |cur_loop| into node |p|@>=
+q:=hold_token_head; r:=u_part(cur_loop);
+while r<>null do
+  begin s:=get_avail; link(q):=s; q:=link(q); info(q):=info(r); r:=link(r);
+  end;
+link(q):=null; u_part(p):=link(hold_token_head);
+q:=hold_token_head; r:=v_part(cur_loop);
+while r<>null do
+  begin s:=get_avail; link(q):=s; q:=link(q); info(q):=info(r); r:=link(r);
+  end;
+link(q):=null; v_part(p):=link(hold_token_head)
+
+@ @<Copy the tabskip glue...@>=
+tail_append(new_glue(glue_ptr(vlink(cur_align))));
+subtype(tail):=tab_skip_code+1
+
+@ @<Package an unset...@>=
+begin if mode=-hmode then
+  begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
+  u:=filtered_hpack(head,tail,natural,align_set_group); w:=width(u);
+  cur_tail:=adjust_tail; adjust_tail:=null;
+  cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
+  end
+else  begin u:=filtered_vpackage(vlink(head),natural,0,align_set_group); w:=height(u);
+  end;
+n:=min_quarterword; {this represents a span count of 1}
+if cur_span<>cur_align then @<Update width entry for spanned columns@>
+else if w>width(cur_align) then width(cur_align):=w;
+type(u):=unset_node; span_count(u):=n;@/
+@<Determine the stretch order@>;
+glue_order(u):=o; glue_stretch(u):=total_stretch[o];@/
+@<Determine the shrink order@>;
+glue_sign(u):=o; glue_shrink(u):=total_shrink[o];@/
+pop_nest; vlink(tail):=u; tail:=u;
+end
+
+@ A span node is a 3-word record containing |width|, |span_span|, and
+|span_ptr| fields. The |span_span| field indicates the number of
+spanned columns; the |span_ptr| field points to a span node for the same
+starting column, having a greater extent of spanning, or to
+|end_span|, which has the largest possible |span_span| field; the |width|
+field holds the largest natural width corresponding to a particular
+set of spanned columns.
+
+A list of the maximum widths so far, for spanned columns starting at a
+given column, begins with the |span_ptr| field of the alignrecord for
+that column. The code has to make sure that there is room for
+|span_ptr| in both the alignrecord and the span nodes, which is why
+|span_ptr| replaces |node_attr|.
+@^data structure assumptions@>
+
+The |new_span_node| function is defined in |texnodes.c|.
+
+@d span_node==41
+@d span_node_size==3 {number of |mem| words for a span node}
+@d span_span(#)==vlink(#+1) {that is normally |alink| }
+
+@<Initialize the special list heads...@>=
+span_span(end_span):=max_quarterword+1; span_ptr(end_span):=null;
+
+@ @<Update width entry for spanned columns@>=
+begin q:=cur_span;
+repeat incr(n); q:=vlink(vlink(q));
+until q=cur_align;
+if n>max_quarterword then confusion("too many spans"); {this can happen, but won't}
+@^system dependencies@>
+@:this can't happen too many spans}{\quad too many spans@>
+q:=cur_span;
+while span_span(span_ptr(q))<n do begin 
+  q:=span_ptr(q);
+  end;
+if span_span(span_ptr(q))>n then begin
+  s:=new_span_node(span_ptr(q),n,w); 
+  span_ptr(q):=s; 
+  end
+else if width(span_ptr(q))<w then width(span_ptr(q)):=w;
+end
+
+@ At the end of a row, we append an unset box to the current vlist (for
+\.{\\halign}) or the current hlist (for \.{\\valign}). This unset box
+contains the unset boxes for the columns, separated by the tabskip glue.
+Everything will be set later.
+
+@p procedure fin_row;
+var p:pointer; {the new unset box}
+begin if mode=-hmode then
+  begin p:=filtered_hpack(head,tail,natural,fin_row_group);
+  pop_nest;
+  if cur_pre_head <> cur_pre_tail then
+      append_list(cur_pre_head)(cur_pre_tail);
+  append_to_vlist(p);
+  if cur_head <> cur_tail then
+      append_list(cur_head)(cur_tail);
+  end
+else  begin p:=filtered_vpackage(vlink(head),natural,max_depth,fin_row_group); 
+  pop_nest; vlink(tail):=p; tail:=p; space_factor:=1000;
+  end;
+type(p):=unset_node; glue_stretch(p):=0;
+if every_cr<>null then begin_token_list(every_cr,every_cr_text);
+align_peek;
+end; {note that |glue_shrink(p)=0| since |glue_shrink==shift_amount|}
+
+@ Finally, we will reach the end of the alignment, and we can breathe a
+sigh of relief that memory hasn't overflowed. All the unset boxes will now be
+set so that the columns line up, taking due account of spanned columns.
+
+@p procedure@?do_assignments; forward;@t\2@>@/
+procedure@?resume_after_display; forward;@t\2@>@/
+procedure@?build_page; forward;@t\2@>@/
+procedure fin_align;
+var @!p,@!q,@!r,@!s,@!u,@!v,@!rr: pointer; {registers for the list operations}
+@!t,@!w:scaled; {width of column}
+@!o:scaled; {shift offset for unset boxes}
+@!n:halfword; {matching span amount}
+@!rule_save:scaled; {temporary storage for |overfull_rule|}
+@!aux_save:memory_word; {temporary storage for |aux|}
+begin if cur_group<>align_group then confusion("align1");
+@:this can't happen align}{\quad align@>
+unsave; {that |align_group| was for individual entries}
+if cur_group<>align_group then confusion("align0");
+unsave; {that |align_group| was for the whole alignment}
+if nest[nest_ptr-1].mode_field=mmode then o:=display_indent
+  else o:=0;
+@<Go through the preamble list, determining the column widths and
+  changing the alignrecords to dummy unset boxes@>;
+@<Package the preamble list, to determine the actual tabskip glue amounts,
+  and let |p| point to this prototype box@>;
+@<Set the glue in all the unset boxes of the current list@>;
+flush_node_list(p); pop_alignment;
+@<Insert the \(c)current list into its environment@>;
+end;@/
+@t\4@>@<Declare the procedure called |align_peek|@>
+
+@ It's time now to dismantle the preamble list and to compute the column
+widths. Let $w_{ij}$ be the maximum of the natural widths of all entries
+that span columns $i$ through $j$, inclusive. The alignrecord for column~$i$
+contains $w_{ii}$ in its |width| field, and there is also a linked list of
+the nonzero $w_{ij}$ for increasing $j$, accessible via the |info| field;
+these span nodes contain the value $j-i-1+|min_quarterword|$ in their
+|link| fields. The values of $w_{ii}$ were initialized to |null_flag|, which
+we regard as $-\infty$.
+
+The final column widths are defined by the formula
+$$w_j=\max_{1\L i\L j}\biggl( w_{ij}-\sum_{i\L k<j}(t_k+w_k)\biggr),$$
+where $t_k$ is the natural width of the tabskip glue between columns
+$k$ and~$k+1$. However, if $w_{ij}=-\infty$ for all |i| in the range
+|1<=i<=j| (i.e., if every entry that involved column~|j| also involved
+column~|j+1|), we let $w_j=0$, and we zero out the tabskip glue after
+column~|j|.
+
+\TeX\ computes these values by using the following scheme: First $w_1=w_{11}$.
+Then replace $w_{2j}$ by $\max(w_{2j},w_{1j}-t_1-w_1)$, for all $j>1$.
+Then $w_2=w_{22}$. Then replace $w_{3j}$ by $\max(w_{3j},w_{2j}-t_2-w_2)$
+for all $j>2$; and so on. If any $w_j$ turns out to be $-\infty$, its
+value is changed to zero and so is the next tabskip.
+
+@<Go through the preamble list,...@>=
+q:=vlink(preamble);
+repeat flush_list(u_part(q)); flush_list(v_part(q));
+p:=vlink(vlink(q));
+if width(q)=null_flag then
+  @<Nullify |width(q)| and the tabskip glue following this column@>;
+if span_ptr(q)<>end_span then
+  @<Merge the widths in the span nodes of |q| with those of |p|,
+    destroying the span nodes of |q|@>;
+type(q):=unset_node; span_count(q):=min_quarterword; height(q):=0;
+depth(q):=0; glue_order(q):=normal; glue_sign(q):=normal;
+glue_stretch(q):=0; glue_shrink(q):=0; q:=p;
+until q=null
+
+@ @<Nullify |width(q)| and the tabskip glue following this column@>=
+begin width(q):=0; r:=vlink(q); s:=glue_ptr(r);
+if s<>zero_glue then
+  begin add_glue_ref(zero_glue); delete_glue_ref(s);
+  glue_ptr(r):=zero_glue;
+  end;
+end
+
+@ Merging of two span-node lists is a typical exercise in the manipulation of
+linearly linked data structures. The essential invariant in the following
+|repeat| loop is that we want to dispense with node |r|, in |q|'s list,
+and |u| is its successor; all nodes of |p|'s list up to and including |s|
+have been processed, and the successor of |s| matches |r| or precedes |r|
+or follows |r|, according as |link(r)=n| or |link(r)>n| or |link(r)<n|.
+
+@<Merge the widths...@>=
+begin t:=width(q)+width(glue_ptr(vlink(q)));
+r:=span_ptr(q); s:=end_span; span_ptr(s):=p; n:=min_quarterword+1;
+repeat width(r):=width(r)-t; u:=span_ptr(r);
+while span_span(r)>n do
+  begin s:=span_ptr(s); n:=span_span(span_ptr(s))+1;
+  end;
+if span_span(r)<n then
+  begin span_ptr(r):=span_ptr(s); span_ptr(s):=r; decr(span_span(r)); s:=r;
+  end
+else  begin if width(r)>width(span_ptr(s)) then width(span_ptr(s)):=width(r);
+  flush_node(r);
+  end;
+r:=u;
+until r=end_span;
+end
+
+@ Now the preamble list has been converted to a list of alternating unset
+boxes and tabskip glue, where the box widths are equal to the final
+column sizes. In case of \.{\\valign}, we change the widths to heights,
+so that a correct error message will be produced if the alignment is
+overfull or underfull.
+
+@<Package the preamble list...@>=
+save_ptr:=save_ptr-2; pack_begin_line:=-mode_line;
+if mode=-vmode then
+  begin rule_save:=overfull_rule;
+  overfull_rule:=0; {prevent rule from being packaged}
+  p:=hpack(preamble,saved(1),saved(0)); 
+  overfull_rule:=rule_save;
+  end
+else  begin q:=vlink(preamble);
+  repeat height(q):=width(q); width(q):=0; q:=vlink(vlink(q));
+  until q=null;
+  p:=filtered_vpackage(preamble,saved(1),saved(0),max_depth,preamble_group);
+  q:=vlink(preamble);
+  repeat width(q):=height(q); height(q):=0; q:=vlink(vlink(q));
+  until q=null;
+  end;
+pack_begin_line:=0
+
+@ @<Set the glue in all the unset...@>=
+q:=vlink(head); s:=head;
+while q<>null do
+  begin if not is_char_node(q) then
+    if type(q)=unset_node then
+      @<Set the unset box |q| and the unset boxes in it@>
+    else if type(q)=rule_node then
+      @<Make the running dimensions in rule |q| extend to the
+        boundaries of the alignment@>;
+  s:=q; q:=vlink(q);
+  end
+
+@ @<Make the running dimensions in rule |q| extend...@>=
+begin if is_running(width(q)) then width(q):=width(p);
+if is_running(height(q)) then height(q):=height(p);
+if is_running(depth(q)) then depth(q):=depth(p);
+if o<>0 then
+  begin r:=vlink(q); vlink(q):=null; q:=hpack(q,natural);
+  shift_amount(q):=o; vlink(q):=r; vlink(s):=q;
+  end;
+end
+
+@ The unset box |q| represents a row that contains one or more unset boxes,
+depending on how soon \.{\\cr} occurred in that row.
+
+@<Set the unset box |q| and the unset boxes in it@>=
+begin if mode=-vmode then
+  begin type(q):=hlist_node; width(q):=width(p);
+  end
+else  begin type(q):=vlist_node; height(q):=height(p);
+  end;
+glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p);
+glue_set(q):=glue_set(p); shift_amount(q):=o;
+r:=vlink(list_ptr(q)); s:=vlink(list_ptr(p));
+repeat @<Set the glue in node |r| and change it from an unset node@>;
+r:=vlink(vlink(r)); s:=vlink(vlink(s));
+until r=null;
+end
+
+@ A box made from spanned columns will be followed by tabskip glue nodes and
+by empty boxes as if there were no spanning. This permits perfect alignment
+of subsequent entries, and it prevents values that depend on floating point
+arithmetic from entering into the dimensions of any boxes.
+
+@<Set the glue in node |r|...@>=
+n:=span_count(r); t:=width(s); w:=t; u:=hold_head;
+while n>min_quarterword do
+  begin decr(n);
+  @<Append tabskip glue and an empty box to list |u|,
+    and update |s| and |t| as the prototype nodes are passed@>;
+  end;
+if mode=-vmode then
+  @<Make the unset node |r| into an |hlist_node| of width |w|,
+    setting the glue as if the width were |t|@>
+else @<Make the unset node |r| into a |vlist_node| of height |w|,
+    setting the glue as if the height were |t|@>;
+shift_amount(r):=0;
+if u<>hold_head then {append blank boxes to account for spanned nodes}
+  begin vlink(u):=vlink(r); vlink(r):=vlink(hold_head); r:=u;
+  end
+
+@ @<Append tabskip glue and an empty box to list |u|...@>=
+s:=vlink(s); v:=glue_ptr(s); vlink(u):=new_glue(v); u:=vlink(u);
+subtype(u):=tab_skip_code+1; t:=t+width(v);
+if glue_sign(p)=stretching then
+  begin if stretch_order(v)=glue_order(p) then
+    t:=t+round(float(glue_set(p))*stretch(v));
+@^real multiplication@>
+  end
+else if glue_sign(p)=shrinking then
+  begin if shrink_order(v)=glue_order(p) then
+    t:=t-round(float(glue_set(p))*shrink(v));
+  end;
+s:=vlink(s); rr:=new_null_box; vlink(u):=rr; u:=vlink(u); t:=t+width(s);
+if mode=-vmode then width(u):=width(s)@+else
+  begin type(u):=vlist_node; height(u):=width(s);
+  end
+
+@ @<Make the unset node |r| into an |hlist_node| of width |w|...@>=
+begin height(r):=height(q); depth(r):=depth(q);
+if t=width(r) then
+  begin glue_sign(r):=normal; glue_order(r):=normal;
+  set_glue_ratio_zero(glue_set(r));
+  end
+else if t>width(r) then
+  begin glue_sign(r):=stretching;
+  if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
+  else glue_set(r):=unfloat((t-width(r))/glue_stretch(r));
+@^real division@>
+  end
+else  begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
+  if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
+  else if (glue_order(r)=normal)and(width(r)-t>glue_shrink(r)) then
+    set_glue_ratio_one(glue_set(r))
+  else glue_set(r):=unfloat((width(r)-t)/glue_shrink(r));
+  end;
+width(r):=w; type(r):=hlist_node;
+end
+
+@ @<Make the unset node |r| into a |vlist_node| of height |w|...@>=
+begin width(r):=width(q);
+if t=height(r) then
+  begin glue_sign(r):=normal; glue_order(r):=normal;
+  set_glue_ratio_zero(glue_set(r));
+  end
+else if t>height(r) then
+  begin glue_sign(r):=stretching;
+  if glue_stretch(r)=0 then set_glue_ratio_zero(glue_set(r))
+  else glue_set(r):=unfloat((t-height(r))/glue_stretch(r));
+@^real division@>
+  end
+else  begin glue_order(r):=glue_sign(r); glue_sign(r):=shrinking;
+  if glue_shrink(r)=0 then set_glue_ratio_zero(glue_set(r))
+  else if (glue_order(r)=normal)and(height(r)-t>glue_shrink(r)) then
+    set_glue_ratio_one(glue_set(r))
+  else glue_set(r):=unfloat((height(r)-t)/glue_shrink(r));
+  end;
+height(r):=w; type(r):=vlist_node;
+end
+
+@ We now have a completed alignment, in the list that starts at |head|
+and ends at |tail|. This list will be merged with the one that encloses
+it. (In case the enclosing mode is |mmode|, for displayed formulas,
+we will need to insert glue before and after the display; that part of the
+program will be deferred until we're more familiar with such operations.)
+
+@<Insert the \(c)current list into its environment@>=
+aux_save:=aux; p:=vlink(head); q:=tail; pop_nest;
+if mode=mmode then @<Finish an alignment in a display@>
+else  begin aux:=aux_save; vlink(tail):=p;
+  if p<>null then tail:=q;
+  if mode=vmode then begin check_filter('alignment'); build_page; end;
+  end
+
+@* \[38] Breaking paragraphs into lines.
+We come now to what is probably the most interesting algorithm of \TeX:
+the mechanism for choosing the ``best possible'' breakpoints that yield
+the individual lines of a paragraph. \TeX's line-breaking algorithm takes
+a given horizontal list and converts it to a sequence of boxes that are
+appended to the current vertical list. In the course of doing this, it
+creates a special data structure containing three kinds of records that are
+not used elsewhere in \TeX. Such nodes are created while a paragraph is
+being processed, and they are destroyed afterwards; thus, the other parts
+of \TeX\ do not need to know anything about how line-breaking is done.
+
+The method used here is based on an approach devised by Michael F. Plass and
+@^Plass, Michael Frederick@>
+@^Knuth, Donald Ervin@>
+the author in 1977, subsequently generalized and improved by the same two
+people in 1980. A detailed discussion appears in {\sl SOFTWARE---Practice
+\AM\ Experience \bf11} (1981), 1119--1184, where it is shown that the
+line-breaking problem can be regarded as a special case of the problem of
+computing the shortest path in an acyclic network. The cited paper includes
+numerous examples and describes the history of line breaking as it has been
+practiced by printers through the ages. The present implementation adds two
+new ideas to the algorithm of 1980: memory space requirements are considerably
+reduced by using smaller records for inactive nodes than for active ones,
+and arithmetic overflow is avoided by using ``delta distances'' instead of
+keeping track of the total distance from the beginning of the paragraph to the
+current point.
+
+@ The |line_break| procedure should be invoked only in horizontal mode; it
+leaves that mode and places its output into the current vlist of the
+enclosing vertical mode (or internal vertical mode).
+There is one explicit parameter:  |d| is true for partial paragraphs
+preceding display math mode; in this case the amount of additional
+penalty inserted before the final line is |display_widow_penalty|
+instead of |widow_penalty|.
+
+There are also a number of implicit parameters: The hlist to be broken
+starts at |vlink(head)|, and it is nonempty. The value of |prev_graf| in the
+enclosing semantic level tells where the paragraph should begin in the
+sequence of line numbers, in case hanging indentation or \.{\\parshape}
+are in use; |prev_graf| is zero unless this paragraph is being continued
+after a displayed formula.  Other implicit parameters, such as the
+|par_shape_ptr| and various penalties to use for hyphenation, etc., appear
+in |eqtb|.
+
+After |line_break| has acted, it will have updated the current vlist and the
+value of |prev_graf|. Furthermore, the global variable |just_box| will
+point to the final box created by |line_break|, so that the width of this
+line can be ascertained when it is necessary to decide whether to use
+|above_display_skip| or |above_display_short_skip| before a displayed formula.
+
+@<Glob...@>=
+@!just_box:pointer; {the |hlist_node| for the last line of the new paragraph}
+@!paragraph_dir:integer; {main direction of paragraph}
+@!line_break_dir:integer; {current direction within paragraph}
+@!line_break_context:integer; {the surrounding state for |line_break| calls}
+@!break_c_htdp:quarterword; {height-depth entry in |char_info|}
+@!temp_no_whatsits:integer; {used when closing group}
+@!temp_no_dirs:integer; {used when closing group}
+@!temporary_dir:integer;
+@!dir_ptr,@!dir_tmp,@!dir_rover:pointer;
+
+@ @<Set init...@>=
+temp_no_whatsits:=0; temp_no_dirs:=0; temporary_dir:=0;
+dir_ptr:=null; dir_tmp:=null; dir_rover:=null;
+line_break_context := bottom_level;
+
+@ In it's complete form, |line_break| is a rather lengthy
+procedure---sort of a small world unto itself---we must build it up
+little by little. Below you see only te general outline.
+
+The main task performed here is to move the list from |head| to
+|temp_head| and go into the enclosing semantic level. We also append
+the \.{\\parfillskip} glue to the end of the paragraph, removing a
+space (or other glue node) if it was there, since spaces usually
+precede blank lines and instances of `\.{\$\$}'. The |par_fill_skip|
+is preceded by an infinite penalty, so it will never be considered as
+a potential breakpoint.
+
+That code assumes that a |glue_node| and a |penalty_node| occupy the
+same number of |mem|~words.
+@^data structure assumptions@>
+
+Most other processing is delegated to external functions.
+
+@p procedure line_break(@!d:boolean);
+var final_par_glue:pointer;
+start_of_par:pointer;
+begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
+vlink(temp_head):=vlink(head);
+new_hyphenation(temp_head, tail);
+if (not is_char_node(vlink(head))) and ((type(vlink(head))=whatsit_node)
+   and (subtype(vlink(head))=local_par_node)) then 
+  paragraph_dir:=local_par_dir(vlink(head)) 
+else
+  paragraph_dir:=0;
+line_break_dir:=paragraph_dir;
+tail:=new_ligkern(temp_head,tail);
+if is_char_node(tail) then new_tail_append(new_penalty(inf_penalty))
+else if type(tail)<>glue_node then new_tail_append(new_penalty(inf_penalty))
+else begin 
+  type(tail):=penalty_node; 
+  delete_glue_ref(glue_ptr(tail));
+  if leader_ptr(tail)<>null then
+    flush_node_list(leader_ptr(tail));
+  penalty(tail):=inf_penalty;
+  end;
+final_par_glue:=new_param_glue(par_fill_skip_code);
+couple_nodes(tail,final_par_glue);
+if not output_active then 
+  lua_node_filter(pre_linebreak_filter_callback,
+	line_break_context,temp_head,addressof(tail));
+last_line_fill:=vlink(tail);
+pop_nest;
+start_of_par:=tail;
+ext_do_line_break(d,pretolerance,tracing_paragraphs,tolerance,emergency_stretch,
+		   looseness,hyphen_penalty,ex_hyphen_penalty,
+		   pdf_adjust_spacing, par_shape_ptr, adj_demerits,
+		   pdf_protrude_chars, line_penalty, last_line_fit, 
+		   double_hyphen_demerits, final_hyphen_demerits,
+		   hang_indent, hsize, hang_after, left_skip, right_skip,
+		   pdf_each_line_height,pdf_each_line_depth,
+		   pdf_first_line_height, pdf_last_line_depth,
+		   inter_line_penalties_ptr, inter_line_penalty,
+		   club_penalty, club_penalties_ptr,
+		   display_widow_penalties_ptr,widow_penalties_ptr,
+		   display_widow_penalty, widow_penalty,
+		   broken_penalty, final_par_glue);
+if not output_active then 
+  lua_node_filter(post_linebreak_filter_callback,
+	line_break_context,start_of_par,addressof(tail));
+pack_begin_line:=0;
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+
+@ It is possible that the user wants to interfere at some point.  
+
+The choice between |check_head_filter| and |check_contrib_filter| is not
+quite clear to me yet, but it seems that the latter is the better choice.
+
+@d check_head_filter(#)==if (not output_active) and (vlink(head)<>null) then
+lua_node_filter_s(buildpage_filter_callback,#,head,addressof(tail))
+
+@d check_contrib_filter(#)==if (not output_active) and (vlink(contrib_head)<>null) then
+lua_node_filter_s(buildpage_filter_callback,#,contrib_head,addressof(garbage))
+
+@d check_filter==check_head_filter
+
+@* \[39] Breaking paragraphs into lines, continued.
+
+Hyphenation and line breaking are now all handled in C. Only the
+section heads are kept here.
+
+@* \[40] Pre-hyphenation.
+
+@* \[41] Post-hyphenation.
+
+@* \[42] Hyphenation.
+
+@ When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
+|new_hyph_exceptions| to do the right thing.
+
+@p procedure new_hyph_exceptions; {enters new exceptions}
+var p:halfword; {just to catch the return value of |scan_toks|}
+begin p:=scan_toks(false,true);
+load_tex_hyphenation(language,def_ref);
+flush_list(def_ref); 
+end;
+
+@ Similarly, when \TeX\ has scanned `\.{\\patterns}', it calls on a
+procedure named |new_patterns|.
+
+@p procedure new_patterns; {initializes the hyphenation pattern data}
+var p:halfword; {just to catch the return value of |scan_toks|}
+begin p:=scan_toks(false,true);
+load_tex_patterns(language,def_ref);
+flush_list(def_ref); 
+end;
+
+@ `\.{\\prehyphenchar}', sets the |pre_break| character, and
+`\.{\\posthyphenchar}' the |post_break| character. Their respective
+defaults are ascii hyphen ("-") and zero (nul).
+
+@p procedure new_pre_hyphen_char;
+begin scan_optional_equals; scan_int;
+   set_pre_hyphen_char(language,cur_val);
+end;
+@#
+procedure new_post_hyphen_char;
+begin scan_optional_equals; scan_int;
+   set_post_hyphen_char(language,cur_val);
+end;
+
+@* \[43] Initializing the hyphenation tables.
+
+None of the trie-related stuff is applicable any more in luatex.
+
+@* \[44] Breaking vertical lists into pages.
+The |vsplit| procedure, which implements \TeX's \.{\\vsplit} operation,
+is considerably simpler than |line_break| because it doesn't have to
+worry about hyphenation, and because its mission is to discover a single
+break instead of an optimum sequence of breakpoints.  But before we get
+into the details of |vsplit|, we need to consider a few more basic things.
+
+@ A subroutine called |prune_page_top| takes a pointer to a vlist and
+returns a pointer to a modified vlist in which all glue, kern, and penalty nodes
+have been deleted before the first box or rule node. However, the first
+box or rule is actually preceded by a newly created glue node designed so that
+the topmost baseline will be at distance |split_top_skip| from the top,
+whenever this is possible without backspacing.
+
+When the second argument |s| is |false| the deleted nodes are destroyed,
+otherwise they are collected in a list starting at |split_disc|.
+
+@d discard_or_move = 60
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+begin prev_p:=temp_head; vlink(temp_head):=p; r:=null;
+while p<>null do
+  case type(p) of
+  hlist_node,vlist_node,rule_node:@<Insert glue for |split_top_skip|
+    and set~|p:=null|@>;
+  whatsit_node,mark_node,ins_node: begin
+    prev_p:=p; p:=vlink(prev_p);
+    end;
+  glue_node,kern_node,penalty_node: begin
+    q:=p; p:=vlink(q); vlink(q):=null;
+    vlink(prev_p):=p;
+    if s then
+      begin if split_disc=null then split_disc:=q else vlink(r):=q;
+      r:=q;
+      end
+    else flush_node_list(q);
+    end;
+  othercases confusion("pruning")
+@:this can't happen pruning}{\quad pruning@>
+  endcases;
+prune_page_top:=vlink(temp_head);
+end;
+
+@ @<Insert glue for |split_top_skip|...@>=
+begin q:=new_skip_param(split_top_skip_code); vlink(prev_p):=q; vlink(q):=p;
+  {now |temp_ptr=glue_ptr(q)|}
+if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+p:=null;
+end
+
+@ The next subroutine finds the best place to break a given vertical list
+so as to obtain a box of height~|h|, with maximum depth~|d|.
+A pointer to the beginning of the vertical list is given,
+and a pointer to the optimum breakpoint is returned. The list is effectively
+followed by a forced break, i.e., a penalty node with the |eject_penalty|;
+if the best break occurs at this artificial node, the value |null| is returned.
+
+@<Glob...@>=
+@!active_height:array[1..9] of scaled;
+  {distance from first active node to~|cur_p|}
+
+@ An array of six |scaled| distances is used to keep track of the height
+from the beginning of the list to the current place, just as in |line_break|.
+In fact, we use one of the same arrays, only changing its name to reflect
+its new significance.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6);#(7)
+
+@d cur_height==active_height[1] {the natural height}
+@d set_height_zero(#)==active_height[#]:=0 {initialize the height to zero}
+@#
+@d update_heights=90 {go here to record glue in the |active_height| table}
+@d awful_bad=@'7777777777 { more than a billion demerits }
+
+@p function vert_break(@!p:pointer; @!h,@!d:scaled):pointer;
+  {finds optimum page break}
+label done,not_found,update_heights;
+var prev_p:pointer; {if |p| is a glue node, |type(prev_p)| determines
+  whether |p| is a legal breakpoint}
+@!q,@!r:pointer; {glue specifications}
+@!pi:integer; {penalty value}
+@!b:integer; {badness at a trial breakpoint}
+@!least_cost:integer; {the smallest badness plus penalties found so far}
+@!best_place:pointer; {the most recent break that leads to |least_cost|}
+@!prev_dp:scaled; {depth of previous box in the list}
+@!t:small_number; {|type| of the node following a kern}
+begin prev_p:=p; {an initial glue node is not a legal breakpoint}
+least_cost:=awful_bad; do_all_six(set_height_zero); prev_dp:=0;
+best_place:=null; pi:=0;
+loop@+  begin @<If node |p| is a legal breakpoint, check if this break is
+    the best known, and |goto done| if |p| is null or
+    if the page-so-far is already too full to accept more stuff@>;
+  prev_p:=p; p:=vlink(prev_p);
+  end;
+done: vert_break:=best_place;
+end;
+
+@ A global variable |best_height_plus_depth| will be set to the natural size
+of the box that corresponds to the optimum breakpoint found by |vert_break|.
+(This value is used by the insertion-splitting algorithm of the page builder.)
+
+@<Glob...@>=
+@!best_height_plus_depth:scaled; {height of the best box, without stretching or
+  shrinking}
+
+@ A subtle point to be noted here is that the maximum depth~|d| might be
+negative, so |cur_height| and |prev_dp| might need to be corrected even
+after a glue or kern node.
+
+@<If node |p| is a legal breakpoint, check...@>=
+if p=null then pi:=eject_penalty
+else  @<Use node |p| to update the current height and depth measurements;
+    if this node is not a legal breakpoint, |goto not_found|
+    or |update_heights|,
+    otherwise set |pi| to the associated penalty at the break@>;
+@<Check if node |p| is a new champion breakpoint; then \(go)|goto done|
+  if |p| is a forced break or if the page-so-far is already too full@>;
+if (type(p)<glue_node)or(type(p)>kern_node) then goto not_found;
+update_heights: @<Update the current height and depth measurements with
+  respect to a glue or kern node~|p|@>;
+not_found: if prev_dp>d then
+    begin cur_height:=cur_height+prev_dp-d;
+    prev_dp:=d;
+    end;
+
+@ @<Use node |p| to update the current height and depth measurements...@>=
+case type(p) of
+hlist_node,vlist_node,rule_node: begin@t@>@;@/
+  cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p);
+  goto not_found;
+  end;
+whatsit_node:@<Process whatsit |p| in |vert_break| loop, |goto not_found|@>;
+glue_node: if precedes_break(prev_p) then pi:=0
+  else goto update_heights;
+kern_node: begin if vlink(p)=null then t:=penalty_node
+  else t:=type(vlink(p));
+  if t=glue_node then pi:=0@+else goto update_heights;
+  end;
+penalty_node: pi:=penalty(p);
+mark_node,ins_node: goto not_found;
+othercases confusion("vertbreak")
+@:this can't happen vertbreak}{\quad vertbreak@>
+endcases
+
+@ @d deplorable==100000 {more than |inf_bad|, but less than |awful_bad|}
+
+@<Check if node |p| is a new champion breakpoint; then \(go)...@>=
+if pi<inf_penalty then
+  begin @<Compute the badness, |b|, using |awful_bad|
+    if the box is too full@>;
+  if b<awful_bad then
+    if pi<=eject_penalty then b:=pi
+    else if b<inf_bad then b:=b+pi
+      else b:=deplorable;
+  if b<=least_cost then
+    begin best_place:=p; least_cost:=b;
+    best_height_plus_depth:=cur_height+prev_dp;
+    end;
+  if (b=awful_bad)or(pi<=eject_penalty) then goto done;
+  end
+
+@ @<Compute the badness, |b|, using |awful_bad| if the box is too full@>=
+if cur_height<h then
+  if (active_height[3]<>0) or (active_height[4]<>0) or
+    (active_height[5]<>0) or (active_height[6]<>0) then b:=0
+  else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[7] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[7])
+
+@ Vertical lists that are subject to the |vert_break| procedure should not
+contain infinite shrinkability, since that would permit any amount of
+information to ``fit'' on one page.
+
+@<Update the current height and depth measurements with...@>=
+if type(p)=kern_node then q:=p
+else  begin q:=glue_ptr(p);
+  active_height[2+stretch_order(q)]:=@|
+    active_height[2+stretch_order(q)]+stretch(q);@/
+  active_height[7]:=active_height[7]+shrink(q);
+  if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+    begin@t@>@;@/
+    print_err("Infinite glue shrinkage found in box being split");@/
+@.Infinite glue shrinkage...@>
+    help4("The box you are \vsplitting contains some infinitely")@/
+      ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
+      ("Such glue doesn't belong there; but you can safely proceed,")@/
+      ("since the offensive shrinkability has been made finite.");
+    error; r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
+    glue_ptr(p):=r; q:=r;
+    end;
+  end;
+cur_height:=cur_height+prev_dp+width(q); prev_dp:=0
+
+@ Now we are ready to consider |vsplit| itself. Most of
+its work is accomplished by the two subroutines that we have just considered.
+
+Given the number of a vlist box |n|, and given a desired page height |h|,
+the |vsplit| function finds the best initial segment of the vlist and
+returns a box for a page of height~|h|. The remainder of the vlist, if
+any, replaces the original box, after removing glue and penalties and
+adjusting for |split_top_skip|. Mark nodes in the split-off box are used to
+set the values of |split_first_mark| and |split_bot_mark|; we use the
+fact that |split_first_mark(x)=null| if and only if |split_bot_mark(x)=null|.
+
+The original box becomes ``void'' if and only if it has been entirely
+extracted.  The extracted box is ``void'' if and only if the original
+box was void (or if it was, erroneously, an hlist box).
+
+@p function vsplit(@!n:halfword; @!h:scaled):pointer;
+  {extracts a page of height |h| from box |n|}
+label exit,done;
+var v:pointer; {the box to be split}
+vdir:integer; {the direction of the box to be split}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+i:halfword; {for traversing marks lists}
+begin v:=box(n); vdir:=box_dir(v);
+flush_node_list(split_disc); split_disc:=null;
+for i:=0 to biggest_used_mark do begin
+  delete_split_first_mark(i);
+  delete_split_bot_mark(i);
+end;
+@<Dispense with trivial cases of void or bad boxes@>;
+q:=vert_break(list_ptr(v),h,split_max_depth);
+@<Look at all the marks in nodes before the break, and set the final
+  link to |null| at the break@>;
+q:=prune_page_top(q,saving_vdiscards>0);
+p:=list_ptr(v); list_ptr(v):=null; flush_node(v);
+pack_direction:=vdir;
+if q=null then box(n):=null {the |eq_level| of the box stays the same}
+else box(n):=filtered_vpackage(q,0,additional,max_depth,split_keep_group);
+vsplit:=filtered_vpackage(p,h,exactly,split_max_depth,split_off_group);
+exit: end;
+
+@ @<Dispense with trivial cases of void or bad boxes@>=
+if v=null then
+  begin vsplit:=null; return;
+  end;
+if type(v)<>vlist_node then
+  begin print_err(""); print_esc("vsplit"); print(" needs a ");
+  print_esc("vbox");
+@:vsplit_}{\.{\\vsplit needs a \\vbox}@>
+  help2("The box you are trying to split is an \hbox.")@/
+  ("I can't split such a box, so I'll leave it alone.");
+  error; vsplit:=null; return;
+  end
+
+@ It's possible that the box begins with a penalty node that is the
+``best'' break, so we must be careful to handle this special case correctly.
+
+@<Look at all the marks...@>=
+p:=list_ptr(v);
+if p=q then list_ptr(v):=null
+else loop@+begin if type(p)=mark_node then
+    if split_first_mark(mark_class(p))=null then
+      begin split_first_mark(mark_class(p)):=mark_ptr(p);
+      split_bot_mark(mark_class(p)):=split_first_mark(mark_class(p));
+      token_ref_count(split_first_mark(mark_class(p))):=@|
+        token_ref_count(split_first_mark(mark_class(p)))+2;
+      end
+    else  begin delete_token_ref(split_bot_mark(mark_class(p)));
+      split_bot_mark(mark_class(p)):=mark_ptr(p);
+      add_token_ref(split_bot_mark(mark_class(p)));
+      end;
+  if vlink(p)=q then
+    begin vlink(p):=null; goto done;
+    end;
+  p:=vlink(p);
+  end;
+done:
+
+@* \[45] The page builder.
+When \TeX\ appends new material to its main vlist in vertical mode, it uses
+a method something like |vsplit| to decide where a page ends, except that
+the calculations are done ``on line'' as new items come in.
+The main complication in this process is that insertions must be put
+into their boxes and removed from the vlist, in a more-or-less optimum manner.
+
+We shall use the term ``current page'' for that part of the main vlist that
+is being considered as a candidate for being broken off and sent to the
+user's output routine. The current page starts at |vlink(page_head)|, and
+it ends at |page_tail|.  We have |page_head=page_tail| if this list is empty.
+@^current page@>
+
+Utter chaos would reign if the user kept changing page specifications
+while a page is being constructed, so the page builder keeps the pertinent
+specifications frozen as soon as the page receives its first box or
+insertion.  The global variable |page_contents| is |empty| when the
+current page contains only mark nodes and content-less whatsit nodes; it
+is |inserts_only| if the page contains only insertion nodes in addition to
+marks and whatsits.  Glue nodes, kern nodes, and penalty nodes are
+discarded until a box or rule node appears, at which time |page_contents|
+changes to |box_there|.  As soon as |page_contents| becomes non-|empty|,
+the current |vsize| and |max_depth| are squirreled away into |page_goal|
+and |page_max_depth|; the latter values will be used until the page has
+been forwarded to the user's output routine. The \.{\\topskip} adjustment
+is made when |page_contents| changes to |box_there|.
+
+Although |page_goal| starts out equal to |vsize|, it is decreased by the
+scaled natural height-plus-depth of the insertions considered so far, and by
+the \.{\\skip} corrections for those insertions. Therefore it represents
+the size into which the non-inserted material should fit, assuming that
+all insertions in the current page have been made.
+
+The global variables |best_page_break| and |least_page_cost| correspond
+respectively to the local variables |best_place| and |least_cost| in the
+|vert_break| routine that we have already studied; i.e., they record the
+location and value of the best place currently known for breaking the
+current page. The value of |page_goal| at the time of the best break is
+stored in |best_size|.
+
+@d inserts_only=1
+  {|page_contents| when an insert node has been contributed, but no boxes}
+@d box_there=2 {|page_contents| when a box or rule has been contributed}
+
+@<Glob...@>=
+@!page_tail:pointer; {the final node on the current page}
+@!page_contents:empty..box_there; {what is on the current page so far?}
+@!page_max_depth:scaled; {maximum box depth on page being built}
+@!best_page_break:pointer; {break here to get the best page known so far}
+@!least_page_cost:integer; {the score for this currently best page}
+@!best_size:scaled; {its |page_goal|}
+
+@ The page builder has another data structure to keep track of insertions.
+This is a list of four-word nodes, starting and ending at |page_ins_head|.
+That is, the first element of the list is node |r@t$_1$@>=vlink(page_ins_head)|;
+node $r_j$ is followed by |r@t$_{j+1}$@>=vlink(r@t$_j$@>)|; and if there are
+|n| items we have |r@t$_{n+1}$@>=page_ins_head|. The |subtype| field of
+each node in this list refers to an insertion number; for example, `\.{\\insert
+250}' would correspond to a node whose |subtype| is |qi(250)|
+(the same as the |subtype| field of the relevant |ins_node|). These |subtype|
+fields are in increasing order, and |subtype(page_ins_head)=
+qi(255)|, so |page_ins_head| serves as a convenient sentinel
+at the end of the list. A record is present for each insertion number that
+appears in the current page.
+
+The |type| field in these nodes distinguishes two possibilities that
+might occur as we look ahead before deciding on the optimum page break.
+If |type(r)=inserting_node|, then |height(r)| contains the total of the
+height-plus-depth dimensions of the box and all its inserts seen so far.
+If |type(r)=split_up_node|, then no more insertions will be made into this box,
+because at least one previous insertion was too big to fit on the current
+page; |broken_ptr(r)| points to the node where that insertion will be
+split, if \TeX\ decides to split it, |broken_ins(r)| points to the
+insertion node that was tentatively split, and |height(r)| includes also the
+natural height plus depth of the part that would be split off.
+
+In both cases, |last_ins_ptr(r)| points to the last |ins_node|
+encountered for box |qo(subtype(r))| that would be at least partially
+inserted on the next page; and |best_ins_ptr(r)| points to the last
+such |ins_node| that should actually be inserted, to get the page with
+minimum badness among all page breaks considered so far. We have
+|best_ins_ptr(r)=null| if and only if no insertion for this box should
+be made to produce this optimum page.
+
+The data structure definitions here use the fact that the |@!height| field
+appears in the fourth word of a box node.
+@^data structure assumptions@>
+
+@d inserting_node=37 {an insertion class that has not yet overflowed}
+@d split_up_node=38 {an overflowed insertion class}
+@d broken_ptr(#)==vlink(#+2)
+  {an insertion for this class will break here if anywhere}
+@d broken_ins(#)==vinfo(#+2) {this insertion might break at |broken_ptr|}
+@d last_ins_ptr(#)==vlink(#+3) {the most recent insertion for this |subtype|}
+@d best_ins_ptr(#)==vinfo(#+3) {the optimum most recent insertion}
+
+@<Initialize the special list heads...@>=
+subtype(page_ins_head):=qi(255);
+type(page_ins_head):=split_up_node; vlink(page_ins_head):=page_ins_head;
+
+@ An array |page_so_far| records the heights and depths of everything
+on the current page. This array contains six |scaled| numbers, like the
+similar arrays already considered in |line_break| and |vert_break|; and it
+also contains |page_goal| and |page_depth|, since these values are
+all accessible to the user via |set_page_dimen| commands. The
+value of |page_so_far[1]| is also called |page_total|.  The stretch
+and shrink components of the \.{\\skip} corrections for each insertion are
+included in |page_so_far|, but the natural space components of these
+corrections are not, since they have been subtracted from |page_goal|.
+
+The variable |page_depth| records the depth of the current page; it has been
+adjusted so that it is at most |page_max_depth|. The variable
+|last_glue| points to the glue specification of the most recent node
+contributed from the contribution list, if this was a glue node; otherwise
+|last_glue=max_halfword|. (If the contribution list is nonempty,
+however, the value of |last_glue| is not necessarily accurate.)
+The variables |last_penalty|, |last_kern|, and |last_node_type|
+are similar.  And
+finally, |insert_penalties| holds the sum of the penalties associated with
+all split and floating insertions.
+
+@d page_goal==page_so_far[0] {desired height of information on page being built}
+@d page_total==page_so_far[1] {height of the current page}
+@d page_shrink==page_so_far[6] {shrinkability of the current page}
+@d page_depth==page_so_far[7] {depth of the current page}
+
+@<Glob...@>=
+@!page_so_far:array [0..7] of scaled; {height and glue of the current page}
+@!last_glue:pointer; {used to implement \.{\\lastskip}}
+@!last_penalty:integer; {used to implement \.{\\lastpenalty}}
+@!last_kern:scaled; {used to implement \.{\\lastkern}}
+@!last_node_type:integer; {used to implement \.{\\lastnodetype}}
+@!insert_penalties:integer; {sum of the penalties for held-over insertions}
+
+@ @<Put each...@>=
+primitive("pagegoal",set_page_dimen,0);
+@!@:page_goal_}{\.{\\pagegoal} primitive@>
+primitive("pagetotal",set_page_dimen,1);
+@!@:page_total_}{\.{\\pagetotal} primitive@>
+primitive("pagestretch",set_page_dimen,2);
+@!@:page_stretch_}{\.{\\pagestretch} primitive@>
+primitive("pagefilstretch",set_page_dimen,3);
+@!@:page_fil_stretch_}{\.{\\pagefilstretch} primitive@>
+primitive("pagefillstretch",set_page_dimen,4);
+@!@:page_fill_stretch_}{\.{\\pagefillstretch} primitive@>
+primitive("pagefilllstretch",set_page_dimen,5);
+@!@:page_filll_stretch_}{\.{\\pagefilllstretch} primitive@>
+primitive("pageshrink",set_page_dimen,6);
+@!@:page_shrink_}{\.{\\pageshrink} primitive@>
+primitive("pagedepth",set_page_dimen,7);
+@!@:page_depth_}{\.{\\pagedepth} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_page_dimen: case chr_code of
+0: print_esc("pagegoal");
+1: print_esc("pagetotal");
+2: print_esc("pagestretch");
+3: print_esc("pagefilstretch");
+4: print_esc("pagefillstretch");
+5: print_esc("pagefilllstretch");
+6: print_esc("pageshrink");
+othercases print_esc("pagedepth")
+endcases;
+
+@ @d print_plus_end(#)==print(#);@+end
+@d print_plus(#)==if page_so_far[#]<>0 then
+  begin print(" plus "); print_scaled(page_so_far[#]); print_plus_end
+
+@p procedure print_totals;
+begin print_scaled(page_total);
+print_plus(2)("");
+print_plus(3)("fil");
+print_plus(4)("fill");
+print_plus(5)("filll");
+if page_shrink<>0 then
+  begin print(" minus "); print_scaled(page_shrink);
+  end;
+end;
+
+@ @<Show the status of the current page@>=
+if page_head<>page_tail then
+  begin print_nl("### current page:");
+  if output_active then print(" (held over for next output)");
+@.held over for next output@>
+  show_box(vlink(page_head));
+  if page_contents>empty then
+    begin print_nl("total height "); print_totals;
+@:total_height}{\.{total height}@>
+    print_nl(" goal height "); print_scaled(page_goal);
+@.goal height@>
+    r:=vlink(page_ins_head);
+    while r<>page_ins_head do
+      begin print_ln; print_esc("insert"); t:=qo(subtype(r));
+      print_int(t); print(" adds ");
+      t:=x_over_n(height(r),1000)*count(t); print_scaled(t);
+      if type(r)=split_up_node then
+        begin q:=page_head; t:=0;
+        repeat q:=vlink(q);
+        if (type(q)=ins_node)and(subtype(q)=subtype(r)) then incr(t);
+        until q=broken_ins(r);
+        print(", #"); print_int(t); print(" might split");
+        end;
+      r:=vlink(r);
+      end;
+    end;
+  end
+
+@ Here is a procedure that is called when the |page_contents| is changing
+from |empty| to |inserts_only| or |box_there|.
+
+@d set_page_so_far_zero(#)==page_so_far[#]:=0
+
+@p procedure freeze_page_specs(@!s:small_number);
+begin page_contents:=s;
+page_goal:=vsize; page_max_depth:=max_depth;
+page_depth:=0; do_all_six(set_page_so_far_zero);
+least_page_cost:=awful_bad;
+@!stat if tracing_pages>0 then
+  begin begin_diagnostic;
+  print_nl("%% goal height="); print_scaled(page_goal);
+@.goal height@>
+  print(", max depth="); print_scaled(page_max_depth);
+  end_diagnostic(false);
+  end;@;@+tats@;@/
+end;
+
+@ Pages are built by appending nodes to the current list in \TeX's
+vertical mode, which is at the outermost level of the semantic nest. This
+vlist is split into two parts; the ``current page'' that we have been
+talking so much about already, and the ``contribution list'' that receives
+new nodes as they are created.  The current page contains everything that
+the page builder has accounted for in its data structures, as described
+above, while the contribution list contains other things that have been
+generated by other parts of \TeX\ but have not yet been
+seen by the page builder.
+The contribution list starts at |vlink(contrib_head)|, and it ends at the
+current node in \TeX's vertical mode.
+
+When \TeX\ has appended new material in vertical mode, it calls the procedure
+|build_page|, which tries to catch up by moving nodes from the contribution
+list to the current page. This procedure will succeed in its goal of
+emptying the contribution list, unless a page break is discovered, i.e.,
+unless the current page has grown to the point where the optimum next
+page break has been determined. In the latter case, the nodes after the
+optimum break will go back onto the contribution list, and control will
+effectively pass to the user's output routine.
+
+We make |type(page_head)=glue_node|, so that an initial glue node on
+the current page will not be considered a valid breakpoint.
+
+@<Initialize the special list...@>=
+type(page_head):=glue_node; subtype(page_head):=normal;
+
+@ The global variable |output_active| is true during the time the
+user's output routine is driving \TeX.
+
+@<Glob...@>=
+@!output_active:boolean; {are we in the midst of an output routine?}
+
+@ @<Set init...@>=
+output_active:=false; insert_penalties:=0;
+
+@ The page builder is ready to start a fresh page if we initialize
+the following state variables. (However, the page insertion list is initialized
+elsewhere.)
+
+@<Start a new current page@>=
+page_contents:=empty; page_tail:=page_head; vlink(page_head):=null;@/
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+page_depth:=0; page_max_depth:=0
+
+@ At certain times box 255 is supposed to be void (i.e., |null|),
+or an insertion box is supposed to be ready to accept a vertical list.
+If not, an error message is printed, and the following subroutine
+flushes the unwanted contents, reporting them to the user.
+
+@p procedure box_error(@!n:eight_bits);
+begin error; begin_diagnostic;
+print_nl("The following box has been deleted:");
+@.The following...deleted@>
+show_box(box(n)); end_diagnostic(true);
+flush_node_list(box(n)); box(n):=null;
+end;
+
+@ The following procedure guarantees that a given box register
+does not contain an \.{\\hbox}.
+
+@p procedure ensure_vbox(@!n:eight_bits);
+var p:pointer; {the box register contents}
+begin p:=box(n);
+if p<>null then if type(p)=hlist_node then
+  begin print_err("Insertions can only be added to a vbox");
+@.Insertions can only...@>
+  help3("Tut tut: You're trying to \insert into a")@/
+    ("\box register that now contains an \hbox.")@/
+    ("Proceed, and I'll discard its present contents.");
+  box_error(n);
+  end;
+end;
+
+@ \TeX\ is not always in vertical mode at the time |build_page|
+is called; the current mode reflects what \TeX\ should return to, after
+the contribution list has been emptied. A call on |build_page| should
+be immediately followed by `|goto big_switch|', which is \TeX's central
+control point.
+
+@d contribute=80 {go here to link a node into the current page}
+
+@p @t\4@>@<Declare the procedure called |fire_up|@>@;@/
+procedure build_page; {append contributions to the current page}
+label exit,done,done1,continue,contribute,update_heights;
+var p:pointer; {the node being appended}
+@!q,@!r:pointer; {nodes being examined}
+@!b,@!c:integer; {badness and cost of current page}
+@!pi:integer; {penalty to be added to the badness}
+@!n:min_quarterword..255; {insertion box number}
+@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
+begin pi:=0;
+if (vlink(contrib_head)=null)or output_active then return;
+repeat continue: p:=vlink(contrib_head);@/
+@<Update the values of |last_glue|, |last_penalty|, and |last_kern|@>;
+@<Move node |p| to the current page; if it is time for a page break,
+  put the nodes following the break back onto the contribution list,
+  and |return| to the user's output routine if there is one@>;
+until vlink(contrib_head)=null;
+@<Make the contribution list empty by setting its tail to |contrib_head|@>;
+exit:end;
+
+@ @d contrib_tail==nest[0].tail_field {tail of the contribution list}
+
+@<Make the contribution list empty...@>=
+if nest_ptr=0 then tail:=contrib_head {vertical mode}
+else contrib_tail:=contrib_head {other modes}
+
+@ @<Update the values of |last_glue|...@>=
+if last_glue<>max_halfword then delete_glue_ref(last_glue);
+last_penalty:=0; last_kern:=0;
+last_node_type:=type(p)+1;
+if type(p)=glue_node then
+  begin last_glue:=glue_ptr(p); add_glue_ref(last_glue);
+  end
+else  begin last_glue:=max_halfword;
+  if type(p)=penalty_node then last_penalty:=penalty(p)
+  else if type(p)=kern_node then last_kern:=width(p);
+  end
+
+@ The code here is an example of a many-way switch into routines that
+merge together in different places. Some people call this unstructured
+programming, but the author doesn't see much wrong with it, as long as
+@^Knuth, Donald Ervin@>
+the various labels have a well-understood meaning.
+
+@<Move node |p| to the current page; ...@>=
+@<If the current page is empty and node |p| is to be deleted, |goto done1|;
+  otherwise use node |p| to update the state of the current page;
+  if this node is an insertion, |goto contribute|; otherwise if this node
+  is not a legal breakpoint, |goto contribute| or |update_heights|;
+  otherwise set |pi| to the penalty associated with this breakpoint@>;
+@<Check if node |p| is a new champion breakpoint; then \(if)if it is time for
+  a page break, prepare for output, and either fire up the user's
+  output routine and |return| or ship out the page and |goto done|@>;
+if (type(p)<glue_node)or(type(p)>kern_node) then goto contribute;
+update_heights:@<Update the current page measurements with respect to the
+  glue or kern specified by node~|p|@>;
+contribute: @<Make sure that |page_max_depth| is not exceeded@>;
+@<Link node |p| into the current page and |goto done|@>;
+done1:@<Recycle node |p|@>;
+done:
+
+@ @<Link node |p| into the current page and |goto done|@>=
+vlink(page_tail):=p; page_tail:=p;
+vlink(contrib_head):=vlink(p); vlink(p):=null; goto done
+
+@ @<Recycle node |p|@>=
+vlink(contrib_head):=vlink(p); vlink(p):=null;
+if saving_vdiscards>0 then
+  begin if page_disc=null then page_disc:=p@+else vlink(tail_page_disc):=p;
+  tail_page_disc:=p;
+  end
+else flush_node_list(p)
+
+@ The title of this section is already so long, it seems best to avoid
+making it more accurate but still longer, by mentioning the fact that a
+kern node at the end of the contribution list will not be contributed until
+we know its successor.
+
+@<If the current page is empty...@>=
+case type(p) of
+hlist_node,vlist_node,rule_node: if page_contents<box_there then
+    @<Initialize the current page, insert the \.{\\topskip} glue
+      ahead of |p|, and |goto continue|@>
+  else @<Prepare to move a box or rule node to the current page,
+    then |goto contribute|@>;
+whatsit_node: @<Prepare to move whatsit |p| to the current page,
+                     then |goto contribute|@>;
+glue_node: if page_contents<box_there then goto done1
+  else if precedes_break(page_tail) then pi:=0
+  else goto update_heights;
+kern_node: if page_contents<box_there then goto done1
+  else if vlink(p)=null then return
+  else if type(vlink(p))=glue_node then pi:=0
+  else goto update_heights;
+penalty_node: if page_contents<box_there then goto done1@+else pi:=penalty(p);
+mark_node: goto contribute;
+ins_node: @<Append an insertion to the current page and |goto contribute|@>;
+othercases confusion("page")
+@:this can't happen page}{\quad page@>
+endcases
+
+@ @<Initialize the current page, insert the \.{\\topskip} glue...@>=
+begin if page_contents=empty then freeze_page_specs(box_there)
+else page_contents:=box_there;
+q:=new_skip_param(top_skip_code); {now |temp_ptr=glue_ptr(q)|}
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+  if width(temp_ptr)>depth(p) then width(temp_ptr):=width(temp_ptr)-depth(p)
+  else width(temp_ptr):=0;
+  end
+else begin
+  if width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+  else width(temp_ptr):=0;
+  end;
+vlink(q):=p; vlink(contrib_head):=q; goto continue;
+end
+
+@ @<Prepare to move a box or rule node to the current page...@>=
+begin
+if (type(p)=hlist_node) and (is_mirrored(body_direction)) then begin
+  page_total:=page_total+page_depth+depth(p);
+  page_depth:=height(p);
+  end
+else begin
+  page_total:=page_total+page_depth+height(p);
+  page_depth:=depth(p);
+  end;
+goto contribute;
+end
+
+@ @<Make sure that |page_max_depth| is not exceeded@>=
+if page_depth>page_max_depth then
+  begin page_total:=@|
+    page_total+page_depth-page_max_depth;@/
+  page_depth:=page_max_depth;
+  end;
+
+@ @<Update the current page measurements with respect to the glue...@>=
+if type(p)=kern_node then q:=p
+else begin q:=glue_ptr(p);
+if stretch_order(q)>1 then
+  page_so_far[1+stretch_order(q)]:=@|
+    page_so_far[1+stretch_order(q)]+stretch(q)@/
+else
+  page_so_far[2+stretch_order(q)]:=@|
+    page_so_far[2+stretch_order(q)]+stretch(q);@/
+  page_shrink:=page_shrink+shrink(q);
+  if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+    begin@t@>@;@/
+    print_err("Infinite glue shrinkage found on current page");@/
+@.Infinite glue shrinkage...@>
+    help4("The page about to be output contains some infinitely")@/
+      ("shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'.")@/
+      ("Such glue doesn't belong there; but you can safely proceed,")@/
+      ("since the offensive shrinkability has been made finite.");
+    error;
+    r:=new_spec(q); shrink_order(r):=normal; delete_glue_ref(q);
+    glue_ptr(p):=r; q:=r;
+    end;
+  end;
+page_total:=page_total+page_depth+width(q); page_depth:=0
+
+@ @<Check if node |p| is a new champion breakpoint; then \(if)...@>=
+if pi<inf_penalty then
+  begin @<Compute the badness, |b|, of the current page,
+    using |awful_bad| if the box is too full@>;
+  if b<awful_bad then
+    if pi<=eject_penalty then c:=pi
+    else  if b<inf_bad then c:=b+pi+insert_penalties
+      else c:=deplorable
+  else c:=b;
+  if insert_penalties>=10000 then c:=awful_bad;
+  @!stat if tracing_pages>0 then @<Display the page break cost@>;@+tats@;@/
+  if c<=least_page_cost then
+    begin best_page_break:=p; best_size:=page_goal;
+    least_page_cost:=c;
+    r:=vlink(page_ins_head);
+    while r<>page_ins_head do
+      begin best_ins_ptr(r):=last_ins_ptr(r);
+      r:=vlink(r);
+      end;
+    end;
+  if (c=awful_bad)or(pi<=eject_penalty) then
+    begin fire_up(p); {output the current page at the best place}
+    if output_active then return; {user's output routine will act}
+    goto done; {the page has been shipped out by default output routine}
+    end;
+  end
+
+@ @<Display the page break cost@>=
+begin begin_diagnostic; print_nl("%");
+print(" t="); print_totals;@/
+print(" g="); print_scaled(page_goal);@/
+print(" b=");
+if b=awful_bad then print_char("*")@+else print_int(b);
+@.*\relax@>
+print(" p="); print_int(pi);
+print(" c=");
+if c=awful_bad then print_char("*")@+else print_int(c);
+if c<=least_page_cost then print_char("#");
+end_diagnostic(false);
+end
+
+@ @<Compute the badness, |b|, of the current page...@>=
+if page_total<page_goal then
+  if (page_so_far[3]<>0) or (page_so_far[4]<>0) or@|
+    (page_so_far[5]<>0) then b:=0
+  else b:=badness(page_goal-page_total,page_so_far[2])
+else if page_total-page_goal>page_shrink then b:=awful_bad
+else b:=badness(page_total-page_goal,page_shrink)
+
+@ @<Append an insertion to the current page and |goto contribute|@>=
+begin if page_contents=empty then freeze_page_specs(inserts_only);
+n:=subtype(p); r:=page_ins_head;
+while n>=subtype(vlink(r)) do r:=vlink(r);
+n:=qo(n);
+if subtype(r)<>qi(n) then
+  @<Create a page insertion node with |subtype(r)=qi(n)|, and
+    include the glue correction for box |n| in the
+    current page state@>;
+if type(r)=split_up_node then insert_penalties:=insert_penalties+float_cost(p)
+else  begin last_ins_ptr(r):=p;
+  delta:=page_goal-page_total-page_depth+page_shrink;
+    {this much room is left if we shrink the maximum}
+  if count(n)=1000 then h:=height(p)
+  else h:=x_over_n(height(p),1000)*count(n); {this much room is needed}
+  if ((h<=0)or(h<=delta))and(height(p)+height(r)<=dimen(n)) then
+    begin page_goal:=page_goal-h; height(r):=height(r)+height(p);
+    end
+  else @<Find the best way to split the insertion, and change
+    |type(r)| to |split_up_node|@>;
+  end;
+goto contribute;
+end
+
+@ We take note of the value of \.{\\skip} |n| and the height plus depth
+of \.{\\box}~|n| only when the first \.{\\insert}~|n| node is
+encountered for a new page. A user who changes the contents of \.{\\box}~|n|
+after that first \.{\\insert}~|n| had better be either extremely careful
+or extremely lucky, or both.
+
+@<Create a page insertion node...@>=
+begin q:=new_node(inserting_node,n); vlink(q):=vlink(r); vlink(r):=q; r:=q;
+ensure_vbox(n);
+if box(n)=null then height(r):=0
+else height(r):=height(box(n))+depth(box(n));
+best_ins_ptr(r):=null;@/
+q:=skip(n);
+if count(n)=1000 then h:=height(r)
+else h:=x_over_n(height(r),1000)*count(n);
+page_goal:=page_goal-h-width(q);@/
+if stretch_order(q)>1 then
+  page_so_far[1+stretch_order(q)]:=@|page_so_far[1+stretch_order(q)]+stretch(q)@/
+else
+  page_so_far[2+stretch_order(q)]:=@|page_so_far[2+stretch_order(q)]+stretch(q);@/
+page_shrink:=page_shrink+shrink(q);
+if (shrink_order(q)<>normal)and(shrink(q)<>0) then
+  begin print_err("Infinite glue shrinkage inserted from "); print_esc("skip");
+@.Infinite glue shrinkage...@>
+  print_int(n);
+  help3("The correction glue for page breaking with insertions")@/
+    ("must have finite shrinkability. But you may proceed,")@/
+    ("since the offensive shrinkability has been made finite.");
+  error;
+  end;
+end
+
+@ Here is the code that will split a long footnote between pages, in an
+emergency. The current situation deserves to be recapitulated: Node |p|
+is an insertion into box |n|; the insertion will not fit, in its entirety,
+either because it would make the total contents of box |n| greater than
+\.{\\dimen} |n|, or because it would make the incremental amount of growth
+|h| greater than the available space |delta|, or both. (This amount |h| has
+been weighted by the insertion scaling factor, i.e., by \.{\\count} |n|
+over 1000.) Now we will choose the best way to break the vlist of the
+insertion, using the same criteria as in the \.{\\vsplit} operation.
+
+@<Find the best way to split the insertion...@>=
+begin if count(n)<=0 then w:=max_dimen
+else  begin w:=page_goal-page_total-page_depth;
+  if count(n)<>1000 then w:=x_over_n(w,count(n))*1000;
+  end;
+if w>dimen(n)-height(r) then w:=dimen(n)-height(r);
+q:=vert_break(ins_ptr(p),w,depth(p));
+height(r):=height(r)+best_height_plus_depth;
+@!stat if tracing_pages>0 then @<Display the insertion split cost@>;@+tats@;@/
+if count(n)<>1000 then
+  best_height_plus_depth:=x_over_n(best_height_plus_depth,1000)*count(n);
+page_goal:=page_goal-best_height_plus_depth;
+type(r):=split_up_node; broken_ptr(r):=q; broken_ins(r):=p;
+if q=null then insert_penalties:=insert_penalties+eject_penalty
+else if type(q)=penalty_node then insert_penalties:=insert_penalties+penalty(q);
+end
+
+@ @<Display the insertion split cost@>=
+begin begin_diagnostic; print_nl("% split"); print_int(n);
+@.split@>
+print(" to "); print_scaled(w);
+print_char(","); print_scaled(best_height_plus_depth);@/
+print(" p=");
+if q=null then print_int(eject_penalty)
+else if type(q)=penalty_node then print_int(penalty(q))
+else print_char("0");
+end_diagnostic(false);
+end
+
+@ When the page builder has looked at as much material as could appear before
+the next page break, it makes its decision. The break that gave minimum
+badness will be used to put a completed ``page'' into box 255, with insertions
+appended to their other boxes.
+
+We also set the values of |top_mark|, |first_mark|, and |bot_mark|. The
+program uses the fact that |bot_mark(x)<>null| implies |first_mark(x)<>null|;
+it also knows that |bot_mark(x)=null| implies |top_mark(x)=first_mark(x)=null|.
+
+The |fire_up| subroutine prepares to output the current page at the best
+place; then it fires up the user's output routine, if there is one,
+or it simply ships out the page. There is one parameter, |c|, which represents
+the node that was being contributed to the page when the decision to
+force an output was made.
+
+@<Declare the procedure called |fire_up|@>=
+procedure fire_up(@!c:pointer);
+label exit;
+var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed}
+@!prev_p:pointer; {predecessor of |p|}
+@!n:min_quarterword..255; {insertion box number}
+@!wait:boolean; {should the present insertion be held over?}
+@!save_vbadness:integer; {saved value of |vbadness|}
+@!save_vfuzz: scaled; {saved value of |vfuzz|}
+@!save_split_top_skip: pointer; {saved value of |split_top_skip|}
+@!i: halfword; { for looping through the marks}
+begin @<Set the value of |output_penalty|@>;
+for i:=0 to biggest_used_mark do begin
+  if bot_mark(i)<>null then
+    begin if top_mark(i)<>null then delete_token_ref(top_mark(i));
+    top_mark(i):=bot_mark(i); add_token_ref(top_mark(i));
+    delete_first_mark(i);
+    end;
+  end;
+@<Put the \(o)optimal current page into box 255, update |first_mark| and
+  |bot_mark|, append insertions to their boxes, and put the
+  remaining nodes back on the contribution list@>;
+for i:=0 to biggest_used_mark do begin
+  if (top_mark(i)<>null)and(first_mark(i)=null) then
+    begin first_mark(i):=top_mark(i); add_token_ref(top_mark(i));
+    end;
+  end;
+if output_routine<>null then
+  if dead_cycles>=max_dead_cycles then
+    @<Explain that too many dead cycles have occurred in a row@>
+  else @<Fire up the user's output routine and |return|@>;
+@<Perform the default output routine@>;
+exit:end;
+
+@ @<Set the value of |output_penalty|@>=
+if type(best_page_break)=penalty_node then
+  begin geq_word_define(int_base+output_penalty_code,penalty(best_page_break));
+  penalty(best_page_break):=inf_penalty;
+  end
+else geq_word_define(int_base+output_penalty_code,inf_penalty)
+
+@ As the page is finally being prepared for output,
+pointer |p| runs through the vlist, with |prev_p| trailing behind;
+pointer |q| is the tail of a list of insertions that
+are being held over for a subsequent page.
+
+@<Put the \(o)optimal current page into box 255...@>=
+if c=best_page_break then best_page_break:=null; {|c| not yet linked in}
+@<Ensure that box 255 is empty before output@>;
+insert_penalties:=0; {this will count the number of insertions held over}
+save_split_top_skip:=split_top_skip;
+if holding_inserts<=0 then
+  @<Prepare all the boxes involved in insertions to act as queues@>;
+q:=hold_head; vlink(q):=null; prev_p:=page_head; p:=vlink(prev_p);
+while p<>best_page_break do
+  begin if type(p)=ins_node then
+    begin if holding_inserts<=0 then
+       @<Either insert the material specified by node |p| into the
+         appropriate box, or hold it for the next page;
+         also delete node |p| from the current page@>;
+    end
+  else if type(p)=mark_node then @<Update the values of
+    |first_mark| and |bot_mark|@>;
+  prev_p:=p; p:=vlink(prev_p);
+  end;
+split_top_skip:=save_split_top_skip;
+@<Break the current page at node |p|, put it in box~255,
+  and put the remaining nodes on the contribution list@>;
+@<Delete \(t)the page-insertion nodes@>
+
+@ @<Ensure that box 255 is empty before output@>=
+if box(255)<>null then
+  begin print_err(""); print_esc("box"); print("255 is not void");
+@:box255}{\.{\\box255 is not void}@>
+  help2("You shouldn't use \box255 except in \output routines.")@/
+    ("Proceed, and I'll discard its present contents.");
+  box_error(255);
+  end
+
+@ @<Update the values of |first_mark| and |bot_mark|@>=
+begin if first_mark(mark_class(p))=null then
+  begin first_mark(mark_class(p)):=mark_ptr(p);
+  add_token_ref(first_mark(mark_class(p)));
+  end;
+if bot_mark(mark_class(p))<>null then delete_token_ref(bot_mark(mark_class(p)));
+bot_mark(mark_class(p)):=mark_ptr(p); add_token_ref(bot_mark(mark_class(p)));
+end;
+
+@ When the following code is executed, the current page runs from node
+|vlink(page_head)| to node |prev_p|, and the nodes from |p| to |page_tail|
+are to be placed back at the front of the contribution list. Furthermore
+the heldover insertions appear in a list from |vlink(hold_head)| to |q|; we
+will put them into the current page list for safekeeping while the user's
+output routine is active.  We might have |q=hold_head|; and |p=null| if
+and only if |prev_p=page_tail|. Error messages are suppressed within
+|vpackage|, since the box might appear to be overfull or underfull simply
+because the stretch and shrink from the \.{\\skip} registers for inserts
+are not actually present in the box.
+
+@<Break the current page at node |p|, put it...@>=
+if p<>null then
+  begin if vlink(contrib_head)=null then
+    if nest_ptr=0 then tail:=page_tail
+    else contrib_tail:=page_tail;
+  vlink(page_tail):=vlink(contrib_head);
+  vlink(contrib_head):=p;
+  vlink(prev_p):=null;
+  end;
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+pack_direction:=body_direction;
+box(255):=filtered_vpackage(vlink(page_head),best_size,exactly,page_max_depth,output_group);
+vbadness:=save_vbadness; vfuzz:=save_vfuzz;
+if last_glue<>max_halfword then delete_glue_ref(last_glue);
+@<Start a new current page@>; {this sets |last_glue:=max_halfword|}
+if q<>hold_head then
+  begin vlink(page_head):=vlink(hold_head); page_tail:=q;
+  end
+
+@ If many insertions are supposed to go into the same box, we want to know
+the position of the last node in that box, so that we don't need to waste time
+when linking further information into it. The |last_ins_ptr| fields of the
+page insertion nodes are therefore used for this purpose during the
+packaging phase.
+
+@<Prepare all the boxes involved in insertions to act as queues@>=
+begin r:=vlink(page_ins_head);
+while r<>page_ins_head do
+  begin if best_ins_ptr(r)<>null then
+    begin n:=qo(subtype(r)); ensure_vbox(n);
+    if box(n)=null then box(n):=new_null_box;
+    p:=box(n)+list_offset;
+    while vlink(p)<>null do p:=vlink(p);
+    last_ins_ptr(r):=p;
+    end;
+  r:=vlink(r);
+  end;
+end
+
+@ @<Delete \(t)the page-insertion nodes@>=
+r:=vlink(page_ins_head);
+while r<>page_ins_head do
+  begin q:=vlink(r); flush_node(r); r:=q;
+  end;
+vlink(page_ins_head):=page_ins_head
+
+@ We will set |best_ins_ptr:=null| and package the box corresponding to
+insertion node~|r|, just after making the final insertion into that box.
+If this final insertion is `|split_up_node|', the remainder after splitting
+and pruning (if any) will be carried over to the next page.
+
+@<Either insert the material specified by node |p| into...@>=
+begin r:=vlink(page_ins_head);
+while subtype(r)<>subtype(p) do r:=vlink(r);
+if best_ins_ptr(r)=null then wait:=true
+else  begin wait:=false; s:=last_ins_ptr(r); vlink(s):=ins_ptr(p);
+  if best_ins_ptr(r)=p then
+    @<Wrap up the box specified by node |r|, splitting node |p| if
+    called for; set |wait:=true| if node |p| holds a remainder after
+    splitting@>
+  else  begin while vlink(s)<>null do s:=vlink(s);
+    last_ins_ptr(r):=s;
+    end;
+  end;
+@<Either append the insertion node |p| after node |q|, and remove it
+  from the current page, or delete |node(p)|@>;
+end
+
+@ @<Wrap up the box specified by node |r|, splitting node |p| if...@>=
+begin if type(r)=split_up_node then
+  if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
+    begin while vlink(s)<>broken_ptr(r) do s:=vlink(s);
+    vlink(s):=null;
+    split_top_skip:=split_top_ptr(p);
+    ins_ptr(p):=prune_page_top(broken_ptr(r),false);
+    if ins_ptr(p)<>null then
+      begin temp_ptr:=vpack(ins_ptr(p),natural);
+      height(p):=height(temp_ptr)+depth(temp_ptr);
+      list_ptr(temp_ptr):=null; flush_node(temp_ptr); wait:=true;
+      end;
+    end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+list_ptr(box(n)):=null; flush_node(box(n));
+pack_direction:=body_direction;
+box(n):=vpack(temp_ptr,natural);
+end
+
+@ @<Either append the insertion node |p|...@>=
+vlink(prev_p):=vlink(p); vlink(p):=null;
+if wait then
+  begin vlink(q):=p; q:=p; incr(insert_penalties);
+  end
+else  begin ins_ptr(p):=null; flush_node(p);
+  end;
+p:=prev_p
+
+@ The list of heldover insertions, running from |vlink(page_head)| to
+|page_tail|, must be moved to the contribution list when the user has
+specified no output routine.
+
+@<Perform the default output routine@>=
+begin if vlink(page_head)<>null then
+  begin if vlink(contrib_head)=null then
+    if nest_ptr=0 then tail:=page_tail@+else contrib_tail:=page_tail
+  else vlink(page_tail):=vlink(contrib_head);
+  vlink(contrib_head):=vlink(page_head);
+  vlink(page_head):=null; page_tail:=page_head;
+  end;
+flush_node_list(page_disc); page_disc:=null;
+ship_out(box(255)); box(255):=null;
+end
+
+@ @<Explain that too many dead cycles have occurred in a row@>=
+begin print_err("Output loop---"); print_int(dead_cycles);
+@.Output loop...@>
+print(" consecutive dead cycles");
+help3("I've concluded that your \output is awry; it never does a")@/
+("\shipout, so I'm shipping \box255 out myself. Next time")@/
+("increase \maxdeadcycles if you want me to be more patient!"); error;
+end
+
+@ @<Fire up the user's output routine and |return|@>=
+begin output_active:=true;
+incr(dead_cycles);
+push_nest; mode:=-vmode; prev_depth:=ignore_depth; mode_line:=-line;
+begin_token_list(output_routine,output_text);
+new_save_level(output_group); normal_paragraph;
+scan_left_brace;
+return;
+end
+
+@ When the user's output routine finishes, it has constructed a vlist
+in internal vertical mode, and \TeX\ will do the following:
+
+@<Resume the page builder after an output routine has come to an end@>=
+begin if (loc<>null) or
+ ((token_type<>output_text)and(token_type<>backed_up)) then
+  @<Recover from an unbalanced output routine@>;
+end_token_list; {conserve stack space in case more outputs are triggered}
+end_graf; unsave; output_active:=false; insert_penalties:=0;@/
+@<Ensure that box 255 is empty after output@>;
+if tail<>head then {current list goes after heldover insertions}
+  begin vlink(page_tail):=vlink(head);
+  page_tail:=tail;
+  end;
+if vlink(page_head)<>null then {and both go before heldover contributions}
+  begin if vlink(contrib_head)=null then contrib_tail:=page_tail;
+  vlink(page_tail):=vlink(contrib_head);
+  vlink(contrib_head):=vlink(page_head);
+  vlink(page_head):=null; page_tail:=page_head;
+  end;
+flush_node_list(page_disc); page_disc:=null;
+pop_nest; build_page;
+end
+
+@ @<Recover from an unbalanced output routine@>=
+begin print_err("Unbalanced output routine");
+@.Unbalanced output routine@>
+help2("Your sneaky output routine has problematic {'s and/or }'s.")@/
+("I can't handle that very well; good luck."); error;
+repeat get_token;
+until loc=null;
+end {loops forever if reading from a file, since |null=min_halfword<=0|}
+
+@ @<Ensure that box 255 is empty after output@>=
+if box(255)<>null then
+  begin print_err("Output routine didn't use all of ");
+  print_esc("box"); print_int(255);
+@.Output routine didn't use...@>
+  help3("Your \output commands should empty \box255,")@/
+    ("e.g., by saying `\shipout\box255'.")@/
+    ("Proceed; I'll discard its present contents.");
+  box_error(255);
+  end
+
+@* \[46] The chief executive.
+We come now to the |main_control| routine, which contains the master
+switch that causes all the various pieces of \TeX\ to do their things,
+in the right order.
+
+In a sense, this is the grand climax of the program: It applies all the
+tools that we have worked so hard to construct. In another sense, this is
+the messiest part of the program: It necessarily refers to other pieces
+of code all over the place, so that a person can't fully understand what is
+going on without paging back and forth to be reminded of conventions that
+are defined elsewhere. We are now at the hub of the web, the central nervous
+system that touches most of the other parts and ties them together.
+@^brain@>
+
+The structure of |main_control| itself is quite simple. There's a label
+called |big_switch|, at which point the next token of input is fetched
+using |get_x_token|. Then the program branches at high speed into one of
+about 100 possible directions, based on the value of the current
+mode and the newly fetched command code; the sum |abs(mode)+cur_cmd|
+indicates what to do next. For example, the case `|vmode+letter|' arises
+when a letter occurs in vertical mode (or internal vertical mode); this
+case leads to instructions that initialize a new paragraph and enter
+horizontal mode.
+
+The big |case| statement that contains this multiway switch has been labeled
+|reswitch|, so that the program can |goto reswitch| when the next token
+has already been fetched. Most of the cases are quite short; they call
+an ``action procedure'' that does the work for that case, and then they
+either |goto reswitch| or they ``fall through'' to the end of the |case|
+statement, which returns control back to |big_switch|. Thus, |main_control|
+is not an extremely large procedure, in spite of the multiplicity of things
+it must do; it is small enough to be handled by \PASCAL\ compilers that put
+severe restrictions on procedure size.
+@!@^action procedure@>
+
+One case is singled out for special treatment, because it accounts for most
+of \TeX's activities in typical applications. The process of reading simple
+text and converting it into |char_node| records, while looking for ligatures
+and kerns, is part of \TeX's ``inner loop''; the whole program runs
+efficiently when its inner loop is fast, so this part has been written
+with particular care.
+
+@ We shall concentrate first on the inner loop of |main_control|, deferring
+consideration of the other cases until later.
+@^inner loop@>
+
+@d big_switch=60 {go here to branch on the next token of input}
+
+@p @t\4@>@<Declare action procedures for use by |main_control|@>@;
+@t\4@>@<Declare the procedure called |handle_right_brace|@>@;
+procedure main_control; {governs \TeX's activities}
+label big_switch,reswitch,continue,exit;
+var@!t,k:integer; {general-purpose temporary variables}
+p:pointer; {for whatsit nodes and testing whether an auto kern should be inserted}
+chr_stack:integer; { to temporarily save an |cur_chr| to be appended }
+begin t:=0; {for -Wall}
+chr_stack:=-1; 
+if every_job<>null then begin_token_list(every_job,every_job_text);
+big_switch: get_x_token;@/
+reswitch: @<Give diagnostic information, if requested@>;
+case abs(mode)+cur_cmd of
+hmode+letter,hmode+other_char,hmode+char_given,hmode+char_num: begin 
+  if abs(mode)+cur_cmd=hmode+char_num then begin 
+    scan_char_num; cur_chr:=cur_val; 
+    end;
+  if is_last_ocp(current_ocp_lstack,current_ocp_no) then begin
+    @<Append character |cur_chr| and the following characters (if~any)
+      to the current hlist in the current font; |goto reswitch| when
+      a non-character has been fetched@>;
+    end
+  else begin
+    @<Create a buffer with character |cur_chr| and the following
+      characters (if~any) and then apply the current active OCP filter
+      to this buffer@>;
+    end;
+  end;
+hmode+no_boundary: begin @<Append a |cancel_boundary_node| @>;
+  end;
+hmode+char_ghost: begin t:=cur_chr; get_x_token;
+  if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+   (cur_cmd=char_num) then begin 
+	p:=new_glyph(cur_font,cur_chr);
+    if t=0 then begin set_is_leftghost(p); end
+    else begin set_is_rightghost(p); end;
+    tail_append(p);
+    end;
+  end;
+hmode+spacer,hmode+ex_space,mmode+ex_space: 
+if (abs(mode)+cur_cmd=hmode+spacer) and 
+   (not (space_factor = 1000)) then
+  app_space
+else begin
+  @<Append a normal inter-word space to the current list@>; 
+  end;
+@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
+end; {of the big |case| statement}
+goto big_switch;
+exit:end;
+
+@ When a new token has just been fetched at |big_switch|, we have an
+ideal place to monitor \TeX's activity.
+@^debugging@>
+
+@<Give diagnostic information, if requested@>=
+if interrupt<>0 then if OK_to_interrupt then
+  begin back_input; check_interrupt; goto big_switch;
+  end;
+if tracing_commands>0 then show_cur_cmd_chr
+
+@ The following part of the program was first written in a structured
+manner, according to the philosophy that ``premature optimization is
+the root of all evil.'' Then it was rearranged into pieces of
+spaghetti so that the most common actions could proceed with little or
+no redundancy. And finally, it is replaced by a completely standalone
+loop over the node list: luatex does not have a |main+loop| at all.
+@^inner loop@>
+
+@<Glob...@>=
+@!main_p:pointer; {temporary register for list manipulation}
+@!main_s:integer; {space factor value}
+
+@ We leave the |space_factor| unchanged if |sf_code(cur_chr)=0|; otherwise we
+set it equal to |sf_code(cur_chr)|, except that it should never change
+from a value less than 1000 to a value exceeding 1000. The most common
+case is |sf_code(cur_chr)=1000|, so we want that case to be fast.
+
+@d adjust_space_factor==@t@>@;@/
+  main_s:=get_sf_code(cur_chr);
+  if main_s=1000 then space_factor:=1000
+  else if main_s<1000 then
+    begin if main_s>0 then space_factor:=main_s;
+    end
+  else if space_factor<1000 then space_factor:=1000
+  else space_factor:=main_s
+
+@<Append character |cur_chr|...@>=
+continue: adjust_space_factor;@/
+chr_stack:=cur_chr;
+tail_append(new_char(cur_font,chr_stack));
+get_x_token;
+if (cur_cmd=letter)or(cur_cmd=other_char)or
+   (cur_cmd=char_given)or(cur_cmd=char_num) then begin 
+  if cur_cmd=char_num then begin 
+    scan_char_num; cur_chr:=cur_val; 
+    end;
+  if (chr_stack=ex_hyphen_char)and(cur_chr<>ex_hyphen_char)and(mode>0) then begin 
+    tail_append(new_disc); subtype(tail):=automatic_disc; 
+    end;
+  goto continue;
+  end 
+else begin
+  if (chr_stack=ex_hyphen_char) and (mode>0) then begin 
+    tail_append(new_disc); subtype(tail):=automatic_disc; 
+    end;
+  chr_stack:=-1;
+  goto reswitch;
+  end
+
+@ The occurrence of blank spaces is almost part of \TeX's inner loop,
+@^inner loop@>
+since we usually encounter about one space for every five non-blank characters.
+Therefore |main_control| gives second-highest priority to ordinary spaces.
+
+When a glue parameter like \.{\\spaceskip} is set to `\.{0pt}', we will
+see to it later that the corresponding glue specification is precisely
+|zero_glue|, not merely a pointer to some specification that happens
+to be full of zeroes. Therefore it is simple to test whether a glue parameter
+is zero or~not.
+
+@<Append a normal inter-word space...@>=
+if space_skip=zero_glue then
+  begin @<Find the glue specification, |main_p|, for
+    text spaces in the current font@>;
+  temp_ptr:=new_glue(main_p);
+  end
+else temp_ptr:=new_param_glue(space_skip_code);
+vlink(tail):=temp_ptr; tail:=temp_ptr
+
+
+@ From Knuth: ``Having |font_glue| allocated for each text font saves
+both time and memory.''  That may be true, but it also punches through
+the API wall for fonts, so I removed that -- Taco. But a bit of caching
+is very welcome, which is why I need to have the next two globals:
+
+@<Glob...@>=
+space_spec_font:internal_font_number;
+space_spec_cache:halfword;
+
+@ @<Set init...@>=
+space_spec_font:=0;
+space_spec_cache:=zero_glue;
+
+@ @<Find the glue specification...@>=
+begin 
+if cur_font<>space_spec_font then begin
+  if space_spec_cache<>zero_glue then
+     delete_glue_ref(space_spec_cache);
+  space_spec_cache:=new_spec(zero_glue);
+  width(space_spec_cache):=space(cur_font);
+  stretch(space_spec_cache):=space_stretch(cur_font);
+  shrink(space_spec_cache):=space_shrink(cur_font);
+  space_spec_font:=cur_font;
+  end;
+main_p:=space_spec_cache;
+end
+
+@ @<Declare act...@>=
+procedure app_space; {handle spaces when |space_factor<>1000|}
+var@!q:pointer; {glue node}
+begin if (space_factor>=2000)and(xspace_skip<>zero_glue) then
+  q:=new_param_glue(xspace_skip_code)
+else begin if space_skip<>zero_glue then 
+    main_p:=new_spec(space_skip)
+  else begin 
+    main_p:=new_spec(zero_glue);
+    width(main_p):=space(cur_font);
+    stretch(main_p):=space_stretch(cur_font);
+    shrink(main_p):=space_shrink(cur_font);
+  end;
+  @<Modify the glue specification in |main_p| according to the space factor@>;
+  q:=new_glue(main_p); glue_ref_count(main_p):=null;
+  end;
+vlink(tail):=q; tail:=q;
+end;
+
+@ @<Modify the glue specification in |main_p| according to the space factor@>=
+if space_factor>=2000 then width(main_p):=width(main_p)+extra_space(cur_font);
+stretch(main_p):=xn_over_d(stretch(main_p),space_factor,1000);
+shrink(main_p):=xn_over_d(shrink(main_p),1000,space_factor)
+
+@ Whew---that covers the main loop. We can now proceed at a leisurely
+pace through the other combinations of possibilities.
+
+@d any_mode(#)==vmode+#,hmode+#,mmode+# {for mode-independent commands}
+
+@<Cases of |main_control| that are not part of the inner loop@>=
+any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing;
+any_mode(ignore_spaces): begin
+  if cur_chr = 0 then begin
+    @<Get the next non-blank non-call...@>;
+    goto reswitch;
+  end
+  else begin
+    t:=scanner_status;
+    scanner_status:=normal;
+    get_filtered_next;
+    scanner_status:=t;
+    cur_cs  := prim_lookup(text(cur_cs));
+    if cur_cs<>undefined_primitive then begin
+      cur_cmd := get_prim_eq_type(cur_cs);
+      cur_chr := get_prim_equiv(cur_cs);
+      cur_tok := (cur_cmd*string_offset)+cur_chr;
+      goto reswitch;
+      end;
+    end;
+  end;
+vmode+stop: if its_all_over then return; {this is the only way out}
+@t\4@>@<Forbidden cases detected in |main_control|@>@+@,any_mode(mac_param):
+  report_illegal_case;
+@<Math-only cases in non-math modes, or vice versa@>: insert_dollar_sign;
+@t\4@>@<Cases of |main_control| that build boxes and lists@>@;
+@t\4@>@<Cases of |main_control| that don't depend on |mode|@>@;
+@t\4@>@<Cases of |main_control| that are for extensions to \TeX@>@;
+
+@ Here is a list of cases where the user has probably gotten into or out of math
+mode by mistake. \TeX\ will insert a dollar sign and rescan the current token.
+
+@d non_math(#)==vmode+#,hmode+#
+
+@<Math-only cases in non-math modes...@>=
+non_math(sup_mark), non_math(sub_mark), non_math(math_char_num),
+non_math(math_given), non_math(omath_given), 
+non_math(math_comp), non_math(delim_num),
+non_math(left_right), non_math(above), non_math(radical),
+non_math(math_style), non_math(math_choice), non_math(vcenter),
+non_math(non_script), non_math(mkern), non_math(limit_switch),
+non_math(mskip), non_math(math_accent),
+mmode+endv, mmode+par_end, mmode+stop, mmode+vskip, mmode+un_vbox,
+mmode+valign, mmode+hrule
+
+@ @<Declare action...@>=
+procedure insert_dollar_sign;
+begin back_input; cur_tok:=math_shift_token+"$";
+print_err("Missing $ inserted");
+@.Missing \$ inserted@>
+help2("I've inserted a begin-math/end-math symbol since I think")@/
+("you left one out. Proceed, with fingers crossed."); ins_error;
+end;
+
+@ When erroneous situations arise, \TeX\ usually issues an error message
+specific to the particular error. For example, `\.{\\noalign}' should
+not appear in any mode, since it is recognized by the |align_peek| routine
+in all of its legitimate appearances; a special error message is given
+when `\.{\\noalign}' occurs elsewhere. But sometimes the most appropriate
+error message is simply that the user is not allowed to do what he or she
+has attempted. For example, `\.{\\moveleft}' is allowed only in vertical mode,
+and `\.{\\lower}' only in non-vertical modes.  Such cases are enumerated
+here and in the other sections referred to under `See also \dots.'
+
+@<Forbidden cases...@>=
+vmode+vmove,hmode+hmove,mmode+hmove,any_mode(last_item),
+
+@ The `|you_cant|' procedure prints a line saying that the current command
+is illegal in the current mode; it identifies these things symbolically.
+
+@<Declare action...@>=
+procedure you_cant;
+begin print_err("You can't use `");
+@.You can't use x in y mode@>
+print_cmd_chr(cur_cmd,cur_chr);
+print("' in "); print_mode(mode);
+end;
+
+@ @<Declare act...@>=
+procedure report_illegal_case;
+begin you_cant;
+help4("Sorry, but I'm not programmed to handle this case;")@/
+("I'll just pretend that you didn't ask for it.")@/
+("If you're in the wrong mode, you might be able to")@/
+("return to the right one by typing `I}' or `I$' or `I\par'.");@/
+error;
+end;
+
+@ Some operations are allowed only in privileged modes, i.e., in cases
+that |mode>0|. The |privileged| function is used to detect violations
+of this rule; it issues an error message and returns |false| if the
+current |mode| is negative.
+
+@<Declare act...@>=
+function privileged:boolean;
+begin if mode>0 then privileged:=true
+else  begin report_illegal_case; privileged:=false;
+  end;
+end;
+
+@ Either \.{\\dump} or \.{\\end} will cause |main_control| to enter the
+endgame, since both of them have `|stop|' as their command code.
+
+@<Put each...@>=
+primitive("end",stop,0);@/
+@!@:end_}{\.{\\end} primitive@>
+primitive("dump",stop,1);@/
+@!@:dump_}{\.{\\dump} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+stop:if chr_code=1 then print_esc("dump")@+else print_esc("end");
+
+@ We don't want to leave |main_control| immediately when a |stop| command
+is sensed, because it may be necessary to invoke an \.{\\output} routine
+several times before things really grind to a halt. (The output routine
+might even say `\.{\\gdef\\end\{...\}}', to prolong the life of the job.)
+Therefore |its_all_over| is |true| only when the current page
+and contribution list are empty, and when the last output was not a
+``dead cycle.''
+
+@<Declare act...@>=
+function its_all_over:boolean; {do this when \.{\\end} or \.{\\dump} occurs}
+label exit;
+begin if privileged then
+  begin if (page_head=page_tail)and(head=tail)and(dead_cycles=0) then
+    begin its_all_over:=true; return;
+    end;
+  back_input; {we will try to end again after ejecting residual material}
+  tail_append(new_null_box);
+  width(tail):=hsize;
+  tail_append(new_glue(fill_glue));
+  tail_append(new_penalty(-@'10000000000));@/
+  build_page; {append \.{\\hbox to \\hsize\{\}\\vfill\\penalty-'10000000000}}
+  end;
+its_all_over:=false;
+exit:end;
+
+@* \[47] Building boxes and lists.
+The most important parts of |main_control| are concerned with \TeX's
+chief mission of box-making. We need to control the activities that put
+entries on vlists and hlists, as well as the activities that convert
+those lists into boxes. All of the necessary machinery has already been
+developed; it remains for us to ``push the buttons'' at the right times.
+
+@ As an introduction to these routines, let's consider one of the simplest
+cases: What happens when `\.{\\hrule}' occurs in vertical mode, or
+`\.{\\vrule}' in horizontal mode or math mode? The code in |main_control|
+is short, since the |scan_rule_spec| routine already does most of what is
+required; thus, there is no need for a special action procedure.
+
+Note that baselineskip calculations are disabled after a rule in vertical
+mode, by setting |prev_depth:=ignore_depth|.
+
+@<Cases of |main_control| that build...@>=
+vmode+hrule,hmode+vrule,mmode+vrule: begin tail_append(scan_rule_spec);
+  if abs(mode)=vmode then prev_depth:=ignore_depth
+  else if abs(mode)=hmode then space_factor:=1000;
+  end;
+
+@ The processing of things like \.{\\hskip} and \.{\\vskip} is slightly
+more complicated. But the code in |main_control| is very short, since
+it simply calls on the action routine |append_glue|. Similarly, \.{\\kern}
+activates |append_kern|.
+
+@<Cases of |main_control| that build...@>=
+vmode+vskip,hmode+hskip,mmode+hskip,mmode+mskip: append_glue;
+any_mode(kern),mmode+mkern: append_kern;
+
+@ The |hskip| and |vskip| command codes are used for control sequences
+like \.{\\hss} and \.{\\vfil} as well as for \.{\\hskip} and \.{\\vskip}.
+The difference is in the value of |cur_chr|.
+
+@d fil_code=0 {identifies \.{\\hfil} and \.{\\vfil}}
+@d fill_code=1 {identifies \.{\\hfill} and \.{\\vfill}}
+@d ss_code=2 {identifies \.{\\hss} and \.{\\vss}}
+@d fil_neg_code=3 {identifies \.{\\hfilneg} and \.{\\vfilneg}}
+@d skip_code=4 {identifies \.{\\hskip} and \.{\\vskip}}
+@d mskip_code=5 {identifies \.{\\mskip}}
+
+@<Put each...@>=
+primitive("hskip",hskip,skip_code);@/
+@!@:hskip_}{\.{\\hskip} primitive@>
+primitive("hfil",hskip,fil_code);
+@!@:hfil_}{\.{\\hfil} primitive@>
+primitive("hfill",hskip,fill_code);@/
+@!@:hfill_}{\.{\\hfill} primitive@>
+primitive("hss",hskip,ss_code);
+@!@:hss_}{\.{\\hss} primitive@>
+primitive("hfilneg",hskip,fil_neg_code);@/
+@!@:hfil_neg_}{\.{\\hfilneg} primitive@>
+primitive("vskip",vskip,skip_code);@/
+@!@:vskip_}{\.{\\vskip} primitive@>
+primitive("vfil",vskip,fil_code);
+@!@:vfil_}{\.{\\vfil} primitive@>
+primitive("vfill",vskip,fill_code);@/
+@!@:vfill_}{\.{\\vfill} primitive@>
+primitive("vss",vskip,ss_code);
+@!@:vss_}{\.{\\vss} primitive@>
+primitive("vfilneg",vskip,fil_neg_code);@/
+@!@:vfil_neg_}{\.{\\vfilneg} primitive@>
+primitive("mskip",mskip,mskip_code);@/
+@!@:mskip_}{\.{\\mskip} primitive@>
+primitive("kern",kern,explicit);
+@!@:kern_}{\.{\\kern} primitive@>
+primitive("mkern",mkern,mu_glue);@/
+@!@:mkern_}{\.{\\mkern} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hskip: case chr_code of
+  skip_code:print_esc("hskip");
+  fil_code:print_esc("hfil");
+  fill_code:print_esc("hfill");
+  ss_code:print_esc("hss");
+  othercases print_esc("hfilneg")
+  endcases;
+vskip: case chr_code of
+  skip_code:print_esc("vskip");
+  fil_code:print_esc("vfil");
+  fill_code:print_esc("vfill");
+  ss_code:print_esc("vss");
+  othercases print_esc("vfilneg")
+  endcases;
+mskip: print_esc("mskip");
+kern: print_esc("kern");
+mkern: print_esc("mkern");
+
+@ All the work relating to glue creation has been relegated to the
+following subroutine. It does not call |build_page|, because it is
+used in at least one place where that would be a mistake.
+
+@<Declare action...@>=
+procedure append_glue;
+var s:small_number; {modifier of skip command}
+begin s:=cur_chr;
+case s of
+fil_code: cur_val:=fil_glue;
+fill_code: cur_val:=fill_glue;
+ss_code: cur_val:=ss_glue;
+fil_neg_code: cur_val:=fil_neg_glue;
+skip_code: scan_glue(glue_val);
+mskip_code: scan_glue(mu_val);
+end; {now |cur_val| points to the glue specification}
+tail_append(new_glue(cur_val));
+if s>=skip_code then
+  begin decr(glue_ref_count(cur_val));
+  if s>skip_code then subtype(tail):=mu_glue;
+  end;
+end;
+
+@ @<Declare act...@>=
+procedure append_kern;
+var s:quarterword; {|subtype| of the kern node}
+begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
+tail_append(new_kern(cur_val)); subtype(tail):=s;
+end;
+
+@ Many of the actions related to box-making are triggered by the appearance
+of braces in the input. For example, when the user says `\.{\\hbox}
+\.{to} \.{100pt\{$\langle\,\hbox{hlist}\,\rangle$\}}' in vertical mode,
+the information about the box size (100pt, |exactly|) is put onto |save_stack|
+with a level boundary word just above it, and |cur_group:=adjusted_hbox_group|;
+\TeX\ enters restricted horizontal mode to process the hlist. The right
+brace eventually causes |save_stack| to be restored to its former state,
+at which time the information about the box size (100pt, |exactly|) is
+available once again; a box is packaged and we leave restricted horizontal
+mode, appending the new box to the current list of the enclosing mode
+(in this case to the current list of vertical mode), followed by any
+vertical adjustments that were removed from the box by |hpack|.
+
+The next few sections of the program are therefore concerned with the
+treatment of left and right curly braces.
+
+@ If a left brace occurs in the middle of a page or paragraph, it simply
+introduces a new level of grouping, and the matching right brace will not have
+such a drastic effect. Such grouping affects neither the mode nor the
+current list.
+
+@<Cases of |main_control| that build...@>=
+non_math(left_brace): begin
+  new_save_level(simple_group);
+  eq_word_define(int_base+no_local_whatsits_code,0);
+  eq_word_define(int_base+no_local_dirs_code,0);
+  end;
+any_mode(begin_group): begin
+  new_save_level(semi_simple_group);
+  eq_word_define(int_base+no_local_whatsits_code,0);
+  eq_word_define(int_base+no_local_dirs_code,0);
+  end;
+any_mode(end_group):
+  if cur_group=semi_simple_group then begin
+    temp_no_whatsits:=no_local_whatsits;
+    temp_no_dirs:=no_local_dirs;
+    temporary_dir:=text_direction;
+    if dir_level(text_dir_ptr)=cur_level then
+      @<DIR: Remove from |text_dir_ptr|@>;
+    unsave;
+    if abs(mode)=hmode then begin
+      if temp_no_dirs<>0 then begin
+        @<DIR: Add local dir node@>;
+        dir_dir(tail):=temporary_dir-64;
+        end;
+      if temp_no_whatsits<>0 then
+        @<LOCAL: Add local paragraph node@>;
+      end
+    end
+  else off_save;
+
+@ We have to deal with errors in which braces and such things are not
+properly nested. Sometimes the user makes an error of commission by
+inserting an extra symbol, but sometimes the user makes an error of omission.
+\TeX\ can't always tell one from the other, so it makes a guess and tries
+to avoid getting into a loop.
+
+The |off_save| routine is called when the current group code is wrong. It tries
+to insert something into the user's input that will help clean off
+the top level.
+
+@<Declare act...@>=
+procedure off_save;
+var p,q:pointer; {inserted token}
+begin if cur_group=bottom_level then
+  @<Drop current token and complain that it was unmatched@>
+else  begin back_input; p:=get_avail; link(temp_token_head):=p;
+  print_err("Missing ");
+  @<Prepare to insert a token that matches |cur_group|,
+    and print what it is@>;
+  print(" inserted"); ins_list(link(temp_token_head));
+  help5("I've inserted something that you may have forgotten.")@/
+  ("(See the <inserted text> above.)")@/
+  ("With luck, this will get me unwedged. But if you")@/
+  ("really didn't forget anything, try typing `2' now; then")@/
+  ("my insertion and my current dilemma will both disappear.");
+  error;
+  end;
+end;
+
+@ At this point, |link(temp_token_head)=p|, a pointer to an empty one-word node.
+
+@<Prepare to insert a token that matches |cur_group|...@>=
+case cur_group of
+semi_simple_group: begin info(p):=cs_token_flag+frozen_end_group;
+  print_esc("endgroup");
+@.Missing \\endgroup inserted@>
+  end;
+math_shift_group: begin info(p):=math_shift_token+"$"; print_char("$");
+@.Missing \$ inserted@>
+  end;
+math_left_group: begin info(p):=cs_token_flag+frozen_right; q:=get_avail; link(p):=q;
+  p:=link(p); info(p):=other_token+"."; print_esc("right.");
+@.Missing \\right\hbox{.} inserted@>
+@^null delimiter@>
+  end;
+othercases begin info(p):=right_brace_token+"}"; print_char("}");
+@.Missing \} inserted@>
+  end
+endcases
+
+@ @<Drop current token and complain that it was unmatched@>=
+begin print_err("Extra "); print_cmd_chr(cur_cmd,cur_chr);
+@.Extra x@>
+help1("Things are pretty mixed up, but I think the worst is over.");@/
+error;
+end
+
+@ The routine for a |right_brace| character branches into many subcases,
+since a variety of things may happen, depending on |cur_group|. Some
+types of groups are not supposed to be ended by a right brace; error
+messages are given in hopes of pinpointing the problem. Most branches
+of this routine will be filled in later, when we are ready to understand
+them; meanwhile, we must prepare ourselves to deal with such errors.
+
+@<Cases of |main_control| that build...@>=
+any_mode(right_brace): handle_right_brace;
+
+@ @<Declare the procedure called |handle_right_brace|@>=
+procedure handle_right_brace;
+var p,@!q:pointer; {for short-term use}
+@!d:scaled; {holds |split_max_depth| in |insert_group|}
+@!f:integer; {holds |floating_penalty| in |insert_group|}
+begin case cur_group of
+simple_group: begin
+  temp_no_whatsits:=no_local_whatsits;
+  temp_no_dirs:=no_local_dirs;
+  temporary_dir:=text_direction;
+  if dir_level(text_dir_ptr)=cur_level then
+    @<DIR: Remove from |text_dir_ptr|@>;
+  unsave;
+  if abs(mode)=hmode then begin
+    if temp_no_dirs<>0 then begin
+      @<DIR: Add local dir node@>;
+      dir_dir(tail):=temporary_dir-64;
+      end;
+    if temp_no_whatsits<>0 then
+      @<LOCAL: Add local paragraph node@>;
+    end
+  end;
+bottom_level: begin print_err("Too many }'s");
+@.Too many \}'s@>
+  help2("You've closed more groups than you opened.")@/
+  ("Such booboos are generally harmless, so keep going."); error;
+  end;
+semi_simple_group,math_shift_group,math_left_group: extra_right_brace;
+@t\4@>@<Cases of |handle_right_brace| where a |right_brace| triggers
+  a delayed action@>@;
+othercases confusion("rightbrace")
+@:this can't happen rightbrace}{\quad rightbrace@>
+endcases;
+end;
+
+@ @<Declare act...@>=
+procedure extra_right_brace;
+begin print_err("Extra }, or forgotten ");
+@.Extra \}, or forgotten x@>
+case cur_group of
+semi_simple_group: print_esc("endgroup");
+math_shift_group: print_char("$");
+math_left_group: print_esc("right");
+end;@/
+help5("I've deleted a group-closing symbol because it seems to be")@/
+("spurious, as in `$x}$'. But perhaps the } is legitimate and")@/
+("you forgot something else, as in `\hbox{$x}'. In such cases")@/
+("the way to recover is to insert both the forgotten and the")@/
+("deleted material, e.g., by typing `I$}'."); error;
+incr(align_state);
+end;
+
+@ Here is where we clear the parameters that are supposed to revert to their
+default values after every paragraph and when internal vertical mode is entered.
+
+@<Declare act...@>=
+procedure normal_paragraph;
+begin if looseness<>0 then eq_word_define(int_base+looseness_code,0);
+if hang_indent<>0 then eq_word_define(dimen_base+hang_indent_code,0);
+if hang_after<>1 then eq_word_define(int_base+hang_after_code,1);
+if par_shape_ptr<>null then eq_define(par_shape_loc,shape_ref,null);
+if inter_line_penalties_ptr<>null then
+  eq_define(inter_line_penalties_loc,shape_ref,null);
+end;
+
+@ Now let's turn to the question of how \.{\\hbox} is treated. We actually
+need to consider also a slightly larger context, since constructions like
+`\.{\\setbox3=}\penalty0\.{\\hbox...}' and
+`\.{\\leaders}\penalty0\.{\\hbox...}' and
+`\.{\\lower3.8pt\\hbox...}'
+are supposed to invoke quite
+different actions after the box has been packaged. Conversely,
+constructions like `\.{\\setbox3=}' can be followed by a variety of
+different kinds of boxes, and we would like to encode such things in an
+efficient way.
+
+In other words, there are two problems: To represent the context of a box,
+and to represent its type.
+
+The first problem is solved by putting a ``context code'' on the |save_stack|,
+just below the two entries that give the dimensions produced by |scan_spec|.
+The context code is either a (signed) shift amount, or it is a large
+integer |>=box_flag|, where |box_flag=@t$2^{30}$@>|. Codes |box_flag| through
+|box_flag+biggest_reg| represent `\.{\\setbox0}' through
+`\.{\\setbox}|biggest_reg|'; codes |box_flag+biggest_reg+1| through
+|box_flag+2*biggest_reg| represent `\.{\\global\\setbox0}'
+through `\.{\\global\\setbox}|biggest_reg|'; code |box_flag+2*number_regs|
+represents `\.{\\shipout}'; and codes |box_flag+2*number_regs+1|
+through |box_flag+2*number_regs+3| represent `\.{\\leaders}', `\.{\\cleaders}',
+and `\.{\\xleaders}'.
+
+The second problem is solved by giving the command code |make_box| to all
+control sequences that produce a box, and by using the following |chr_code|
+values to distinguish between them: |box_code|, |copy_code|, |last_box_code|,
+|vsplit_code|, |vtop_code|, |vtop_code+vmode|, and |vtop_code+hmode|,
+where the latter two are used denote \.{\\vbox} and \.{\\hbox}, respectively.
+
+@d box_flag==@'10000000000 {context code for `\.{\\setbox0}'}
+@d global_box_flag==(box_flag+number_regs) {context code for `\.{\\global\\setbox0}'}
+@d max_global_box_flag==(global_box_flag+number_regs)
+@d ship_out_flag==(max_global_box_flag+1) {context code for `\.{\\shipout}'}
+@d leader_flag==ship_out_flag+1 {context code for `\.{\\leaders}'}
+@d box_code=0 {|chr_code| for `\.{\\box}'}
+@d copy_code=1 {|chr_code| for `\.{\\copy}'}
+@d last_box_code=2 {|chr_code| for `\.{\\lastbox}'}
+@d vsplit_code=3 {|chr_code| for `\.{\\vsplit}'}
+@d vtop_code=4 {|chr_code| for `\.{\\vtop}'}
+
+@<Put each...@>=
+primitive("moveleft",hmove,1);
+@!@:move_left_}{\.{\\moveleft} primitive@>
+primitive("moveright",hmove,0);@/
+@!@:move_right_}{\.{\\moveright} primitive@>
+primitive("raise",vmove,1);
+@!@:raise_}{\.{\\raise} primitive@>
+primitive("lower",vmove,0);
+@!@:lower_}{\.{\\lower} primitive@>
+@#
+primitive("box",make_box,box_code);
+@!@:box_}{\.{\\box} primitive@>
+primitive("copy",make_box,copy_code);
+@!@:copy_}{\.{\\copy} primitive@>
+primitive("lastbox",make_box,last_box_code);
+@!@:last_box_}{\.{\\lastbox} primitive@>
+primitive("vsplit",make_box,vsplit_code);
+@!@:vsplit_}{\.{\\vsplit} primitive@>
+primitive("vtop",make_box,vtop_code);@/
+@!@:vtop_}{\.{\\vtop} primitive@>
+primitive("vbox",make_box,vtop_code+vmode);
+@!@:vbox_}{\.{\\vbox} primitive@>
+primitive("hbox",make_box,vtop_code+hmode);@/
+@!@:hbox_}{\.{\\hbox} primitive@>
+primitive("shipout",leader_ship,a_leaders-1); {|ship_out_flag=leader_flag-1|}
+@!@:ship_out_}{\.{\\shipout} primitive@>
+primitive("leaders",leader_ship,a_leaders);
+@!@:leaders_}{\.{\\leaders} primitive@>
+primitive("cleaders",leader_ship,c_leaders);
+@!@:c_leaders_}{\.{\\cleaders} primitive@>
+primitive("xleaders",leader_ship,x_leaders);
+@!@:x_leaders_}{\.{\\xleaders} primitive@>;
+primitive("boxdir",assign_box_dir,0);
+@!@:box_dir}{\.{\\boxdir} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hmove: if chr_code=1 then print_esc("moveleft")@+else print_esc("moveright");
+vmove: if chr_code=1 then print_esc("raise")@+else print_esc("lower");
+make_box: case chr_code of
+  box_code: print_esc("box");
+  copy_code: print_esc("copy");
+  last_box_code: print_esc("lastbox");
+  vsplit_code: print_esc("vsplit");
+  vtop_code: print_esc("vtop");
+  vtop_code+vmode: print_esc("vbox");
+  othercases print_esc("hbox")
+  endcases;
+leader_ship: if chr_code=a_leaders then print_esc("leaders")
+  else if chr_code=c_leaders then print_esc("cleaders")
+  else if chr_code=x_leaders then print_esc("xleaders")
+  else print_esc("shipout");
+
+@ Constructions that require a box are started by calling |scan_box| with
+a specified context code. The |scan_box| routine verifies
+that a |make_box| command comes next and then it calls |begin_box|.
+
+@<Cases of |main_control| that build...@>=
+vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
+  scan_normal_dimen;
+  if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
+  end;
+any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
+any_mode(make_box): begin_box(0);
+any_mode(assign_box_dir): begin scan_register_num;
+  cur_box:=box(cur_val);
+  scan_optional_equals; scan_direction;
+  if cur_box<>null then box_dir(cur_box):=cur_val;
+  end;
+
+@ The global variable |cur_box| will point to a newly-made box. If the box
+is void, we will have |cur_box=null|. Otherwise we will have
+|type(cur_box)=hlist_node| or |vlist_node| or |rule_node|; the |rule_node|
+case can occur only with leaders.
+
+@<Glob...@>=
+@!cur_box:pointer; {box to be placed into its context}
+
+@ The |box_end| procedure does the right thing with |cur_box|, if
+|box_context| represents the context as explained above.
+
+@<Declare act...@>=
+procedure box_end(@!box_context:integer);
+var p:pointer; {|ord_noad| for new box in math mode}
+begin if box_context<box_flag then @<Append box |cur_box| to the current list,
+    shifted by |box_context|@>
+else if box_context<ship_out_flag then @<Store \(c)|cur_box| in a box register@>
+else if cur_box<>null then
+  if box_context>ship_out_flag then @<Append a new leader node that
+      uses |cur_box|@>
+  else ship_out(cur_box);
+end;
+
+@ The global variable |adjust_tail| will be non-null if and only if the
+current box might include adjustments that should be appended to the
+current vertical list.
+
+@<Append box |cur_box| to the current...@>=
+begin if cur_box<>null then
+  begin shift_amount(cur_box):=box_context;
+  if abs(mode)=vmode then
+    begin
+        if pre_adjust_tail <> null then begin
+            if pre_adjust_head <> pre_adjust_tail then
+                append_list(pre_adjust_head)(pre_adjust_tail);
+            pre_adjust_tail := null;
+        end;
+        append_to_vlist(cur_box);
+        if adjust_tail <> null then begin
+            if adjust_head <> adjust_tail then
+                append_list(adjust_head)(adjust_tail);
+            adjust_tail := null;
+        end;
+    if mode>0 then begin check_filter('box'); build_page; end;
+    end
+  else  begin if abs(mode)=hmode then space_factor:=1000
+    else  begin p:=new_noad;
+      math_type(nucleus(p)):=sub_box;
+      vinfo(nucleus(p)):=cur_box; cur_box:=p;
+      end;
+    vlink(tail):=cur_box; tail:=cur_box;
+    end;
+  end;
+end
+
+@ @<Store \(c)|cur_box| in a box register@>=
+if box_context<global_box_flag then
+  eq_define(box_base+box_context-box_flag,box_ref,cur_box)
+else geq_define(box_base+box_context-global_box_flag,box_ref,cur_box)
+
+@ @<Append a new leader node ...@>=
+begin @<Get the next non-blank non-relax...@>;
+if ((cur_cmd=hskip)and(abs(mode)<>vmode))or@|
+   ((cur_cmd=vskip)and(abs(mode)=vmode))or@|
+   ((cur_cmd=mskip)and(abs(mode)=mmode)) then
+  begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders);
+  leader_ptr(tail):=cur_box;
+  end
+else  begin print_err("Leaders not followed by proper glue");
+@.Leaders not followed by...@>
+  help3("You should say `\leaders <box or rule><hskip or vskip>'.")@/
+  ("I found the <box or rule>, but there's no suitable")@/
+  ("<hskip or vskip>, so I'm ignoring these leaders."); back_error;
+  flush_node_list(cur_box);
+  end;
+end
+
+@ Now that we can see what eventually happens to boxes, we can consider
+the first steps in their creation. The |begin_box| routine is called when
+|box_context| is a context specification, |cur_chr| specifies the type of
+box desired, and |cur_cmd=make_box|.
+
+@<Declare act...@>=
+procedure begin_box(@!box_context:integer);
+label exit, done;
+var @!p,@!q:pointer; {run through the current list}
+@!k:halfword; {0 or |vmode| or |hmode|}
+@!n:eight_bits; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; cur_box:=box(cur_val);
+  box(cur_val):=null; {the box becomes void, at the same level}
+  end;
+copy_code: begin scan_register_num; cur_box:=copy_node_list(box(cur_val));
+  end;
+last_box_code: @<If the current list ends with a box node, delete it from
+  the list and make |cur_box| point to it; otherwise set |cur_box:=null|@>;
+vsplit_code: @<Split off part of a vertical box, make |cur_box| point to it@>;
+othercases @<Initiate the construction of an hbox or vbox, then |return|@>
+endcases;@/
+box_end(box_context); {in simple cases, we use the box immediately}
+exit:end;
+
+@ Note that the condition |not is_char_node(tail)| implies that |head<>tail|,
+since |head| is a one-word node.
+
+@<If the current list ends with a box node, delete it...@>=
+begin cur_box:=null;
+if abs(mode)=mmode then
+  begin you_cant; help1("Sorry; this \lastbox will be void."); error;
+  end
+else if (mode=vmode)and(head=tail) then
+  begin you_cant;
+  help2("Sorry...I usually can't take things from the current page.")@/
+    ("This \lastbox will therefore be void."); error;
+  end
+else  begin if not is_char_node(tail) then
+    if (type(tail)=hlist_node)or(type(tail)=vlist_node) then
+      @<Remove the last box, unless it's part of a discretionary@>;
+  end;
+end
+
+@ @<Remove the last box...@>=
+begin q:=head;
+repeat p:=q;
+if not is_char_node(q) then if type(q)=disc_node then
+  begin 
+  if p=tail then goto done;
+  end;
+q:=vlink(p);
+until q=tail;
+cur_box:=tail; shift_amount(cur_box):=0;
+tail:=p; vlink(p):=null;
+done:end
+
+@ Here we deal with things like `\.{\\vsplit 13 to 100pt}'.
+
+@<Split off part of a vertical box, make |cur_box| point to it@>=
+begin scan_register_num; n:=cur_val;
+if not scan_keyword("to") then
+@.to@>
+  begin print_err("Missing `to' inserted");
+@.Missing `to' inserted@>
+  help2("I'm working on `\vsplit<box number> to <dimen>';")@/
+  ("will look for the <dimen> next."); error;
+  end;
+scan_normal_dimen;
+cur_box:=vsplit(n,cur_val);
+end
+
+@ Here is where we enter restricted horizontal mode or internal vertical
+mode, in order to make a box.
+
+@<Initiate the construction of an hbox or vbox, then |return|@>=
+begin k:=cur_chr-vtop_code; saved(0):=box_context;
+case abs(mode) of
+vmode: spec_direction:=body_direction;
+hmode: spec_direction:=text_direction;
+mmode: spec_direction:=math_direction;
+end;
+if k=hmode then
+  if (box_context<box_flag)and(abs(mode)=vmode) then
+    scan_spec(adjusted_hbox_group,true)
+  else scan_spec(hbox_group,true)
+else  begin if k=vmode then scan_spec(vbox_group,true)
+  else  begin scan_spec(vtop_group,true); k:=vmode;
+    end;
+  normal_paragraph;
+  end;
+push_nest; mode:=-k;
+if k=vmode then
+  begin prev_depth:=ignore_depth;
+  if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+  end
+else  begin space_factor:=1000;
+  if every_hbox<>null then begin_token_list(every_hbox,every_hbox_text);
+  end;
+return;
+end
+
+@ @<Declare act...@>=
+procedure scan_box(@!box_context:integer);
+  {the next input should specify a box or perhaps a rule}
+begin @<Get the next non-blank non-relax...@>;
+if cur_cmd=make_box then begin_box(box_context)
+else if (box_context>=leader_flag)and((cur_cmd=hrule)or(cur_cmd=vrule)) then
+  begin cur_box:=scan_rule_spec; box_end(box_context);
+  end
+else  begin@t@>@;@/
+  print_err("A <box> was supposed to be here");@/
+@.A <box> was supposed to...@>
+  help3("I was expecting to see \hbox or \vbox or \copy or \box or")@/
+  ("something like that. So you might find something missing in")@/
+  ("your output. But keep trying; you can fix this later."); back_error;
+  end;
+end;
+
+@ When the right brace occurs at the end of an \.{\\hbox} or \.{\\vbox} or
+\.{\\vtop} construction, the |package| routine comes into action. We might
+also have to finish a paragraph that hasn't ended.
+
+@<Cases of |handle...@>=
+hbox_group: package(0);
+adjusted_hbox_group: begin adjust_tail:=adjust_head;
+    pre_adjust_tail:=pre_adjust_head; package(0);
+  end;
+vbox_group: begin line_break_context:=vbox_group; end_graf; package(0);
+  end;
+vtop_group: begin line_break_context:=vtop_group; end_graf; package(vtop_code);
+  end;
+
+@ @<Declare action...@>=
+procedure package(@!c:small_number);
+var h:scaled; {height of box}
+@!p:pointer; {first node in a box}
+@!d:scaled; {max depth}
+@!grp:integer;
+begin grp:=cur_group;
+d:=box_max_depth; unsave; save_ptr:=save_ptr-6;
+pack_direction:=saved(3);
+if mode=-hmode then cur_box:=filtered_hpack(head,tail,saved(2),saved(1),grp)
+else  begin cur_box:=filtered_vpackage(vlink(head),saved(2),saved(1),d,grp);
+  if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+    for \.{\\vtop}@>;
+  end;
+if saved(4)<>null then
+  @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>;
+replace_attribute_list(cur_box, saved(5)); 
+pop_nest; box_end(saved(0));
+end;
+
+@ The height of a `\.{\\vtop}' box is inherited from the first item on its list,
+if that item is an |hlist_node|, |vlist_node|, or |rule_node|; otherwise
+the \.{\\vtop} height is zero.
+
+
+@<Readjust the height...@>=
+begin h:=0; p:=list_ptr(cur_box);
+if p<>null then if type(p)<=rule_node then h:=height(p);
+depth(cur_box):=depth(cur_box)-h+height(cur_box); height(cur_box):=h;
+end
+
+@ Here is a really small patch to add a new primitive called
+\.{\\quitvmode}. In vertical modes, it is identical to \.{\\indent},
+but in horizontal and math modes it is really a no-op (as opposed to
+\.{\\indent}, which executes the |indent_in_hmode| procedure).
+
+A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\quitvmode}',
+`\.{\\indent}' or `\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+primitive("quitvmode",start_par,2);
+@!@:quit_vmode_}{\.{\\quitvmode} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+start_par: if chr_code=0 then print_esc("noindent")@+ else if chr_code=1 then print_esc("indent")@+ else print_esc("quitvmode");
+
+@ @<Cases of |main_control| that build...@>=
+vmode+start_par: new_graf(cur_chr>0);
+vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given,
+   vmode+char_ghost,
+   vmode+math_shift,vmode+un_hbox,vmode+vrule,
+   vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign,
+   vmode+ex_space,vmode+no_boundary:@t@>@;@/
+  begin back_input; new_graf(true);
+  end;
+
+@ @<Declare act...@>=
+procedure new_graf(@!indented:boolean);
+var p,q,dir_graf_tmp:pointer;
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then begin
+  tail_append(new_param_glue(par_skip_code));
+  if nest_ptr=0 then
+    check_filter('begin_of_par'); 
+  end;
+push_nest; mode:=hmode; space_factor:=1000; 
+@<LOCAL: Add local paragraph node@>;
+if indented then begin
+  p:=new_null_box; box_dir(p):=par_direction;
+  width(p):=par_indent;@+
+  tail_append(p);
+  end;
+q:=tail;
+dir_rover:=text_dir_ptr;
+while dir_rover<>null do
+  begin
+  if (vlink(dir_rover)<>null) or (dir_dir(dir_rover)<>par_direction) then
+    begin
+    dir_graf_tmp:=new_dir(dir_dir(dir_rover));
+    vlink(dir_graf_tmp):=vlink(q); vlink(q):=dir_graf_tmp;
+    end;
+  dir_rover:=vlink(dir_rover);
+  end;
+q:=head;
+while vlink(q)<>null do q:=vlink(q);
+tail:=q;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then begin 
+  build_page; {put |par_skip| glue on current page}
+  end;
+end;
+
+@ @<Cases of |main_control| that build...@>=
+hmode+start_par,mmode+start_par: if cur_chr<>2 then indent_in_hmode;
+
+@ @<Declare act...@>=
+procedure indent_in_hmode;
+var p,@!q:pointer;
+begin if cur_chr>0 then {\.{\\indent}}
+  begin p:=new_null_box; width(p):=par_indent;
+  if abs(mode)=hmode then space_factor:=1000
+  else  begin q:=new_noad; math_type(nucleus(q)):=sub_box;
+    vinfo(nucleus(q)):=p; p:=q;
+    end;
+  tail_append(p);
+  end;
+end;
+
+@ A paragraph ends when a |par_end| command is sensed, or when we are in
+horizontal mode when reaching the right brace of vertical-mode routines
+like \.{\\vbox}, \.{\\insert}, or \.{\\output}.
+
+@<Cases of |main_control| that build...@>=
+vmode+par_end: begin normal_paragraph;
+  if mode>0 then begin check_filter('vmode_par'); build_page; end;
+  end;
+hmode+par_end: begin if align_state<0 then off_save; {this tries to
+    recover from an alignment that didn't end properly}
+  if (mode>0) and (nest[(nest_ptr-1)].mode_field=vmode) then
+	  line_break_context:=bottom_level;
+  end_graf; {this takes us to the enclosing mode, if |mode>0|}
+  if mode=vmode then begin check_filter('hmode_par');  build_page; end;
+  end;
+hmode+stop,hmode+vskip,hmode+hrule,hmode+un_vbox,hmode+halign: head_for_vmode;
+
+@ @<Declare act...@>=
+procedure head_for_vmode;
+begin if mode<0 then
+  if cur_cmd<>hrule then off_save
+  else  begin print_err("You can't use `");
+    print_esc("hrule"); print("' here except with leaders");
+@.You can't use \\hrule...@>
+    help2("To put a horizontal rule in an hbox or an alignment,")@/
+      ("you should use \leaders or \hrulefill (see The TeXbook).");
+    error;
+    end
+else  begin back_input; cur_tok:=par_token; back_input; token_type:=inserted;
+  end;
+end;
+
+@ TODO (BUG?): |dir_save| would have been set by |line_break| by means
+of |post_line_break|, but this is not done right now, as it introduces
+pretty heavy memory leaks. This means the current code is probably
+wrong in some way that relates to in-paragraph displays.
+ 
+@<Declare act...@>=
+procedure end_graf;
+begin if mode=hmode then
+  begin if (head=tail) or (vlink(head)=tail) then pop_nest
+        {null paragraphs are ignored, all contain a |local_paragraph| node}
+  else line_break(false);
+  if dir_save<>null then
+    begin flush_node_list(dir_save); dir_save:=null;
+    end;
+  normal_paragraph;
+  error_count:=0;
+  end;
+end;
+
+@ Insertion and adjustment and mark nodes are constructed by the following
+pieces of the program.
+
+@<Cases of |main_control| that build...@>=
+any_mode(insert),hmode+vadjust,mmode+vadjust: begin_insert_or_adjust;
+any_mode(mark): handle_mark;
+
+@ @<Forbidden...@>=
+vmode+vadjust,
+
+@ @<Declare act...@>=
+procedure begin_insert_or_adjust;
+begin if cur_cmd=vadjust then cur_val:=255
+else  begin scan_register_num;
+  if cur_val=255 then
+    begin print_err("You can't "); print_esc("insert"); print_int(255);
+@.You can't \\insert255@>
+    help1("I'm changing to \insert0; box 255 is special.");
+    error; cur_val:=0;
+    end;
+  end;
+saved(0) := cur_val;
+if (cur_cmd = vadjust) and scan_keyword("pre") then
+    saved(1) := 1
+else
+    saved(1) := 0;
+save_ptr := save_ptr + 2;
+new_save_level(insert_group); scan_left_brace; normal_paragraph;
+push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+end;
+
+@ @<Cases of |handle...@>=
+insert_group: begin
+  line_break_context:=insert_group; 
+  end_graf; q:=split_top_skip; add_glue_ref(q);
+  d:=split_max_depth; f:=floating_penalty; unsave; save_ptr := save_ptr - 2;
+  {now |saved(0)| is the insertion number, or 255 for |vadjust|}
+  p:=vpack(vlink(head),natural); pop_nest;
+  if saved(0)<>255 then
+    begin tail_append(new_node(ins_node,saved(0))); 
+    height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p);
+    split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f;
+    end
+  else  begin tail_append(new_node(adjust_node,saved(1))); {the |subtype| is used for |adjust_pre|}
+    adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
+    end;
+  list_ptr(p):=null; flush_node(p);
+  if nest_ptr=0 then begin check_filter('insert'); build_page; end;
+  end;
+output_group: @<Resume the page builder...@>;
+
+@ I've renamed the |make_mark| procedure to this, because if the
+current chr code is 1, then the actual command was \.{\\clearmarks},
+which does not generate a mark node but instead destroys the current
+mark tokenlists.
+
+@<Declare act...@>=
+procedure handle_mark;
+var p:pointer; {new node}
+@!c:halfword; {the mark class}
+begin if cur_chr=clear_marks_code then begin
+    scan_mark_num; c:=cur_val;
+    delete_top_mark(c); delete_bot_mark(c); delete_first_mark(c);
+    delete_split_first_mark(c); delete_split_bot_mark(c);
+  end
+else begin
+if cur_chr=0 then c:=0
+else begin scan_mark_num; c:=cur_val;
+  if c > biggest_used_mark then biggest_used_mark := c;
+  end;
+p:=scan_toks(false,true); 
+p:=new_node(mark_node,0); {the |subtype| is not used}
+mark_class(p):=c;
+mark_ptr(p):=def_ref; vlink(tail):=p; tail:=p;
+end;
+end;
+
+@ Penalty nodes get into a list via the |break_penalty| command.
+@^penalties@>
+
+@<Cases of |main_control| that build...@>=
+any_mode(break_penalty): append_penalty;
+
+@ @<Declare action...@>=
+procedure append_penalty;
+begin scan_int; tail_append(new_penalty(cur_val));
+if mode=vmode then begin check_filter('penalty'); build_page; end;
+end;
+
+@ The |remove_item| command removes a penalty, kern, or glue node if it
+appears at the tail of the current list, using a brute-force linear scan.
+Like \.{\\lastbox}, this command is not allowed in vertical mode (except
+internal vertical mode), since the current list in vertical mode is sent
+to the page builder.  But if we happen to be able to implement it in
+vertical mode, we do.
+
+@<Cases of |main_control| that build...@>=
+any_mode(remove_item): delete_last;
+
+@ When |delete_last| is called, |cur_chr| is the |type| of node that
+will be deleted, if present.
+
+@<Declare action...@>=
+procedure delete_last;
+label exit;
+var @!p,@!q:pointer; {run through the current list}
+begin if (mode=vmode)and(tail=head) then
+  @<Apologize for inability to do the operation now,
+    unless \.{\\unskip} follows non-glue@>
+else  begin if not is_char_node(tail) then if type(tail)=cur_chr then
+    begin q:=head;
+    repeat p:=q;
+    if not is_char_node(q) then if type(q)=disc_node then
+      begin
+      if p=tail then return;
+      end;
+    q:=vlink(p);
+    until q=tail;
+    vlink(p):=null; flush_node_list(tail); tail:=p;
+    end;
+  end;
+exit:end;
+
+@ @<Apologize for inability to do the operation...@>=
+begin if (cur_chr<>glue_node)or(last_glue<>max_halfword) then
+  begin you_cant;
+  help2("Sorry...I usually can't take things from the current page.")@/
+    ("Try `I\vskip-\lastskip' instead.");
+  if cur_chr=kern_node then help_line[0]:=
+    ("Try `I\kern-\lastkern' instead.")
+  else if cur_chr<>glue_node then help_line[0]:=@|
+    ("Perhaps you can make the output routine do it.");
+  error;
+  end;
+end
+
+@ @<Put each...@>=
+primitive("unpenalty",remove_item,penalty_node);@/
+@!@:un_penalty_}{\.{\\unpenalty} primitive@>
+primitive("unkern",remove_item,kern_node);@/
+@!@:un_kern_}{\.{\\unkern} primitive@>
+primitive("unskip",remove_item,glue_node);@/
+@!@:un_skip_}{\.{\\unskip} primitive@>
+primitive("unhbox",un_hbox,box_code);@/
+@!@:un_hbox_}{\.{\\unhbox} primitive@>
+primitive("unhcopy",un_hbox,copy_code);@/
+@!@:un_hcopy_}{\.{\\unhcopy} primitive@>
+primitive("unvbox",un_vbox,box_code);@/
+@!@:un_vbox_}{\.{\\unvbox} primitive@>
+primitive("unvcopy",un_vbox,copy_code);@/
+@!@:un_vcopy_}{\.{\\unvcopy} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+remove_item: if chr_code=glue_node then print_esc("unskip")
+  else if chr_code=kern_node then print_esc("unkern")
+  else print_esc("unpenalty");
+un_hbox: if chr_code=copy_code then print_esc("unhcopy")
+  else print_esc("unhbox");
+un_vbox: if chr_code=copy_code then print_esc("unvcopy")
+  @<Cases of |un_vbox| for |print_cmd_chr|@>@/
+  else print_esc("unvbox");
+
+@ The |un_hbox| and |un_vbox| commands unwrap one of the |number_regs| current boxes.
+
+@<Cases of |main_control| that build...@>=
+vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage;
+
+@ @<Declare act...@>=
+procedure unpackage;
+label done, exit;
+var p:pointer; {the box}
+    r: pointer; {to remove marginal kern nodes}
+@!c:box_code..copy_code; {should we copy?}
+@!s:pointer; {for varmem assignment }
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; p:=box(cur_val);
+if p=null then return;
+if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
+   ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
+  begin print_err("Incompatible list can't be unboxed");
+@.Incompatible list...@>
+  help3("Sorry, Pandora. (You sneaky devil.)")@/
+  ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
+  ("And I can't open any boxes in math mode.");@/
+  error; return;
+  end;
+if c=copy_code then begin s:=copy_node_list(list_ptr(p)); vlink(tail):=s; end
+else  begin vlink(tail):=list_ptr(p); box(cur_val):=null;
+  list_ptr(p):=null; flush_node(p);
+  end;
+done:
+while vlink(tail) <> null do begin
+    r := vlink(tail);
+    if not is_char_node(r) and (type(r) = margin_kern_node) then begin
+        vlink(tail) := vlink(r);
+        flush_node(r);
+    end;
+    tail:=vlink(tail);
+end;
+exit:end;
+
+@ @<Forbidden...@>=vmode+ital_corr,
+
+@ Italic corrections are converted to kern nodes when the |ital_corr| command
+follows a character. In math mode the same effect is achieved by appending
+a kern of zero here, since italic corrections are supplied later.
+
+@<Cases of |main_control| that build...@>=
+hmode+ital_corr: append_italic_correction;
+mmode+ital_corr: tail_append(new_kern(0));
+
+@ @<Declare act...@>=
+procedure append_italic_correction;
+label exit;
+var p:pointer; {|char_node| at the tail of the current list}
+@!f:internal_font_number; {the font in the |char_node|}
+begin if tail<>head then
+  begin if is_char_node(tail) then p:=tail
+  else return;
+  f:=font(p);
+  tail_append(new_kern(char_italic(f,character(p))));
+  subtype(tail):=explicit;
+  end;
+exit:end;
+
+@ Discretionary nodes are easy in the common case `\.{\\-}', but in the
+general case we must process three braces full of items.
+
+There are four subtypes of discretionaries, but only the first two are
+generated by primitive commands.
+
+@d discretionary_disc=0
+@d explicit_disc=1
+
+@<Put each...@>=
+primitive("-",discretionary,explicit_disc);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,discretionary_disc);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+primitive("localleftbox",assign_local_box,0);
+@!@:assign_local_box}{\.{\\localleftbox} primitive@>
+primitive("localrightbox",assign_local_box,1);
+@!@:assign_local_box}{\.{\\localrightbox} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=explicit_disc then
+  print_esc("-")@+else print_esc("discretionary");
+assign_local_box: if chr_code=0 then print_esc("localleftbox")
+                  else print_esc("localrightbox");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+any_mode(assign_local_box): append_local_box(cur_chr);
+
+@ The space factor does not change when we append a discretionary node,
+but it starts out as 1000 in the subsidiary lists.
+
+@<Declare act...@>=
+procedure append_local_box(kind:integer);
+begin 
+incr(save_ptr); saved(-1):=kind; new_save_level(local_box_group);
+scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+end;
+
+procedure append_discretionary;
+var c:integer;
+begin tail_append(new_disc);
+subtype(tail):=cur_chr;
+if cur_chr=explicit_disc then begin 
+    c:=get_pre_hyphen_char(cur_lang);
+    if c<>0 then begin 
+   	  vlink(pre_break(tail)):=new_char(cur_font,c);
+      alink(vlink(pre_break(tail))):=pre_break(tail);
+   	  tlink(pre_break(tail)):=vlink(pre_break(tail));
+      end;
+    c:=get_post_hyphen_char(cur_lang);
+    if c<>0 then begin
+       vlink(post_break(tail)):=new_char(cur_font,c);
+       alink(vlink(post_break(tail))):=post_break(tail);
+       tlink(post_break(tail)):=vlink(post_break(tail));
+       end;
+    end
+else  begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
+  scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
+  end;
+end;
+
+@ The three discretionary lists are constructed somewhat as if they were
+hboxes. A~subroutine called |build_discretionary| handles the transitions.
+(This is sort of fun.)
+
+@<Cases of |handle...@>=
+disc_group: build_discretionary;
+local_box_group: build_local_box;
+
+@ @<Declare act...@>=
+procedure build_local_box;
+var p:pointer;
+    kind:integer;
+begin
+unsave;
+kind:=saved(-1);
+decr(save_ptr);
+p:=vlink(head); pop_nest;
+p:=hpack(p,natural);
+if kind=0 then
+  eq_define(local_left_box_base,box_ref,p)
+else
+  eq_define(local_right_box_base,box_ref,p);
+if abs(mode)=hmode then
+  @<LOCAL: Add local paragraph node@>;
+eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+end;
+
+procedure build_discretionary;
+label done,exit;
+var p,@!q:pointer; {for link manipulation}
+@!n:integer; {length of discretionary list}
+begin unsave;
+@<Prune the current list, if necessary, until it contains only
+  |char_node|, |kern_node|, |hlist_node|, |vlist_node| and 
+  |rule_node| items; set |n| to the length of the list,
+  and set |q| to the list's tail@>;
+p:=vlink(head); pop_nest;
+case saved(-1) of
+0: if (n>0) then begin 
+   vlink(pre_break(tail)):=p; 
+   alink(p):=pre_break(tail);
+   tlink(pre_break(tail)):=q; 
+   end;
+1: if (n>0) then begin
+   vlink(post_break(tail)):=p;
+   alink(p):=post_break(tail);
+   tlink(post_break(tail)):=q; 
+   end;
+2:@<Attach list |p| to the current list, and record its length;
+  then finish up and |return|@>;
+end; {there are no other cases}
+incr(saved(-1)); new_save_level(disc_group); scan_left_brace;
+push_nest; mode:=-hmode; space_factor:=1000;
+exit:end;
+
+@ @<Attach list |p| to the current...@>=
+begin if (n>0)and(abs(mode)=mmode) then
+  begin print_err("Illegal math "); print_esc("discretionary");
+@.Illegal math \\disc...@>
+  help2("Sorry: The third part of a discretionary break must be")@/
+  ("empty, in math formulas. I had to delete your third part.");
+  flush_node_list(p); error;
+  end
+else begin 
+  if (n>0) then begin  
+    vlink(no_break(tail)):=p;
+    alink(p):=no_break(tail);
+    tlink(no_break(tail)):=q; 
+    end;
+  end;
+decr(save_ptr); return;
+end
+
+@ During this loop, |p=vlink(q)| and there are |n| items preceding |p|.
+
+@<Prune the current list, if necessary...@>=
+q:=head; p:=vlink(q); n:=0;
+while p<>null do
+  begin if not is_char_node(p) then if type(p)<>disc_node then
+    if type(p)>rule_node then if type(p)<>kern_node then 
+      begin print_err("Improper discretionary list");
+@.Improper discretionary list@>
+      help1("Discretionary lists must contain only boxes and kerns.");@/
+      error;
+      begin_diagnostic;
+      print_nl("The following discretionary sublist has been deleted:");
+@.The following...deleted@>
+      show_box(p);
+      end_diagnostic(true);
+      flush_node_list(p); vlink(q):=null; goto done;
+      end;
+  q:=p; p:=vlink(q); incr(n);
+  end;
+done:
+
+@ We need only one more thing to complete the horizontal mode routines, namely
+the \.{\\accent} primitive.
+
+@<Cases of |main_control| that build...@>=
+hmode+accent: make_accent;
+
+@ The positioning of accents is straightforward but tedious. Given an accent
+of width |a|, designed for characters of height |x| and slant |s|;
+and given a character of width |w|, height |h|, and slant |t|: We will shift
+the accent down by |x-h|, and we will insert kern nodes that have the effect of
+centering the accent over the character and shifting the accent to the
+right by $\delta={1\over2}(w-a)+h\cdot t-x\cdot s$.  If either character is
+absent from the font, we will simply use the other, without shifting.
+
+@<Declare act...@>=
+procedure make_accent;
+var s,@!t: real; {amount of slant}
+@!p,@!q,@!r:pointer; {character, box, and kern nodes}
+@!f:internal_font_number; {relevant font}
+@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
+begin scan_char_num; f:=cur_font; p:=new_glyph(f,cur_val);
+if p<>null then
+  begin x:=x_height(f); s:=slant(f)/float_constant(65536);
+@^real division@>
+  a:=glyph_width(p);@/
+  do_assignments;@/
+  @<Create a character node |q| for the next character,
+    but set |q:=null| if problems arise@>;
+  if q<>null then @<Append the accent with appropriate kerns,
+      then set |p:=q|@>;
+  vlink(tail):=p; tail:=p; space_factor:=1000;
+  end;
+end;
+
+@ @<Create a character node |q| for the next...@>=
+q:=null; f:=cur_font;
+if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
+  q:=new_glyph(f,cur_chr)
+else if cur_cmd=char_num then
+  begin scan_char_num; q:=new_glyph(f,cur_val);
+  end
+else back_input
+
+@ The kern nodes appended here must be distinguished from other kerns, lest
+they be wiped away by the hyphenation algorithm or by a previous line break.
+
+The two kerns are computed with (machine-dependent) |real| arithmetic, but
+their sum is machine-independent; the net effect is machine-independent,
+because the user cannot remove these nodes nor access them via \.{\\lastkern}.
+
+@<Append the accent with appropriate kerns...@>=
+begin t:=slant(f)/float_constant(65536);
+@^real division@>
+w:=glyph_width(q); 
+h:=glyph_height(q);
+if h<>x then {the accent must be shifted up or down}
+  begin p:=hpack(p,natural); shift_amount(p):=x-h;
+  end;
+delta:=round((w-a)/float_constant(2)+h*t-x*s);
+@^real multiplication@>
+@^real addition@>
+r:=new_kern(delta); subtype(r):=acc_kern; vlink(tail):=r; vlink(r):=p;
+tail:=new_kern(-a-delta); subtype(tail):=acc_kern; vlink(p):=tail; p:=q;
+end
+
+@ When `\.{\\cr}' or `\.{\\span}' or a tab mark comes through the scanner
+into |main_control|, it might be that the user has foolishly inserted
+one of them into something that has nothing to do with alignment. But it is
+far more likely that a left brace or right brace has been omitted, since
+|get_next| takes actions appropriate to alignment only when `\.{\\cr}'
+or `\.{\\span}' or tab marks occur with |align_state=0|. The following
+program attempts to make an appropriate recovery.
+
+@<Cases of |main_control| that build...@>=
+any_mode(car_ret), any_mode(tab_mark): align_error;
+any_mode(no_align): no_align_error;
+any_mode(omit): omit_error;
+
+@ @<Declare act...@>=
+procedure align_error;
+begin if abs(align_state)>2 then
+  @<Express consternation over the fact that no alignment is in progress@>
+else  begin back_input;
+  if align_state<0 then
+    begin print_err("Missing { inserted");
+@.Missing \{ inserted@>
+    incr(align_state); cur_tok:=left_brace_token+"{";
+    end
+  else  begin print_err("Missing } inserted");
+@.Missing \} inserted@>
+    decr(align_state); cur_tok:=right_brace_token+"}";
+    end;
+  help3("I've put in what seems to be necessary to fix")@/
+    ("the current column of the current alignment.")@/
+    ("Try to go on, since this might almost work."); ins_error;
+  end;
+end;
+
+@ @<Express consternation...@>=
+begin print_err("Misplaced "); print_cmd_chr(cur_cmd,cur_chr);
+@.Misplaced \&@>
+@.Misplaced \\span@>
+@.Misplaced \\cr@>
+if cur_tok=tab_token+"&" then
+  begin help6("I can't figure out why you would want to use a tab mark")@/
+  ("here. If you just want an ampersand, the remedy is")@/
+  ("simple: Just type `I\&' now. But if some right brace")@/
+  ("up above has ended a previous alignment prematurely,")@/
+  ("you're probably due for more error messages, and you")@/
+  ("might try typing `S' now just to see what is salvageable.");
+  end
+else  begin help5("I can't figure out why you would want to use a tab mark")@/
+  ("or \cr or \span just now. If something like a right brace")@/
+  ("up above has ended a previous alignment prematurely,")@/
+  ("you're probably due for more error messages, and you")@/
+  ("might try typing `S' now just to see what is salvageable.");
+  end;
+error;
+end
+
+@ The help messages here contain a little white lie, since \.{\\noalign}
+and \.{\\omit} are allowed also after `\.{\\noalign\{...\}}'.
+
+@<Declare act...@>=
+procedure no_align_error;
+begin print_err("Misplaced "); print_esc("noalign");
+@.Misplaced \\noalign@>
+help2("I expect to see \noalign only after the \cr of")@/
+  ("an alignment. Proceed, and I'll ignore this case."); error;
+end;
+procedure omit_error;
+begin print_err("Misplaced "); print_esc("omit");
+@.Misplaced \\omit@>
+help2("I expect to see \omit only after tab marks or the \cr of")@/
+  ("an alignment. Proceed, and I'll ignore this case."); error;
+end;
+
+@ We've now covered most of the abuses of \.{\\halign} and \.{\\valign}.
+Let's take a look at what happens when they are used correctly.
+
+@<Cases of |main_control| that build...@>=
+vmode+halign,hmode+valign:init_align;
+mmode+halign: if privileged then
+  if cur_group=math_shift_group then init_align
+  else off_save;
+vmode+endv,hmode+endv: do_endv;
+
+@ An |align_group| code is supposed to remain on the |save_stack|
+during an entire alignment, until |fin_align| removes it.
+
+A devious user might force an |endv| command to occur just about anywhere;
+we must defeat such hacks.
+
+@<Declare act...@>=
+procedure do_endv;
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+while (input_stack[base_ptr].index_field<>v_template) and
+      (input_stack[base_ptr].loc_field=null) and
+      (input_stack[base_ptr].state_field=token_list) do decr(base_ptr);
+if (input_stack[base_ptr].index_field<>v_template) or
+      (input_stack[base_ptr].loc_field<>null) or
+      (input_stack[base_ptr].state_field<>token_list) then
+  fatal_error("(interwoven alignment preambles are not allowed)");
+@.interwoven alignment preambles...@>
+ if cur_group=align_group then
+  begin line_break_context:=align_group; end_graf;
+  if fin_col then fin_row;
+  end
+else off_save;
+end;
+
+@ @<Cases of |handle_right_brace|...@>=
+align_group: begin back_input; cur_tok:=cs_token_flag+frozen_cr;
+  print_err("Missing "); print_esc("cr"); print(" inserted");
+@.Missing \\cr inserted@>
+  help1("I'm guessing that you meant to end an alignment here.");
+  ins_error;
+  end;
+
+@ @<Cases of |handle_right_brace|...@>=
+no_align_group: begin line_break_context:=no_align_group; end_graf; unsave; align_peek;
+  end;
+
+@ Finally, \.{\\endcsname} is not supposed to get through to |main_control|.
+
+@<Cases of |main_control| that build...@>=
+any_mode(end_cs_name): cs_error;
+
+@ @<Declare act...@>=
+procedure cs_error;
+begin print_err("Extra "); print_esc("endcsname");
+@.Extra \\endcsname@>
+help1("I'm ignoring this, since I wasn't doing a \csname.");
+error;
+end;
+
+@* \[48] Building math lists.
+The routines that \TeX\ uses to create mlists are similar to those we have
+just seen for the generation of hlists and vlists. But it is necessary to
+make ``noads'' as well as nodes, so the reader should review the
+discussion of math mode data structures before trying to make sense out of
+the following program.
+
+Here is a little routine that needs to be done whenever a subformula
+is about to be processed. The parameter is a code like |math_group|.
+
+@<Declare act...@>=
+procedure push_math(@!c:group_code);
+begin
+if math_direction<>text_direction then dir_math_save:=true;
+push_nest; mode:=-mmode; incompleat_noad:=null;
+@<DIR: |new_save_level| math@>;
+end;
+
+@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
+|math_shift| character) is scanned. We must check to see whether this
+`\.\$' is immediately followed by another, in case display math mode is
+called for.
+
+@<Cases of |main_control| that build...@>=
+hmode+math_shift:init_math;
+
+@ @<Declare act...@>=
+procedure init_math;
+label found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!l:scaled; {new |display_width|}
+@!s:scaled; {new |display_indent|}
+@!p:pointer; {current node when calculating |pre_display_size|}
+@!q:pointer; {glue specification when calculating |pre_display_size|}
+@!f:internal_font_number; {font in current |char_node|}
+@!n:integer; {scope of paragraph shape specification}
+@!v:scaled; {|w| plus possible glue amount}
+@!d:scaled; {increment to |v|}
+begin get_token; {|get_x_token| would fail on \.{\\ifmmode}\thinspace!}
+if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@>
+else  begin back_input; @<Go into ordinary math mode@>;
+  end;
+end;
+
+@ @<Go into ordinary math mode@>=
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+end
+
+@ We get into ordinary math mode from display math mode when `\.{\\eqno}' or
+`\.{\\leqno}' appears. In such cases |cur_chr| will be 0 or~1, respectively;
+the value of |cur_chr| is placed onto |save_stack| for safe keeping.
+
+@<Cases of |main_control| that build...@>=
+mmode+eq_no: if privileged then
+  if cur_group=math_shift_group then start_eq_no
+  else off_save;
+
+@ @<Put each...@>=
+primitive("eqno",eq_no,0);
+@!@:eq_no_}{\.{\\eqno} primitive@>
+primitive("leqno",eq_no,1);
+@!@:leq_no_}{\.{\\leqno} primitive@>
+
+@ When \TeX\ is in display math mode, |cur_group=math_shift_group|,
+so it is not necessary for the |start_eq_no| procedure to test for
+this condition.
+
+@<Declare act...@>=
+procedure start_eq_no;
+begin saved(0):=cur_chr; incr(save_ptr);
+@<Go into ordinary math mode@>;
+end;
+
+@ @<Cases of |print_cmd_chr|...@>=
+eq_no:if chr_code=1 then print_esc("leqno")@+else print_esc("eqno");
+
+@ @<Forbidden...@>=non_math(eq_no),
+
+@ When we enter display math mode, we need to call |line_break| to
+process the partial paragraph that has just been interrupted by the
+display. Then we can set the proper values of |display_width| and
+|display_indent| and |pre_display_size|.
+
+@<Go into display math mode@>=
+begin if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+  begin pop_nest; w:=-max_dimen;
+  end
+else  begin 
+  line_break(true);@/
+  @<Calculate the natural width, |w|, by which the characters of the
+    final line extend to the right of the reference point,
+    plus two ems; or set |w:=max_dimen| if the non-blank information
+    on that line is affected by stretching or shrinking@>;
+  end;
+{now we are in vertical mode, working on the list that will contain the display}
+@<Calculate the length, |l|, and the shift amount, |s|, of the display lines@>;
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+eq_word_define(dimen_base+pre_display_size_code,w);
+eq_word_define(dimen_base+display_width_code,l);
+eq_word_define(dimen_base+display_indent_code,s);
+if every_display<>null then begin_token_list(every_display,every_display_text);
+if nest_ptr=1 then begin check_contrib_filter('before_display'); build_page; end;
+end
+
+@ @<Calculate the natural width, |w|, by which...@>=
+v:=shift_amount(just_box)+2*quad(cur_font); w:=-max_dimen;
+p:=list_ptr(just_box);
+while p<>null do
+  begin @<Let |d| be the natural width of node |p|;
+    if the node is ``visible,'' |goto found|;
+    if the node is glue that stretches or shrinks, set |v:=max_dimen|@>;
+  if v<max_dimen then v:=v+d;
+  goto not_found;
+  found: if v<max_dimen then
+    begin v:=v+d; w:=v;
+    end
+  else  begin w:=max_dimen; goto done;
+    end;
+  not_found: p:=vlink(p);
+  end;
+done:
+
+@ @<Let |d| be the natural width of node |p|...@>=
+if is_char_node(p) then
+  begin f:=font(p); d:=glyph_width(p);
+  goto found;
+  end;
+case type(p) of
+hlist_node,vlist_node,rule_node: begin d:=width(p); goto found;
+  end;
+margin_kern_node: d:=width(p);
+kern_node: d:=width(p);
+math_node: d:=surround(p);
+glue_node:@<Let |d| be the natural width of this glue; if stretching
+  or shrinking, set |v:=max_dimen|; |goto found| in the case of leaders@>;
+whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
+othercases d:=0
+endcases
+
+@ We need to be careful that |w|, |v|, and |d| do not depend on any |glue_set|
+values, since such values are subject to system-dependent rounding.
+System-dependent numbers are not allowed to infiltrate parameters like
+|pre_display_size|, since \TeX82 is supposed to make the same decisions on all
+machines.
+
+@<Let |d| be the natural width of this glue...@>=
+begin q:=glue_ptr(p); d:=width(q);
+if glue_sign(just_box)=stretching then
+  begin if (glue_order(just_box)=stretch_order(q))and@|
+     (stretch(q)<>0) then
+    v:=max_dimen;
+  end
+else if glue_sign(just_box)=shrinking then
+  begin if (glue_order(just_box)=shrink_order(q))and@|
+     (shrink(q)<>0) then
+    v:=max_dimen;
+  end;
+if subtype(p)>=a_leaders then goto found;
+end
+
+@ A displayed equation is considered to be three lines long, so we
+calculate the length and offset of line number |prev_graf+2|.
+
+@<Calculate the length, |l|, ...@>=
+if par_shape_ptr=null then
+  if (hang_indent<>0)and@|
+   (((hang_after>=0)and(prev_graf+2>hang_after))or@|
+    (prev_graf+1<-hang_after)) then
+    begin l:=hsize-abs(hang_indent);
+    if hang_indent>0 then s:=hang_indent@+else s:=0;
+    end
+  else  begin l:=hsize; s:=0;
+    end
+else  begin n:=vinfo(par_shape_ptr);
+  if prev_graf+2>=n then p:=par_shape_ptr+2*n
+  else p:=par_shape_ptr+2*(prev_graf+2);
+  s:=vmem(p-1).sc; l:=vmem(p).sc;
+  end
+
+@ Subformulas of math formulas cause a new level of math mode to be entered,
+on the semantic nest as well as the save stack. These subformulas arise in
+several ways: (1)~A left brace by itself indicates the beginning of a
+subformula that will be put into a box, thereby freezing its glue and
+preventing line breaks. (2)~A subscript or superscript is treated as a
+subformula if it is not a single character; the same applies to
+the nucleus of things like \.{\\underline}. (3)~The \.{\\left} primitive
+initiates a subformula that will be terminated by a matching \.{\\right}.
+The group codes placed on |save_stack| in these three cases are
+|math_group|, |math_group|, and |math_left_group|, respectively.
+
+Here is the code that handles case (1); the other cases are not quite as
+trivial, so we shall consider them later.
+
+@<Cases of |main_control| that build...@>=
+mmode+left_brace: begin tail_append(new_noad);
+  back_input; scan_math(nucleus(tail));
+  end;
+
+@ Recall that the |nucleus|, |subscr|, and |supscr| fields in a noad are
+broken down into subfields called |math_type| and either |info| or
+|(fam,character)|. The job of |scan_math| is to figure out what to place
+in one of these principal fields; it looks at the subformula that
+comes next in the input, and places an encoding of that subformula
+into a given word of |mem|.
+
+@d fam_in_range==((cur_fam>=0)and(cur_fam<256))
+
+@<Declare act...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=get_math_code(cur_chr);
+   if c=@"8000000 then
+      begin @<Treat |cur_chr| as an active character@>;
+      goto restart;
+      end;
+    end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+  goto reswitch;
+  end;
+math_char_num: begin
+  if cur_chr=0 then scan_fifteen_bit_int
+  else scan_big_fifteen_bit_int;
+  c:=cur_val;
+  end;
+math_given: begin
+  c := ((cur_chr div @"1000) * @"1000000) +
+         (((cur_chr mod @"1000) div @"100) * @"10000) +
+         (cur_chr mod @"100);
+  end;
+omath_given: begin c:=cur_chr;
+  end;
+delim_num: begin
+  if cur_chr=0 then scan_twenty_seven_bit_int
+  else scan_fifty_one_bit_int;
+  c:=cur_val;
+  end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; mcharacter(p):=qi(c mod @"10000);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div @"10000) mod @"100;
+exit:end;
+
+@ An active character that is an |outer_call| is allowed here.
+
+@<Treat |cur_chr|...@>=
+begin cur_cs:=(cur_chr mod number_active_chars)+active_base;
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+x_token; back_input;
+end
+
+@ The pointer |p| is placed on |save_stack| while a complex subformula
+is being scanned.
+
+@<Scan a subformula...@>=
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); push_math(math_group); return;
+end
+
+@ The simplest math formula is, of course, `\.{\${ }\$}', when no noads are
+generated. The next simplest cases involve a single character, e.g.,
+`\.{\$x\$}'. Even though such cases may not seem to be very interesting,
+the reader can perhaps understand how happy the author was when `\.{\$x\$}'
+was first properly typeset by \TeX. The code in this section was used.
+@^Knuth, Donald Ervin@>
+
+@<Cases of |main_control| that build...@>=
+mmode+letter,mmode+other_char,mmode+char_given:
+  set_math_char(get_math_code(cur_chr));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+  set_math_char(get_math_code(cur_chr));
+  end;
+mmode+math_char_num: begin
+  if cur_chr=0 then scan_fifteen_bit_int
+  else scan_big_fifteen_bit_int;
+  set_math_char(cur_val);
+  end;
+mmode+math_given: begin
+  set_math_char(((cur_chr div @"1000) * @"1000000) +
+                (((cur_chr mod @"1000) div @"100) * @"10000) +
+                (cur_chr mod @"100));
+  end;
+mmode+omath_given: set_math_char(cur_chr);
+mmode+delim_num: begin
+  if cur_chr=0 then scan_twenty_seven_bit_int
+  else scan_fifty_one_bit_int;
+  set_math_char(cur_val);
+  end;
+
+@ The |set_math_char| procedure creates a new noad appropriate to a given
+math code, and appends it to the current mlist. However, if the math code
+is sufficiently large, the |cur_chr| is treated as an active character and
+nothing is appended.
+
+@<Declare act...@>=
+procedure set_math_char(@!c:integer);
+var p:pointer; {the new noad}
+begin if c>=@"8000000 then
+  @<Treat |cur_chr|...@>
+else  begin p:=new_noad; math_type(nucleus(p)):=math_char;
+  mcharacter(nucleus(p)):=qi(c mod @"10000);
+  fam(nucleus(p)):=(c div @"10000) mod @"100;
+  if c>=var_code then
+    begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+    type(p):=ord_noad;
+    end
+  else
+    type(p):=ord_noad+(c div @"1000000);
+  vlink(tail):=p; tail:=p;
+  end;
+end;
+
+@ Primitive math operators like \.{\\mathop} and \.{\\underline} are given
+the command code |math_comp|, supplemented by the noad type that they
+generate.
+
+@<Put each...@>=
+primitive("mathord",math_comp,ord_noad);
+@!@:math_ord_}{\.{\\mathord} primitive@>
+primitive("mathop",math_comp,op_noad);
+@!@:math_op_}{\.{\\mathop} primitive@>
+primitive("mathbin",math_comp,bin_noad);
+@!@:math_bin_}{\.{\\mathbin} primitive@>
+primitive("mathrel",math_comp,rel_noad);
+@!@:math_rel_}{\.{\\mathrel} primitive@>
+primitive("mathopen",math_comp,open_noad);
+@!@:math_open_}{\.{\\mathopen} primitive@>
+primitive("mathclose",math_comp,close_noad);
+@!@:math_close_}{\.{\\mathclose} primitive@>
+primitive("mathpunct",math_comp,punct_noad);
+@!@:math_punct_}{\.{\\mathpunct} primitive@>
+primitive("mathinner",math_comp,inner_noad);
+@!@:math_inner_}{\.{\\mathinner} primitive@>
+primitive("underline",math_comp,under_noad);
+@!@:underline_}{\.{\\underline} primitive@>
+primitive("overline",math_comp,over_noad);@/
+@!@:overline_}{\.{\\overline} primitive@>
+primitive("displaylimits",limit_switch,normal);
+@!@:display_limits_}{\.{\\displaylimits} primitive@>
+primitive("limits",limit_switch,limits);
+@!@:limits_}{\.{\\limits} primitive@>
+primitive("nolimits",limit_switch,no_limits);
+@!@:no_limits_}{\.{\\nolimits} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+math_comp: case chr_code of
+  ord_noad: print_esc("mathord");
+  op_noad: print_esc("mathop");
+  bin_noad: print_esc("mathbin");
+  rel_noad: print_esc("mathrel");
+  open_noad: print_esc("mathopen");
+  close_noad: print_esc("mathclose");
+  punct_noad: print_esc("mathpunct");
+  inner_noad: print_esc("mathinner");
+  under_noad: print_esc("underline");
+  othercases print_esc("overline")
+  endcases;
+limit_switch: if chr_code=limits then print_esc("limits")
+  else if chr_code=no_limits then print_esc("nolimits")
+  else print_esc("displaylimits");
+
+@ @<Cases of |main_control| that build...@>=
+mmode+math_comp: begin tail_append(new_noad);
+  type(tail):=cur_chr; scan_math(nucleus(tail));
+  end;
+mmode+limit_switch: math_limit_switch;
+
+@ @<Declare act...@>=
+procedure math_limit_switch;
+label exit;
+begin if head<>tail then if type(tail)=op_noad then
+  begin subtype(tail):=cur_chr; return;
+  end;
+print_err("Limit controls must follow a math operator");
+@.Limit controls must follow...@>
+help1("I'm ignoring this misplaced \limits or \nolimits command."); error;
+exit:end;
+
+@ Delimiter fields of noads are filled in by the |scan_delimiter| routine.
+The first parameter of this procedure is the |mem| address where the
+delimiter is to be placed; the second tells if this delimiter follows
+\.{\\radical} or not.
+
+@<Declare act...@>=
+procedure scan_delimiter(@!p:pointer;@!r:integer);
+begin if r=1 then scan_twenty_seven_bit_int
+else if r=2 then scan_fifty_one_bit_int
+else  begin @<Get the next non-blank non-relax...@>;
+  case cur_cmd of
+  letter,other_char: begin
+    cur_val:=get_del_code_a(cur_chr); cur_val1:=get_del_code_b(cur_chr);
+    end;
+  delim_num: if cur_chr=0 then scan_twenty_seven_bit_int
+             else scan_fifty_one_bit_int;
+  othercases begin cur_val:=-1; cur_val1:=-1; end;
+  endcases;
+  end;
+if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
+   to null; set~|cur_val:=0|@>;
+ cur_val1:=0;
+ end;
+small_fam(p):=(cur_val div @"10000) mod @"100;
+small_char(p):=qi(cur_val mod @"10000);
+large_fam(p):=(cur_val1 div @"10000) mod @"100;
+large_char(p):=qi(cur_val1 mod @"10000);
+end;
+
+@ @<Report that an invalid delimiter...@>=
+begin print_err("Missing delimiter (. inserted)");
+@.Missing delimiter...@>
+help6("I was expecting to see something like `(' or `\{' or")@/
+  ("`\}' here. If you typed, e.g., `{' instead of `\{', you")@/
+  ("should probably delete the `{' by typing `1' now, so that")@/
+  ("braces don't get unbalanced. Otherwise just proceed.")@/
+  ("Acceptable delimiters are characters whose \delcode is")@/
+  ("nonnegative, or you can use `\delimiter <delimiter code>'.");
+back_error; cur_val:=0;
+end
+
+@ @<Cases of |main_control| that build...@>=
+mmode+radical:math_radical;
+
+@ @<Declare act...@>=
+procedure math_radical;
+begin tail_append(new_node(radical_noad,normal));
+vmem(nucleus(tail)).hh:=empty_field;
+vmem(subscr(tail)).hh:=empty_field;
+vmem(supscr(tail)).hh:=empty_field;
+scan_delimiter(left_delimiter(tail),cur_chr+1);
+scan_math(nucleus(tail));
+end;
+
+@ @<Cases of |main_control| that build...@>=
+mmode+accent,mmode+math_accent:math_ac;
+
+@ @<Declare act...@>=
+procedure math_ac;
+begin if cur_cmd=accent then
+  @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(new_node(accent_noad,normal));
+vmem(nucleus(tail)).hh:=empty_field;
+vmem(subscr(tail)).hh:=empty_field;
+vmem(supscr(tail)).hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+if cur_chr=0 then scan_fifteen_bit_int
+else scan_big_fifteen_bit_int;
+mcharacter(accent_chr(tail)):=qi(cur_val mod @"1000);
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div @"10000) mod @"100;
+scan_math(nucleus(tail));
+end;
+
+@ @<Complain that the user should have said \.{\\mathaccent}@>=
+begin print_err("Please use "); print_esc("mathaccent");
+print(" for accents in math mode");
+@.Please use \\mathaccent...@>
+help2("I'm changing \accent to \mathaccent here; wish me luck.")@/
+  ("(Accents are not the same in formulas as they are in text.)");
+error;
+end
+
+@ @<Cases of |main_control| that build...@>=
+mmode+vcenter: begin scan_spec(vcenter_group,false); normal_paragraph;
+  push_nest; mode:=-vmode; prev_depth:=ignore_depth;
+  if every_vbox<>null then begin_token_list(every_vbox,every_vbox_text);
+  end;
+
+@ @<Cases of |handle...@>=
+vcenter_group: begin line_break_context:=vcenter_group; end_graf; unsave; save_ptr:=save_ptr-2;
+  p:=vpack(vlink(head),saved(1),saved(0)); pop_nest;
+  tail_append(new_noad); type(tail):=vcenter_noad;
+  math_type(nucleus(tail)):=sub_box; vinfo(nucleus(tail)):=p;
+  end;
+
+@ The routine that inserts a |style_node| holds no surprises.
+
+@<Put each...@>=
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+math_style: print_style(chr_code);
+
+@ @<Cases of |main_control| that build...@>=
+mmode+math_style: tail_append(new_style(cur_chr));
+mmode+non_script: begin tail_append(new_glue(zero_glue));
+  subtype(tail):=cond_math_glue;
+  end;
+mmode+math_choice: append_choices;
+
+@ The routine that scans the four mlists of a \.{\\mathchoice} is very
+much like the routine that builds discretionary nodes.
+
+@<Declare act...@>=
+procedure append_choices;
+begin tail_append(new_choice); incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+end;
+
+@ @<Cases of |handle_right_brace|...@>=
+math_choice_group: build_choices;
+
+@ @<Declare act...@>=
+procedure build_choices;
+label exit;
+var p:pointer; {the current mlist}
+begin @<DIR: |unsave| math@>; p:=fin_mlist(null);
+case saved(-1) of
+0:display_mlist(tail):=p;
+1:text_mlist(tail):=p;
+2:script_mlist(tail):=p;
+3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
+  end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+exit:end;
+
+@ Subscripts and superscripts are attached to the previous nucleus by the
+@^superscripts@>@^subscripts@>
+action procedure called |sub_sup|. We use the facts that |sub_mark=sup_mark+1|
+and |subscr(p)=supscr(p)+1|.
+
+@<Cases of |main_control| that build...@>=
+mmode+sub_mark,mmode+sup_mark: sub_sup;
+
+@ @<Declare act...@>=
+procedure sub_sup;
+var t:small_number; {type of previous sub/superscript}
+@!p:pointer; {field to be filled by |scan_math|}
+begin t:=empty; p:=null;
+if tail<>head then if scripts_allowed(tail) then
+  begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+  t:=math_type(p);
+  end;
+if (p=null)or(t<>empty) then @<Insert a dummy noad to be sub/superscripted@>;
+scan_math(p);
+end;
+
+@ @<Insert a dummy...@>=
+begin tail_append(new_noad);
+p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
+if t<>empty then
+  begin if cur_cmd=sup_mark then
+    begin print_err("Double superscript");
+@.Double superscript@>
+    help1("I treat `x^1^2' essentially like `x^1{}^2'.");
+    end
+  else  begin print_err("Double subscript");
+@.Double subscript@>
+    help1("I treat `x_1_2' essentially like `x_1{}_2'.");
+    end;
+  error;
+  end;
+end
+
+@ An operation like `\.{\\over}' causes the current mlist to go into a
+state of suspended animation: |incompleat_noad| points to a |fraction_noad|
+that contains the mlist-so-far as its numerator, while the denominator
+is yet to come. Finally when the mlist is finished, the denominator will
+go into the incompleat fraction noad, and that noad will become the
+whole formula, unless it is surrounded by `\.{\\left}' and `\.{\\right}'
+delimiters.
+
+@d above_code=0 { `\.{\\above}' }
+@d over_code=1 { `\.{\\over}' }
+@d atop_code=2 { `\.{\\atop}' }
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+
+@<Put each...@>=
+primitive("above",above,above_code);@/
+@!@:above_}{\.{\\above} primitive@>
+primitive("over",above,over_code);@/
+@!@:over_}{\.{\\over} primitive@>
+primitive("atop",above,atop_code);@/
+@!@:atop_}{\.{\\atop} primitive@>
+primitive("abovewithdelims",above,delimited_code+above_code);@/
+@!@:above_with_delims_}{\.{\\abovewithdelims} primitive@>
+primitive("overwithdelims",above,delimited_code+over_code);@/
+@!@:over_with_delims_}{\.{\\overwithdelims} primitive@>
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+above: case chr_code of
+  over_code:print_esc("over");
+  atop_code:print_esc("atop");
+  delimited_code+above_code:print_esc("abovewithdelims");
+  delimited_code+over_code:print_esc("overwithdelims");
+  delimited_code+atop_code:print_esc("atopwithdelims");
+  othercases print_esc("above")
+  endcases;
+
+@ @<Cases of |main_control| that build...@>=
+mmode+above: math_fraction;
+
+@ @<Declare act...@>=
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+if incompleat_noad<>null then
+  @<Ignore the fraction operation and complain about this ambiguous case@>
+else  begin incompleat_noad:=new_node(fraction_noad,normal);
+  math_type(numerator(incompleat_noad)):=sub_mlist;
+  vinfo(numerator(incompleat_noad)):=vlink(head);
+  vmem(denominator(incompleat_noad)).hh:=empty_field;
+  vmem(left_delimiter(incompleat_noad)).qqqq:=null_delimiter;
+  vmem(right_delimiter(incompleat_noad)).qqqq:=null_delimiter;@/
+  vlink(head):=null; tail:=head;
+  @<Use code |c| to distinguish between generalized fractions@>;
+  end;
+end;
+
+@ @<Use code |c|...@>=
+if c>=delimited_code then
+  begin scan_delimiter(left_delimiter(incompleat_noad),false);
+  scan_delimiter(right_delimiter(incompleat_noad),false);
+  end;
+case c mod delimited_code of
+above_code: begin scan_normal_dimen;
+  thickness(incompleat_noad):=cur_val;
+  end;
+over_code: thickness(incompleat_noad):=default_code;
+atop_code: thickness(incompleat_noad):=0;
+end {there are no other cases}
+
+@ @<Ignore the fraction...@>=
+begin if c>=delimited_code then
+  begin scan_delimiter(garbage,false); scan_delimiter(garbage,false);
+  end;
+if c mod delimited_code=above_code then scan_normal_dimen;
+print_err("Ambiguous; you need another { and }");
+@.Ambiguous...@>
+help3("I'm ignoring this fraction specification, since I don't")@/
+  ("know whether a construction like `x \over y \over z'")@/
+  ("means `{x \over y} \over z' or `x \over {y \over z}'.");
+error;
+end
+
+@ At the end of a math formula or subformula, the |fin_mlist| routine is
+called upon to return a pointer to the newly completed mlist, and to
+pop the nest back to the enclosing semantic level. The parameter to
+|fin_mlist|, if not null, points to a |right_noad| that ends the
+current mlist; this |right_noad| has not yet been appended.
+
+@<Declare the function called |fin_mlist|@>=
+function fin_mlist(@!p:pointer):pointer;
+var q:pointer; {the mlist to return}
+begin if incompleat_noad<>null then @<Compleat the incompleat noad@>
+else  begin vlink(tail):=p; q:=vlink(head);
+  end;
+pop_nest; fin_mlist:=q;
+end;
+
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+vinfo(denominator(incompleat_noad)):=vlink(head);
+if p=null then q:=incompleat_noad
+else  begin q:=vinfo(numerator(incompleat_noad));
+  if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+  vinfo(numerator(incompleat_noad)):=vlink(delim_ptr);
+  vlink(delim_ptr):=incompleat_noad; vlink(incompleat_noad):=p;
+  end;
+end
+
+@ Now at last we're ready to see what happens when a right brace occurs
+in a math formula. Two special cases are simplified here: Braces are effectively
+removed when they surround a single Ord without sub/superscripts, or when they
+surround an accent that is the nucleus of an Ord atom.
+
+@<Cases of |handle...@>=
+math_group: begin @<DIR: |unsave| math@>; decr(save_ptr);@/
+  math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); vinfo(saved(0)):=p;
+  if p<>null then if vlink(p)=null then
+   if type(p)=ord_noad then
+    begin if math_type(subscr(p))=empty then
+     if math_type(supscr(p))=empty then
+      begin vmem(saved(0)).hh:=vmem(nucleus(p)).hh;
+      flush_node(p);
+      end;
+    end
+  else if type(p)=accent_noad then if saved(0)=nucleus(tail) then
+   if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>;
+  end;
+
+@ @<Replace the tail...@>=
+begin q:=head; while vlink(q)<>tail do q:=vlink(q);
+vlink(q):=p; flush_node(tail); tail:=p;
+end
+
+@ We have dealt with all constructions of math mode except `\.{\\left}' and
+`\.{\\right}', so the picture is completed by the following sections of
+the program.
+
+@<Put each...@>=
+primitive("left",left_right,left_noad);
+@!@:left_}{\.{\\left} primitive@>
+primitive("right",left_right,right_noad);
+@!@:right_}{\.{\\right} primitive@>
+text(frozen_right):="right"; eqtb[frozen_right]:=eqtb[cur_val];
+
+@ @<Cases of |print_cmd_chr|...@>=
+left_right: if chr_code=left_noad then print_esc("left")
+@/@<Cases of |left_right| for |print_cmd_chr|@>@/
+else print_esc("right");
+
+@ @<Cases of |main_control| that build...@>=
+mmode+left_right: math_left_right;
+
+@ @<Declare act...@>=
+procedure math_left_right;
+var t:small_number; {|left_noad| or |right_noad|}
+@!p:pointer; {new noad}
+@!q:pointer; {resulting mlist}
+begin t:=cur_chr;
+if (t<>left_noad)and(cur_group<>math_left_group) then
+  @<Try to recover from mismatched \.{\\right}@>
+else  begin p:=new_noad; type(p):=t;
+  scan_delimiter(delimiter(p),false);
+  if t=middle_noad then
+    begin type(p):=right_noad; subtype(p):=middle_noad;
+    end;
+  if t=left_noad then q:=p
+  else  begin q:=fin_mlist(p);
+    @<DIR: |unsave| math@>; {end of |math_left_group|}
+    end;
+  if t<>right_noad then
+    begin push_math(math_left_group); vlink(head):=q; tail:=p;
+    delim_ptr:=p;
+    end
+  else  begin
+    tail_append(new_noad); type(tail):=inner_noad;
+    math_type(nucleus(tail)):=sub_mlist;
+    vinfo(nucleus(tail)):=q;
+    end;
+  end;
+end;
+
+@ @<Try to recover from mismatch...@>=
+begin if cur_group=math_shift_group then
+  begin scan_delimiter(garbage,false);
+  print_err("Extra ");
+  if t=middle_noad then
+    begin print_esc("middle");
+@.Extra \\middle.@>
+    help1("I'm ignoring a \middle that had no matching \left.");
+    end
+  else  begin print_esc("right");
+@.Extra \\right.@>
+    help1("I'm ignoring a \right that had no matching \left.");
+    end;
+  error;
+  end
+else off_save;
+end
+
+@ Here is the only way out of math mode.
+
+@<Cases of |main_control| that build...@>=
+mmode+math_shift: if cur_group=math_shift_group then after_math
+  else off_save;
+
+@ @<Declare act...@>=
+procedure after_math;
+var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'}
+@!danger:boolean; {not enough symbol fonts are present}
+@!m:integer; {|mmode| or |-mmode|}
+@!p:pointer; {the formula}
+@!a:pointer; {box containing equation number}
+@<Local variables for finishing a displayed formula@>@;
+begin danger:=false;
+@<Check that the necessary fonts for math symbols are present;
+  if not, flush the current math lists and set |danger:=true|@>;
+m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest}
+if mode=-m then {end of equation number}
+  begin @<Check that another \.\$ follows@>;
+  cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false;
+  mlist_to_hlist; a:=hpack(vlink(temp_head),natural);
+  @<DIR: |unsave| math@>;
+  decr(save_ptr); {now |cur_group=math_shift_group|}
+  if saved(0)=1 then l:=true;
+  danger:=false;
+  @<Check that the necessary fonts for math symbols are present;
+    if not, flush the current math lists and set |danger:=true|@>;
+  m:=mode; p:=fin_mlist(null);
+  end
+else a:=null;
+if m<0 then @<Finish math in text@>
+else  begin if a=null then @<Check that another \.\$ follows@>;
+  @<Finish displayed math@>;
+  end;
+end;
+
+@ @<Check that the necessary fonts...@>=
+if (font_params(fam_fnt(2+text_size))<total_mathsy_params)or@|
+   (font_params(fam_fnt(2+script_size))<total_mathsy_params)or@|
+   (font_params(fam_fnt(2+script_script_size))<total_mathsy_params) then
+  begin print_err("Math formula deleted: Insufficient symbol fonts");@/
+@.Math formula deleted...@>
+  help3("Sorry, but I can't typeset math unless \textfont 2")@/
+    ("and \scriptfont 2 and \scriptscriptfont 2 have all")@/
+    ("the \fontdimen values needed in math symbol fonts.");
+  error; flush_math; danger:=true;
+  end
+else if (font_params(fam_fnt(3+text_size))<total_mathex_params)or@|
+   (font_params(fam_fnt(3+script_size))<total_mathex_params)or@|
+   (font_params(fam_fnt(3+script_script_size))<total_mathex_params) then
+  begin print_err("Math formula deleted: Insufficient extension fonts");@/
+  help3("Sorry, but I can't typeset math unless \textfont 3")@/
+    ("and \scriptfont 3 and \scriptscriptfont 3 have all")@/
+    ("the \fontdimen values needed in math extension fonts.");
+  error; flush_math; danger:=true;
+  end
+
+@ The |unsave| is done after everything else here; hence an appearance of
+`\.{\\mathsurround}' inside of `\.{\$...\$}' affects the spacing at these
+particular \.\$'s. This is consistent with the conventions of
+`\.{\$\$...\$\$}', since `\.{\\abovedisplayskip}' inside a display affects the
+space above that display.
+
+@<Finish math in text@> =
+begin tail_append(new_math(math_surround,before));
+if dir_math_save then
+  @<Append a begin direction to the tail of the current list@>;
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+vlink(tail):=vlink(temp_head);
+while vlink(tail)<>null do tail:=vlink(tail);
+if dir_math_save then
+  @<Append an end direction to the tail of the current list@>;
+dir_math_save:=false;
+tail_append(new_math(math_surround,after));
+space_factor:=1000;
+@<DIR: |unsave| math@>;
+end
+
+@ \TeX\ gets to the following part of the program when the first `\.\$' ending
+a display has been scanned.
+
+@<Check that another \.\$ follows@>=
+begin get_x_token;
+if cur_cmd<>math_shift then
+  begin print_err("Display math should end with $$");
+@.Display math...with \$\$@>
+  help2("The `$' that I just saw supposedly matches a previous `$$'.")@/
+    ("So I shall assume that you typed `$$' both times.");
+  back_error;
+  end;
+end
+
+@ We have saved the worst for last: The fussiest part of math mode processing
+occurs when a displayed formula is being centered and placed with an optional
+equation number.
+
+@<Local variables for finishing...@>=
+@!b:pointer; {box containing the equation}
+@!w:scaled; {width of the equation}
+@!z:scaled; {width of the line}
+@!e:scaled; {width of equation number}
+@!q:scaled; {width of equation number plus space to separate from equation}
+@!d:scaled; {displacement of equation in the line}
+@!s:scaled; {move the line right this much}
+@!g1,@!g2:small_number; {glue parameter codes for before and after}
+@!r:pointer; {kern node used to position the display}
+@!t:pointer; {tail of adjustment list}
+@!pre_t:pointer; {tail of pre-adjustment list}
+
+@ At this time |p| points to the mlist for the formula; |a| is either
+|null| or it points to a box containing the equation number; and we are in
+vertical mode (or internal vertical mode).
+
+@<Finish displayed math@>=
+cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false;
+mlist_to_hlist; p:=vlink(temp_head);@/
+adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head;
+b:=hpack(p,natural); p:=list_ptr(b);
+t:=adjust_tail; adjust_tail:=null;@/
+pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/
+w:=width(b); z:=display_width; s:=display_indent;
+if (a=null)or danger then
+  begin e:=0; q:=0;
+  end
+else  begin e:=width(a); q:=e+math_quad(text_size);
+  end;
+if w+q>z then
+  @<Squeeze the equation as much as possible; if there is an equation
+    number that should go on a separate line by itself,
+    set~|e:=0|@>;
+@<Determine the displacement, |d|, of the left edge of the equation, with
+  respect to the line size |z|, assuming that |l=false|@>;
+@<Append the glue or equation number preceding the display@>;
+@<Append the display and perhaps also the equation number@>;
+@<Append the glue or equation number following the display@>;
+resume_after_display
+
+@ @<Declare act...@>=
+procedure resume_after_display;
+begin if cur_group<>math_shift_group then confusion("display");
+@:this can't happen display}{\quad display@>
+@<DIR: |unsave| math@>;
+prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000;
+@<LOCAL: Add local paragraph node@>;
+@<Scan an optional space@>;
+if nest_ptr=1 then begin check_filter('after_display'); build_page; end;
+end;
+
+@ The user can force the equation number to go on a separate line
+by causing its width to be zero.
+
+@<Squeeze the equation as much as possible...@>=
+begin if (e<>0)and((w-total_shrink[normal]+q<=z)or@|
+   (total_shrink[sfi]<>0)or(total_shrink[fil]<>0)or
+   (total_shrink[fill]<>0)or(total_shrink[filll]<>0)) then
+  begin flush_node(b);
+  b:=hpack(p,z-q,exactly);
+  end
+else  begin e:=0;
+  if w>z then
+    begin 
+    list_ptr(b):=null; flush_node(b);
+    b:=hpack(p,z,exactly);
+    end;
+  end;
+w:=width(b);
+end
+
+@ We try first to center the display without regard to the existence of
+the equation number. If that would make it too close (where ``too close''
+means that the space between display and equation number is less than the
+width of the equation number), we either center it in the remaining space
+or move it as far from the equation number as possible. The latter alternative
+is taken only if the display begins with glue, since we assume that the
+user put glue there to control the spacing precisely.
+
+@<Determine the displacement, |d|, of the left edge of the equation...@>=
+d:=half(z-w);
+if (e>0)and(d<2*e) then {too close}
+  begin d:=half(z-w-e);
+  if p<>null then if not is_char_node(p) then if type(p)=glue_node then d:=0;
+  end
+
+@ If the equation number is set on a line by itself, either before or
+after the formula, we append an infinite penalty so that no page break will
+separate the display from its number; and we use the same size and
+displacement for all three potential lines of the display, even though
+`\.{\\parshape}' may specify them differently.
+
+@<Append the glue or equation number preceding the display@>=
+tail_append(new_penalty(pre_display_penalty));@/
+if (d+s<=pre_display_size)or l then {not enough clearance}
+  begin g1:=above_display_skip_code; g2:=below_display_skip_code;
+  end
+else  begin g1:=above_display_short_skip_code;
+  g2:=below_display_short_skip_code;
+  end;
+if l and(e=0) then {it follows that |type(a)=hlist_node|}
+  begin shift_amount(a):=s; append_to_vlist(a);
+  tail_append(new_penalty(inf_penalty));
+  end
+else tail_append(new_param_glue(g1))
+
+@ @<Append the display and perhaps also the equation number@>=
+if e<>0 then
+  begin r:=new_kern(z-w-e-d);
+  if l then
+    begin vlink(a):=r; vlink(r):=b; b:=a; d:=0;
+    end
+  else  begin vlink(b):=r; vlink(r):=a;
+    end;
+  b:=hpack(b,natural);
+  end;
+shift_amount(b):=s+d; append_to_vlist(b)
+
+@ @<Append the glue or equation number following the display@>=
+if (a<>null)and(e=0)and not l then
+  begin tail_append(new_penalty(inf_penalty));
+  shift_amount(a):=s+z-width(a);
+  append_to_vlist(a);
+  g2:=0;
+  end;
+if t<>adjust_head then {migrating material comes after equation number}
+  begin vlink(tail):=vlink(adjust_head); tail:=t;
+  end;
+if pre_t<>pre_adjust_head then
+  begin vlink(tail):=vlink(pre_adjust_head); tail:=pre_t;
+  end;
+tail_append(new_penalty(post_display_penalty));
+if g2>0 then tail_append(new_param_glue(g2))
+
+@ When \.{\\halign} appears in a display, the alignment routines operate
+essentially as they do in vertical mode. Then the following program is
+activated, with |p| and |q| pointing to the beginning and end of the
+resulting list, and with |aux_save| holding the |prev_depth| value.
+
+@<Finish an alignment in a display@>=
+begin do_assignments;
+if cur_cmd<>math_shift then @<Pontificate about improper alignment in display@>
+else @<Check that another \.\$ follows@>;
+pop_nest;
+tail_append(new_penalty(pre_display_penalty));
+tail_append(new_param_glue(above_display_skip_code));
+vlink(tail):=p;
+if p<>null then tail:=q;
+tail_append(new_penalty(post_display_penalty));
+tail_append(new_param_glue(below_display_skip_code));
+prev_depth:=aux_save.sc; resume_after_display;
+end
+
+@ @<Pontificate...@>=
+begin print_err("Missing $$ inserted");
+@.Missing {\$\$} inserted@>
+help2("Displays can use special alignments (like \eqalignno)")@/
+  ("only if nothing but the alignment itself is between $$'s.");
+back_error;
+end
+
+@* \[49] Mode-independent processing.
+The long |main_control| procedure has now been fully specified, except for
+certain activities that are independent of the current mode. These activities
+do not change the current vlist or hlist or mlist; if they change anything,
+it is the value of a parameter or the meaning of a control sequence.
+
+Assignments to values in |eqtb| can be global or local. Furthermore, a
+control sequence can be defined to be `\.{\\long}', `\.{\\protected}',
+or `\.{\\outer}', and it might or might not be expanded. The prefixes
+`\.{\\global}', `\.{\\long}', `\.{\\protected}',
+and `\.{\\outer}' can occur in any order. Therefore we assign binary numeric
+codes, making it possible to accumulate the union of all specified prefixes
+by adding the corresponding codes.  (\PASCAL's |set| operations could also
+have been used.)
+
+@<Put each...@>=
+primitive("long",prefix,1);
+@!@:long_}{\.{\\long} primitive@>
+primitive("outer",prefix,2);
+@!@:outer_}{\.{\\outer} primitive@>
+primitive("global",prefix,4);
+@!@:global_}{\.{\\global} primitive@>
+primitive("def",def,0);
+@!@:def_}{\.{\\def} primitive@>
+primitive("gdef",def,1);
+@!@:gdef_}{\.{\\gdef} primitive@>
+primitive("edef",def,2);
+@!@:edef_}{\.{\\edef} primitive@>
+primitive("xdef",def,3);
+@!@:xdef_}{\.{\\xdef} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+prefix: if chr_code=1 then print_esc("long")
+  else if chr_code=2 then print_esc("outer")
+  @/@<Cases of |prefix| for |print_cmd_chr|@>@/
+  else print_esc("global");
+def: if chr_code=0 then print_esc("def")
+  else if chr_code=1 then print_esc("gdef")
+  else if chr_code=2 then print_esc("edef")
+  else print_esc("xdef");
+
+@ Every prefix, and every command code that might or might not be prefixed,
+calls the action procedure |prefixed_command|. This routine accumulates
+a sequence of prefixes until coming to a non-prefix, then it carries out
+the command.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(toks_register),
+any_mode(assign_toks),
+any_mode(assign_int),
+any_mode(assign_attr),
+any_mode(assign_dir),
+any_mode(assign_dimen),
+any_mode(assign_glue),
+any_mode(assign_mu_glue),
+any_mode(assign_font_dimen),
+any_mode(assign_font_int),
+any_mode(set_aux),
+any_mode(set_prev_graf),
+any_mode(set_page_dimen),
+any_mode(set_page_int),
+any_mode(set_box_dimen),
+any_mode(set_shape),
+any_mode(def_code),
+any_mode(extdef_code),
+any_mode(def_family),
+any_mode(set_font),
+any_mode(def_font),
+any_mode(letterspace_font),
+any_mode(register),
+any_mode(advance),
+any_mode(multiply),
+any_mode(divide),
+any_mode(prefix),
+any_mode(let),
+any_mode(shorthand_def),
+any_mode(read_to_cs),
+any_mode(def),
+any_mode(set_box),
+any_mode(hyph_data),
+any_mode(set_interaction),
+any_mode(set_ocp),
+any_mode(def_ocp),
+any_mode(set_ocp_list),
+any_mode(def_ocp_list),
+any_mode(clear_ocp_lists),
+any_mode(push_ocp_list),
+any_mode(pop_ocp_list),
+any_mode(ocp_list_op),
+any_mode(ocp_trace_level) : prefixed_command;
+
+@ If the user says, e.g., `\.{\\global\\global}', the redundancy is
+silently accepted.
+
+@<Declare act...@>=
+@t\4@>@<Declare subprocedures for |prefixed_command|@>@t@>@;@/
+procedure prefixed_command;
+label done,exit;
+var a:small_number; {accumulated prefix codes so far}
+@!f:internal_font_number; {identifies a font}
+@!j:halfword; {index into a \.{\\parshape} specification}
+@!p,@!q:pointer; {for temporary short-term use}
+@!n:integer; {ditto}
+@!e:boolean; {should a definition be expanded? or was \.{\\let} not done?}
+begin a:=0;
+while cur_cmd=prefix do
+  begin if not odd(a div cur_chr) then a:=a+cur_chr;
+  @<Get the next non-blank non-relax...@>;
+  if cur_cmd<=max_non_prefixed_command then
+    @<Discard erroneous prefixes and |return|@>;
+  if tracing_commands>2 then show_cur_cmd_chr;
+  end;
+@<Discard the prefixes \.{\\long} and \.{\\outer} if they are irrelevant@>;
+@<Adjust \(f)for the setting of \.{\\globaldefs}@>;
+case cur_cmd of
+@t\4@>@<Assignments@>@;
+othercases confusion("prefix")
+@:this can't happen prefix}{\quad prefix@>
+endcases;
+done: @<Insert a token saved by \.{\\afterassignment}, if any@>;
+exit:end;
+
+@ @<Discard erroneous...@>=
+begin print_err("You can't use a prefix with `");
+@.You can't use a prefix with x@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("I'll pretend you didn't say \long or \outer or \global.");
+back_error; return;
+end
+
+@ @<Discard the prefixes...@>=
+if a>=8 then
+  begin j:=protected_token; a:=a-8;
+  end
+else j:=0;
+if (cur_cmd<>def)and((a mod 4<>0)or(j<>0)) then
+  begin print_err("You can't use `"); print_esc("long"); print("' or `");
+  print_esc("outer"); print("' with `");
+@.You can't use \\long...@>
+  print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+  help1("I'll pretend you didn't say \long or \outer here.");
+  error;
+  end
+
+@ The previous routine does not have to adjust |a| so that |a mod 4=0|,
+since the following routines test for the \.{\\global} prefix as follows.
+
+@d global==(a>=4)
+@d define(#)==if global then geq_define(#)@+else eq_define(#)
+@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@d define_math_code(#)==if global 
+   then set_math_code(#,level_one)@+else set_math_code(#,cur_level)
+@d define_del_code(#)==if global 
+   then set_del_code(#,level_one)@+else set_del_code(#,cur_level)
+@d define_lc_code(#)==if global 
+   then set_lc_code(#,level_one)@+else set_lc_code(#,cur_level)
+@d define_uc_code(#)==if global 
+   then set_uc_code(#,level_one)@+else set_uc_code(#,cur_level)
+@d define_sf_code(#)==if global 
+   then set_sf_code(#,level_one)@+else set_sf_code(#,cur_level)
+@d define_cat_code(#)==if global 
+   then set_cat_code(cat_code_table,#,level_one)@+else set_cat_code(cat_code_table,#,cur_level)
+
+@<Adjust \(f)for the setting of \.{\\globaldefs}@>=
+if global_defs<>0 then
+  if global_defs<0 then
+    begin if global then a:=a-4;
+    end
+  else  begin if not global then a:=a+4;
+    end
+
+@ When a control sequence is to be defined, by \.{\\def} or \.{\\let} or
+something similar, the |get_r_token| routine will substitute a special
+control sequence for a token that is not redefinable.
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure get_r_token;
+label restart;
+begin restart: repeat get_token;
+until cur_tok<>space_token;
+if (cur_cs=0)or(cur_cs>frozen_control_sequence) then
+  begin print_err("Missing control sequence inserted");
+@.Missing control...@>
+  help5("Please don't say `\def cs{...}', say `\def\cs{...}'.")@/
+  ("I've inserted an inaccessible control sequence so that your")@/
+  ("definition will be completed without mixing me up too badly.")@/
+  ("You can recover graciously from this error, if you're")@/
+  ("careful; see exercise 27.2 in The TeXbook.");
+@:TeXbook}{\sl The \TeX book@>
+  if cur_cs=0 then back_input;
+  cur_tok:=cs_token_flag+frozen_protection; ins_error; goto restart;
+  end;
+end;
+
+@ @<Initialize table entries...@>=
+text(frozen_protection):="inaccessible";
+
+@ Assignments from Lua need helpers. 
+
+@p function is_int_assign(cmd:halfword):boolean;
+begin
+  is_int_assign := (cmd=assign_int);
+end;
+function is_dim_assign(cmd:halfword):boolean;
+begin
+  is_dim_assign := (cmd=assign_dimen);
+end;
+procedure assign_internal_int(cmd:halfword;value:integer);
+var  a:small_number;
+begin
+   a:=0;
+   word_define(cmd,value);
+end;
+procedure assign_internal_dim(cmd:halfword;value:integer);
+var  a:small_number;
+begin
+   a:=0;
+  word_define(cmd,value);
+end;
+
+
+@ Here's an example of the way many of the following routines operate.
+(Unfortunately, they aren't all as simple as this.)
+
+@<Assignments@>=
+set_font: define(cur_font_loc,data,cur_chr);
+
+@ When a |def| command has been scanned,
+|cur_chr| is odd if the definition is supposed to be global, and
+|cur_chr>=2| if the definition is supposed to be expanded.
+
+@<Assignments@>=
+def: begin if odd(cur_chr)and not global and(global_defs>=0) then a:=a+4;
+  e:=(cur_chr>=2); get_r_token; p:=cur_cs;
+  q:=scan_toks(true,e);
+  if j<>0 then
+    begin q:=get_avail; info(q):=j; link(q):=link(def_ref);
+    link(def_ref):=q;
+    end;
+  define(p,call+(a mod 4),def_ref);
+  end;
+
+@ Both \.{\\let} and \.{\\futurelet} share the command code |let|.
+
+@<Put each...@>=
+primitive("let",let,normal);@/
+@!@:let_}{\.{\\let} primitive@>
+primitive("futurelet",let,normal+1);@/
+@!@:future_let_}{\.{\\futurelet} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let");
+
+@ @<Assignments@>=
+let:  begin n:=cur_chr;
+  get_r_token; p:=cur_cs;
+  if n=normal then
+    begin repeat get_token;
+    until cur_cmd<>spacer;
+    if cur_tok=other_token+"=" then
+      begin get_token;
+      if cur_cmd=spacer then get_token;
+      end;
+    end
+  else  begin get_token; q:=cur_tok; get_token; back_input;
+    cur_tok:=q; back_input; {look ahead, then back up}
+    end; {note that |back_input| doesn't affect |cur_cmd|, |cur_chr|}
+  if cur_cmd>=call then add_token_ref(cur_chr);
+  define(p,cur_cmd,cur_chr);
+  end;
+
+@ A \.{\\chardef} creates a control sequence whose |cmd| is |char_given|;
+a \.{\\mathchardef} creates a control sequence whose |cmd| is |math_given|;
+and the corresponding |chr| is the character code or math code. A \.{\\countdef}
+or \.{\\dimendef} or \.{\\skipdef} or \.{\\muskipdef} creates a control
+sequence whose |cmd| is |assign_int| or \dots\ or |assign_mu_glue|, and the
+corresponding |chr| is the |eqtb| location of the internal register in question.
+
+@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
+@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
+@d omath_char_def_code=2 {|shorthand_def| for \.{\\omathchardef}}
+@d count_def_code=3 {|shorthand_def| for \.{\\countdef}}
+@d attribute_def_code=4 {|shorthand_def| for \.{\\attributedef}}
+@d dimen_def_code=5 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=6 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=7 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=8 {|shorthand_def| for \.{\\toksdef}}
+
+@<Put each...@>=
+primitive("chardef",shorthand_def,char_def_code);@/
+@!@:char_def_}{\.{\\chardef} primitive@>
+primitive("mathchardef",shorthand_def,math_char_def_code);@/
+@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("omathchardef",shorthand_def,omath_char_def_code);@/
+@!@:math_char_def_}{\.{\\omathchardef} primitive@>
+primitive("countdef",shorthand_def,count_def_code);@/
+@!@:count_def_}{\.{\\countdef} primitive@>
+primitive("attributedef",shorthand_def,attribute_def_code);@/
+@!@:attribute_def_}{\.{\\attributedef} primitive@>
+primitive("dimendef",shorthand_def,dimen_def_code);@/
+@!@:dimen_def_}{\.{\\dimendef} primitive@>
+primitive("skipdef",shorthand_def,skip_def_code);@/
+@!@:skip_def_}{\.{\\skipdef} primitive@>
+primitive("muskipdef",shorthand_def,mu_skip_def_code);@/
+@!@:mu_skip_def_}{\.{\\muskipdef} primitive@>
+primitive("toksdef",shorthand_def,toks_def_code);@/
+@!@:toks_def_}{\.{\\toksdef} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+shorthand_def: case chr_code of
+  char_def_code: print_esc("chardef");
+  math_char_def_code: print_esc("mathchardef");
+  omath_char_def_code: print_esc("omathchardef");
+  count_def_code: print_esc("countdef");
+  attribute_def_code: print_esc("attributedef");
+  dimen_def_code: print_esc("dimendef");
+  skip_def_code: print_esc("skipdef");
+  mu_skip_def_code: print_esc("muskipdef");
+  othercases print_esc("toksdef")
+  endcases;
+char_given: begin print_esc("char"); print_hex(chr_code);
+  end;
+math_given: begin print_esc("mathchar"); print_hex(chr_code);
+  end;
+omath_given: begin print_esc("omathchar"); print_hex(chr_code);
+  end;
+
+@ We temporarily define |p| to be |relax|, so that an occurrence of |p|
+while scanning the definition will simply stop the scanning instead of
+producing an ``undefined control sequence'' error or expanding the
+previous meaning.  This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
+
+@<Assignments@>=
+shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; 
+  define(p,relax,too_big_char); scan_optional_equals;
+  case n of
+  char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+    end;
+  math_char_def_code: begin scan_real_fifteen_bit_int;
+    define(p,math_given,cur_val);
+    end;
+  omath_char_def_code: begin scan_big_fifteen_bit_int;
+    define(p,omath_given,cur_val);
+    end;
+  othercases begin scan_register_num;
+    case n of
+    count_def_code: define(p,assign_int,count_base+cur_val);
+    attribute_def_code: define(p,assign_attr,attribute_base+cur_val);
+    dimen_def_code: define(p,assign_dimen,scaled_base+cur_val);
+    skip_def_code: define(p,assign_glue,skip_base+cur_val);
+    mu_skip_def_code: define(p,assign_mu_glue,mu_skip_base+cur_val);
+    toks_def_code: define(p,assign_toks,toks_base+cur_val);
+    end; {there are no other cases}
+    end
+  endcases;
+  end;
+
+@ @<Assignments@>=
+read_to_cs: begin j:=cur_chr; scan_int; n:=cur_val;
+  if not scan_keyword("to") then
+    begin print_err("Missing `to' inserted");
+@.Missing `to'...@>
+    help2("You should have said `\read<number> to \cs'.")@/
+    ("I'm going to look for the \cs now."); error;
+    end;
+  get_r_token;
+  p:=cur_cs; read_toks(n,p,j); define(p,call,cur_val);
+  end;
+
+@ The token-list parameters, \.{\\output} and \.{\\everypar}, etc., receive
+their values in the following way. (For safety's sake, we place an
+enclosing pair of braces around an \.{\\output} list.)
+
+@<Assignments@>=
+toks_register,assign_toks: begin q:=cur_cs;
+  if cur_cmd=toks_register then
+    begin scan_register_num; p:=toks_base+cur_val;
+    end
+  else p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
+  scan_optional_equals;
+  @<Get the next non-blank non-relax non-call token@>;
+  if cur_cmd<>left_brace then @<If the right-hand side is a token parameter
+      or token register, finish the assignment and |goto done|@>;
+  back_input; cur_cs:=q; q:=scan_toks(false,false);
+  if link(def_ref)=null then {empty list: revert to the default}
+    begin define(p,undefined_cs,null); free_avail(def_ref);
+    end
+  else  begin if p=output_routine_loc then {enclose in curlies}
+      begin p:=get_avail; link(q):=p; p:=output_routine_loc; 
+      q:=link(q);info(q):=right_brace_token+"}";
+      q:=get_avail;      
+      info(q):=left_brace_token+"{";
+      link(q):=link(def_ref); link(def_ref):=q;
+      end;
+    define(p,call,def_ref);
+    end;
+  end;
+
+@ @<If the right-hand side is a token parameter...@>=
+begin if cur_cmd=toks_register then
+  begin scan_register_num; cur_cmd:=assign_toks; cur_chr:=toks_base+cur_val;
+  end;
+if cur_cmd=assign_toks then
+  begin q:=equiv(cur_chr);
+  if q=null then define(p,undefined_cs,null)
+  else  begin add_token_ref(q); define(p,call,q);
+    end;
+  goto done;
+  end;
+end
+
+@ Similar routines are used to assign values to the numeric parameters.
+
+@<Assignments@>=
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+  if p=(int_base+cat_code_table_code) then begin
+    if valid_catcode_table(cur_val) then begin
+      if cur_val<>cat_code_table then
+        word_define(p,cur_val);
+      end
+    else begin
+      print_err("Invalid \catcode table");
+      help2("You can only switch to a \catcode table that is initialized")
+           ("using \savecatcodetable or \initcatcodetable, or to table 0");
+      error;
+      end;
+    end
+  else if (p=new_line_char)and(cur_val>127) then begin
+    print_err("Invalid \newlinechar");
+    help1("The value for \newlinechar has to be between 0 and 127.");
+    error;
+    end
+  else if p=end_line_char then begin
+    if (cur_val<0)or(cur_val>biggest_char) then
+      word_define(p,-1)
+    else
+      word_define(p,13);
+    end
+  else 
+   word_define(p,cur_val);
+{If we are defining subparagraph penalty levels while we are
+in hmode, then we put out a whatsit immediately, otherwise
+we leave it alone.  This mechanism might not be sufficiently
+powerful, and some other algorithm, searching down the stack,
+might be necessary.  Good first step.}
+  if (abs(mode)=hmode) and
+     ((p=(int_base+local_inter_line_penalty_code)) or
+      (p=(int_base+local_broken_penalty_code))) then begin
+    @<LOCAL: Add local paragraph node@>;
+    eq_word_define(int_base+no_local_whatsits_code,no_local_whatsits+1);
+    local_par_bool:=true;
+    end;
+  if p=int_base+language_code then word_define(int_base+cur_lang_code,cur_val);
+  end;
+assign_attr: begin p:=cur_chr; scan_optional_equals; scan_int;
+  if (p-attribute_base)>max_used_attr then max_used_attr:=(p-attribute_base);
+  attr_list_cache:=cache_disabled;
+  word_define(p,cur_val); end;
+assign_dir: begin
+  @<DIR: Assign direction codes@>
+  end;
+assign_dimen: begin p:=cur_chr; scan_optional_equals;
+  scan_normal_dimen; word_define(p,cur_val);
+  end;
+assign_glue,assign_mu_glue: begin p:=cur_chr; n:=cur_cmd; scan_optional_equals;
+  if n=assign_mu_glue then scan_glue(mu_val)@+else scan_glue(glue_val);
+  trap_zero_glue;
+  define(p,glue_ref,cur_val);
+  end;
+
+@ When a glue register or parameter becomes zero, it will always point to
+|zero_glue| because of the following procedure. (Exception: The tabskip
+glue isn't trapped while preambles are being scanned.)
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure trap_zero_glue;
+begin if (width(cur_val)=0)and(stretch(cur_val)=0)and(shrink(cur_val)=0) then
+  begin add_glue_ref(zero_glue);
+  delete_glue_ref(cur_val); cur_val:=zero_glue;
+  end;
+end;
+
+@ The various character code tables are changed by the |def_code| commands,
+and the font families are declared by |def_family|.
+
+@<Put each...@>=
+primitive("catcode",def_code,cat_code_base);
+@!@:cat_code_}{\.{\\catcode} primitive@>
+primitive("mathcode",def_code,math_code_base);
+@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("lccode",def_code,lc_code_base);
+@!@:lc_code_}{\.{\\lccode} primitive@>
+primitive("uccode",def_code,uc_code_base);
+@!@:uc_code_}{\.{\\uccode} primitive@>
+primitive("sfcode",def_code,sf_code_base);
+@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("textfont",def_family,math_font_base);
+@!@:text_font_}{\.{\\textfont} primitive@>
+primitive("scriptfont",def_family,math_font_base+script_size);
+@!@:script_font_}{\.{\\scriptfont} primitive@>
+primitive("scriptscriptfont",def_family,math_font_base+script_script_size);
+@!@:script_script_font_}{\.{\\scriptscriptfont} primitive@>
+primitive("omathcode",extdef_code,math_code_base);
+@!@:math_code_}{\.{\\omathcode} primitive@>
+primitive("odelcode",extdef_code,del_code_base);
+@!@:del_code_}{\.{\\odelcode} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+def_code: if chr_code=cat_code_base then print_esc("catcode")
+  else if chr_code=math_code_base then print_esc("mathcode")
+  else if chr_code=lc_code_base then print_esc("lccode")
+  else if chr_code=uc_code_base then print_esc("uccode")
+  else if chr_code=sf_code_base then print_esc("sfcode")
+  else print_esc("delcode");
+extdef_code: if chr_code=math_code_base then print_esc("omathcode")
+  else print_esc("odelcode");
+def_family: print_size(chr_code-math_font_base);
+
+@ The different types of code values have different legal ranges; the
+following program is careful to check each case properly.
+
+@d check_def_code(#)== if ((cur_val<0)and(p<#))or(cur_val>n) then
+      begin print_err("Invalid code ("); print_int(cur_val);
+      if p<# then print("), should be in the range 0..")
+      else print("), should be at most ");
+      print_int(n);
+      help1("I'm going to use 0 instead of that illegal code value.");@/
+      error; cur_val:=0;
+     end
+@.Invalid code@>
+
+
+@<Assignments@>=
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+  p:=cur_chr;
+  if cur_chr=math_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(math_code_base);
+    if cur_val=@"8000 then cur_val:=@"8000000
+    else cur_val:=((cur_val div @"1000) * @"1000000) +
+                  (((cur_val mod @"1000) div @"100) * @"10000) +
+                  (cur_val mod @"100);
+    define_math_code(p,cur_val);
+    end
+  else if cur_chr=lc_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(lc_code_base);
+    define_lc_code(p,cur_val);
+    end
+  else if cur_chr=uc_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(uc_code_base);
+    define_uc_code(p,cur_val);
+    end
+  else if cur_chr=sf_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(sf_code_base);
+    define_sf_code(p,cur_val);
+    end
+  else if cur_chr=cat_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(cat_code_base);
+    define_cat_code(p,cur_val);
+    end
+  else if cur_chr=del_code_base then begin
+    scan_char_num; p:= cur_val;
+    scan_optional_equals;  
+    scan_int;
+    check_def_code(del_code_base);
+    cur_val1:=cur_val div @"1000;
+    cur_val1:=(cur_val1 div @"100)*@"10000 + (cur_val1 mod @"100);
+    cur_val:=cur_val mod @"1000;
+    cur_val:=(cur_val div @"100)*@"10000 + (cur_val mod @"100);
+    define_del_code(p,cur_val1,cur_val);
+    end;
+  end;
+extdef_code: begin 
+  if cur_chr=del_code_base then begin
+   p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+   scan_int; cur_val1:=cur_val; scan_int; {backwards}
+   if (cur_val1>@"FFFFFF) or (cur_val>@"FFFFFF) then
+     begin print_err("Invalid code ("); print_int(cur_val1); print(" ");
+     print_int(cur_val);
+     print("), should be at most ""FFFFFF ""FFFFFF");
+     help1("I'm going to use 0 instead of that illegal code value.");@/
+     error; cur_val1:=0; cur_val:=0;
+     end;
+   define_del_code(p,cur_val1,cur_val);
+   end
+   else begin
+   p:=cur_chr; scan_char_num; p:=cur_val; scan_optional_equals;
+   scan_int;
+   if (cur_val>@"8000000) then
+     begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+     print("), should be at most ");  print_int(@"8000000);
+     help1("I'm going to use 0 instead of that illegal code value.");@/
+     error; cur_val:=0;
+     end;
+   define_math_code(p,cur_val);
+   end;
+  end;
+
+@ @<Let |n| be the largest...@>=
+if cur_chr=cat_code_base then n:=max_char_code
+else if cur_chr=lc_code_base then n:=biggest_char
+else if cur_chr=uc_code_base then n:=biggest_char
+else if cur_chr=math_code_base then n:=@'100000
+else if cur_chr=sf_code_base then n:=@'77777
+else if cur_chr=del_code_base then n:=@'77777777
+else n:=biggest_char
+
+@ @<Assignments@>=
+def_family: begin p:=cur_chr; scan_math_family_int; p:=p+cur_val;
+  scan_optional_equals; scan_font_ident; define(p,data,cur_val);
+  end;
+
+@ Next we consider changes to \TeX's numeric registers.
+
+@<Assignments@>=
+register,advance,multiply,divide: do_register_command(a);
+
+@ We use the fact that |register<advance<multiply<divide|.
+
+@<Declare subprocedures for |prefixed_command|@>=
+procedure do_register_command(@!a:small_number);
+label found,exit;
+var l,@!q,@!r,@!s:pointer; {for list manipulation}
+@!p:int_val..mu_val; {type of register involved}
+begin q:=cur_cmd; 
+@<Compute the register location |l| and its type |p|; but |return| if invalid@>;
+if q=register then scan_optional_equals
+else if scan_keyword("by") then do_nothing; {optional `\.{by}'}
+arith_error:=false;
+if q<multiply then @<Compute result of |register| or
+    |advance|, put it in |cur_val|@>
+else @<Compute result of |multiply| or |divide|, put it in |cur_val|@>;
+if arith_error then
+  begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+  help2("I can't carry out that multiplication or division,")@/
+    ("since the result is out of range.");
+  error; return;
+  end;
+if p<glue_val then begin
+   if p=attr_val then begin
+     if (l-attribute_base)>max_used_attr then max_used_attr:=(l-attribute_base);
+     attr_list_cache:=cache_disabled;
+     end;
+  word_define(l,cur_val);
+  end
+else  begin trap_zero_glue; define(l,glue_ref,cur_val);
+  end;
+exit: end;
+
+@ Here we use the fact that the consecutive codes |int_val...mu_val| and
+|assign_int..assign_mu_glue| correspond to each other nicely.
+
+@<Compute the register location |l| and its type |p|...@>=
+begin l:=0;
+if q<>register then
+  begin get_x_token;
+  if (cur_cmd>=assign_int)and(cur_cmd<=assign_mu_glue) then
+    begin l:=cur_chr; p:=cur_cmd-assign_int; goto found;
+    end;
+  if cur_cmd<>register then
+    begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr);
+@.You can't use x after ...@>
+    print("' after "); print_cmd_chr(q,0);
+    help1("I'm forgetting what you said and not changing anything.");
+    error; return;
+    end;
+  end;
+p:=cur_chr; scan_register_num;
+case p of
+int_val: l:=cur_val+count_base;
+attr_val: l:=cur_val+attribute_base;
+dimen_val: l:=cur_val+scaled_base;
+glue_val: l:=cur_val+skip_base;
+mu_val: l:=cur_val+mu_skip_base;
+end; {there are no other cases}
+end;
+found:
+
+@ @<Compute result of |register| or |advance|...@>=
+if p<glue_val then
+  begin if (p=int_val) or (p=attr_val) then scan_int@+else scan_normal_dimen;
+  if q=advance then cur_val:=cur_val+eqtb[l].int;
+  end
+else  begin scan_glue(p);
+  if q=advance then @<Compute the sum of two glue specs@>;
+  end
+
+@ @<Compute the sum of two glue specs@>=
+begin q:=new_spec(cur_val); r:=equiv(l);
+delete_glue_ref(cur_val);
+width(q):=width(q)+width(r);
+if stretch(q)=0 then stretch_order(q):=normal;
+if stretch_order(q)=stretch_order(r) then stretch(q):=stretch(q)+stretch(r)
+else if (stretch_order(q)<stretch_order(r))and(stretch(r)<>0) then
+  begin stretch(q):=stretch(r); stretch_order(q):=stretch_order(r);
+  end;
+if shrink(q)=0 then shrink_order(q):=normal;
+if shrink_order(q)=shrink_order(r) then shrink(q):=shrink(q)+shrink(r)
+else if (shrink_order(q)<shrink_order(r))and(shrink(r)<>0) then
+  begin shrink(q):=shrink(r); shrink_order(q):=shrink_order(r);
+  end;
+cur_val:=q;
+end
+
+@ @<Compute result of |multiply| or |divide|...@>=
+begin scan_int;
+if p<glue_val then
+  if q=multiply then
+    if (p=int_val)or(p=attr_val) then cur_val:=mult_integers(eqtb[l].int,cur_val)
+    else cur_val:=nx_plus_y(eqtb[l].int,cur_val,0)
+  else cur_val:=x_over_n(eqtb[l].int,cur_val)
+else  begin s:=equiv(l); r:=new_spec(s);
+  if q=multiply then
+    begin width(r):=nx_plus_y(width(s),cur_val,0);
+    stretch(r):=nx_plus_y(stretch(s),cur_val,0);
+    shrink(r):=nx_plus_y(shrink(s),cur_val,0);
+    end
+  else  begin width(r):=x_over_n(width(s),cur_val);
+    stretch(r):=x_over_n(stretch(s),cur_val);
+    shrink(r):=x_over_n(shrink(s),cur_val);
+    end;
+  cur_val:=r;
+  end;
+end
+
+@ The processing of boxes is somewhat different, because we may need
+to scan and create an entire box before we actually change the value of the old
+one.
+
+@<Assignments@>=
+set_box: begin scan_register_num;
+  if global then n:=global_box_flag+cur_val@+else n:=box_flag+cur_val;
+  scan_optional_equals;
+  if set_box_allowed then scan_box(n)
+  else begin print_err("Improper "); print_esc("setbox");
+@.Improper \\setbox@>
+    help2("Sorry, \setbox is not allowed after \halign in a display,")@/
+    ("or between \accent and an accented character."); error;
+    end;
+  end;
+
+@ The |space_factor| or |prev_depth| settings are changed when a |set_aux|
+command is sensed. Similarly, |prev_graf| is changed in the presence of
+|set_prev_graf|, and |dead_cycles| or |insert_penalties| in the presence of
+|set_page_int|. These definitions are always global.
+
+When some dimension of a box register is changed, the change isn't exactly
+global; but \TeX\ does not look at the \.{\\global} switch.
+
+@<Assignments@>=
+set_aux:alter_aux;
+set_prev_graf:alter_prev_graf;
+set_page_dimen:alter_page_so_far;
+set_page_int:alter_integer;
+set_box_dimen:alter_box_dimen;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_aux;
+var c:halfword; {|hmode| or |vmode|}
+begin if cur_chr<>abs(mode) then report_illegal_case
+else  begin c:=cur_chr; scan_optional_equals;
+  if c=vmode then
+    begin scan_normal_dimen; prev_depth:=cur_val;
+    end
+  else  begin scan_int;
+    if (cur_val<=0)or(cur_val>32767) then
+      begin print_err("Bad space factor");
+@.Bad space factor@>
+      help1("I allow only values in the range 1..32767 here.");
+      int_error(cur_val);
+      end
+    else space_factor:=cur_val;
+    end;
+  end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_prev_graf;
+var p:0..nest_size; {index into |nest|}
+begin nest[nest_ptr]:=cur_list; p:=nest_ptr;
+while abs(nest[p].mode_field)<>vmode do decr(p);
+scan_optional_equals; scan_int;
+if cur_val<0 then
+  begin print_err("Bad "); print_esc("prevgraf");
+@.Bad \\prevgraf@>
+  help1("I allow only nonnegative values here.");
+  int_error(cur_val);
+  end
+else  begin nest[p].pg_field:=cur_val; cur_list:=nest[nest_ptr];
+  end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_page_so_far;
+var c:0..7; {index into |page_so_far|}
+begin c:=cur_chr; scan_optional_equals; scan_normal_dimen;
+page_so_far[c]:=cur_val;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_integer;
+var c:small_number;
+  {0 for \.{\\deadcycles}, 1 for \.{\\insertpenalties}, etc.}
+begin c:=cur_chr; scan_optional_equals; scan_int;
+if c=0 then dead_cycles:=cur_val
+@/@<Cases for |alter_integer|@>@/
+else insert_penalties:=cur_val;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure alter_box_dimen;
+var c:small_number; {|width_offset| or |height_offset| or |depth_offset|}
+@!b:eight_bits; {box number}
+begin c:=cur_chr; scan_register_num; b:=cur_val; scan_optional_equals;
+scan_normal_dimen;
+if box(b)<>null then vmem(box(b)+c).sc:=cur_val;
+end;
+
+@ Paragraph shapes are set up in an obvious way. It needs one word more than in 
+\TeX, though.
+
+@d shape_node=54 { storage for shape pointers }
+
+@<Assignments@>=
+set_shape: begin q:=cur_chr; scan_optional_equals; scan_int; n:=cur_val;
+  if n<=0 then p:=null
+  else if q>par_shape_loc then
+    begin n:=(cur_val div 2)+1; p:=new_node(shape_node,2*n+1+1); vinfo(p+1):=n;
+    n:=cur_val; vmem(p+2).int:=n; {number of penalties}
+    for j:=p+3 to p+n+2 do
+      begin scan_int; vmem(j).int:=cur_val; {penalty values}
+      end;
+    if not odd(n) then vmem(p+n+3).int:=0; {unused}
+    end
+  else  begin p:=new_node(shape_node,2*(n+1)+1); vinfo(p+1):=n;
+    for j:=1 to n do
+      begin scan_normal_dimen;
+      vmem(p+2*j).sc:=cur_val; {indentation}
+      scan_normal_dimen;
+      vmem(p+2*j+1).sc:=cur_val; {width}
+      end;
+    end;
+  define(q,shape_ref,p);
+  end;
+
+@ New language information data is loaded by the |hyph_data| command.
+
+@<Put each...@>=
+primitive("hyphenation",hyph_data,0);
+@!@:hyphenation_}{\.{\\hyphenation} primitive@>
+primitive("patterns",hyph_data,1);
+@!@:patterns_}{\.{\\patterns} primitive@>
+primitive("prehyphenchar",hyph_data,2);
+@!@:prehyphenchar_}{\.{\\prehyphenchar} primitive@>
+primitive("posthyphenchar",hyph_data,3);
+@!@:posthyphenchar_}{\.{\\posthyphenchar} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hyph_data: case cur_chr of 
+    0: print_esc("hyphenation"); 
+    1: print_esc("patterns"); 
+    2: print_esc("prehyphenchar"); 
+    3: print_esc("posthyphenchar");
+    endcases;
+
+@ @<Assignments@>=
+hyph_data: begin 
+   case cur_chr of 
+    0: new_hyph_exceptions; 
+    1: new_patterns; 
+    2: new_pre_hyphen_char; 
+    3: new_post_hyphen_char;
+    endcases;
+  goto done;
+  end;
+
+@ All of \TeX's parameters are kept in |eqtb| except the font information,
+the interaction mode, and the hyphenation tables; these are strictly global.
+
+@<Assignments@>=
+assign_font_dimen: set_font_dimen;
+assign_font_int: begin 
+  n:=cur_chr; scan_font_ident; f:=cur_val;
+  if n = no_lig_code then set_no_ligatures(f)
+  else if n < lp_code_base then begin
+    scan_optional_equals; scan_int;
+    if n=0 then set_hyphen_char(f,cur_val)@+else set_skew_char(f,cur_val);
+  end
+  else begin
+    scan_char_num; p := cur_val;
+    scan_optional_equals; scan_int;
+    case n of
+    lp_code_base: set_lp_code(f, p, cur_val);
+    rp_code_base: set_rp_code(f, p, cur_val);
+    ef_code_base: set_ef_code(f, p, cur_val);
+    tag_code:     set_tag_code(f, p, cur_val);
+    end;
+  end;
+end;
+
+@ @<Put each...@>=
+primitive("hyphenchar",assign_font_int,0);
+@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
+primitive("skewchar",assign_font_int,1);
+@!@:skew_char_}{\.{\\skewchar} primitive@>
+primitive("lpcode",assign_font_int,lp_code_base);
+@!@:lp_code_}{\.{\\lpcode} primitive@>
+primitive("rpcode",assign_font_int,rp_code_base);
+@!@:rp_code_}{\.{\\rpcode} primitive@>
+primitive("efcode",assign_font_int,ef_code_base);
+@!@:ef_code_}{\.{\\efcode} primitive@>
+primitive("tagcode",assign_font_int,tag_code);
+@!@:tag_code_}{\.{\\tagcode} primitive@>
+primitive("pdfnoligatures",assign_font_int,no_lig_code);
+@!@:no_lig_code_}{\.{\\pdfnoligatures} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+assign_font_int: case chr_code of
+0: print_esc("hyphenchar");
+1: print_esc("skewchar");
+lp_code_base: print_esc("lpcode");
+rp_code_base: print_esc("rpcode");
+ef_code_base: print_esc("efcode");
+tag_code: print_esc("tagcode");
+no_lig_code: print_esc("pdfnoligatures");
+endcases;
+
+@ Here is where the information for a new font gets loaded.
+
+@<Assignments@>=
+def_font: def_new_font(a);
+letterspace_font: new_letterspaced_font(a);
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure def_new_font(@!a:small_number);
+var u:pointer; {user's font identifier}
+@!s:scaled; {stated ``at'' size, or negative of scaled magnification}
+@!f:internal_font_number; {runs through existing fonts}
+@!t:str_number; {name for the frozen font identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!offset:integer;
+@!natural_dir:integer;{the natural direction of the font}
+@!flushable_string:str_number; {string not yet referenced}
+@!junk:pointer;
+begin if job_name=0 then open_log_file;
+  {avoid confusing \.{texput} with the font name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u=null_cs then t:="FONT"
+else  begin old_setting:=selector; selector:=new_string;
+  print("FONT"); print(u-active_base); selector:=old_setting;
+@.FONTx@>
+  str_room(1); t:=make_string;
+  end;
+define(u,set_font,null_font); scan_optional_equals; 
+@<Get the next non-blank non-call token@>;
+if cur_cmd<>left_brace then begin
+  back_input;
+  scan_file_name;
+  end 
+else begin
+  back_input;
+  junk:=scan_toks(false,true);
+  old_setting:=selector; selector:=new_string;
+  token_show(def_ref); selector:=old_setting;
+  flush_list(def_ref);
+  str_room(1);
+  cur_name:=make_string;
+  cur_ext:=""; 
+  cur_area:="";
+  end;
+@<Scan the font size specification@>;
+name_in_progress:=true;
+if scan_keyword("offset") then begin
+  scan_int;
+  offset:=cur_val;
+  if (cur_val<0) then begin
+    print_err("Illegal offset has been changed to 0");
+    help1("The offset must be bigger than 0."); int_error(cur_val);
+    offset:=0;
+    end
+  end
+else offset:=0;
+if scan_keyword("naturaldir") then begin
+  scan_direction;
+  natural_dir:=cur_val;
+  end
+else natural_dir:=-1;
+name_in_progress:=false;
+if cur_area = "" then
+  f:=read_font_info(u,cur_name,"",s,natural_dir)
+else
+  f:=read_font_info(u,cur_name,cur_area,s,natural_dir);
+equiv(u):=f; eqtb[font_id_base+f]:=eqtb[u]; font_id_text(f):=t;
+end;
+
+@ @<Scan the font size specification@>=
+name_in_progress:=true; {this keeps |cur_name| from being changed}
+if scan_keyword("at") then @<Put the \(p)(positive) `at' size into |s|@>
+@.at@>
+else if scan_keyword("scaled") then
+@.scaled@>
+  begin scan_int; s:=-cur_val;
+  if (cur_val<=0)or(cur_val>32768) then
+    begin print_err("Illegal magnification has been changed to 1000");@/
+@.Illegal magnification...@>
+    help1("The magnification ratio must be between 1 and 32768.");
+    int_error(cur_val); s:=-1000;
+    end;
+  end
+else s:=-1000;
+name_in_progress:=false
+
+@ @<Put the \(p)(positive) `at' size into |s|@>=
+begin scan_normal_dimen; s:=cur_val;
+if (s<=0)or(s>=@'1000000000) then
+  begin print_err("Improper `at' size (");
+  print_scaled(s); print("pt), replaced by 10pt");
+@.Improper `at' size...@>
+  help2("I can only handle fonts at positive sizes that are")@/
+  ("less than 2048pt, so I've changed what you said to 10pt.");
+  error; s:=10*unity;
+  end;
+end
+
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_font:begin print("select font "); print_font_name(chr_code);
+  if font_size(chr_code)<>font_dsize(chr_code) then
+    begin print(" at "); print_scaled(font_size(chr_code));
+    print("pt");
+    end;
+  end;
+
+@ @<Put each...@>=
+primitive("batchmode",set_interaction,batch_mode);
+@!@:batch_mode_}{\.{\\batchmode} primitive@>
+primitive("nonstopmode",set_interaction,nonstop_mode);
+@!@:nonstop_mode_}{\.{\\nonstopmode} primitive@>
+primitive("scrollmode",set_interaction,scroll_mode);
+@!@:scroll_mode_}{\.{\\scrollmode} primitive@>
+primitive("errorstopmode",set_interaction,error_stop_mode);
+@!@:error_stop_mode_}{\.{\\errorstopmode} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_interaction: case chr_code of
+  batch_mode: print_esc("batchmode");
+  nonstop_mode: print_esc("nonstopmode");
+  scroll_mode: print_esc("scrollmode");
+  othercases print_esc("errorstopmode")
+  endcases;
+
+@ @<Assignments@>=
+set_interaction: new_interaction;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_interaction;
+begin print_ln;
+interaction:=cur_chr;
+@<Initialize the print |selector| based on |interaction|@>;
+if log_opened then selector:=selector+2;
+end;
+
+@ The \.{\\afterassignment} command puts a token into the global
+variable |after_token|. This global variable is examined just after
+every assignment has been performed.
+
+@<Glob...@>=
+@!after_token:halfword; {zero, or a saved token}
+
+@ @<Set init...@>=
+after_token:=0;
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(after_assignment):begin get_token; after_token:=cur_tok;
+  end;
+
+@ @<Insert a token saved by \.{\\afterassignment}, if any@>=
+if after_token<>0 then
+  begin cur_tok:=after_token; back_input; after_token:=0;
+  end
+
+@ Here is a procedure that might be called `Get the next non-blank non-relax
+non-call non-assignment token'.
+
+@<Declare act...@>=
+procedure do_assignments;
+label exit;
+begin loop begin @<Get the next non-blank non-relax...@>;
+  if cur_cmd<=max_non_prefixed_command then return;
+  set_box_allowed:=false; prefixed_command; set_box_allowed:=true;
+  end;
+exit:end;
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(after_group):begin get_token; save_for_after(cur_tok);
+  end;
+
+@ Files for \.{\\read} are opened and closed by the |in_stream| command.
+
+@<Put each...@>=
+primitive("openin",in_stream,1);
+@!@:open_in_}{\.{\\openin} primitive@>
+primitive("closein",in_stream,0);
+@!@:close_in_}{\.{\\closein} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+in_stream: if chr_code=0 then print_esc("closein")
+  else print_esc("openin");
+
+@ @<Cases of |main_control| that don't...@>=
+any_mode(in_stream): open_or_close_in;
+
+@ @<Declare act...@>=
+procedure open_or_close_in;
+var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
+@!n:0..15; {stream number}
+begin c:=cur_chr; scan_four_bit_int; n:=cur_val;
+if read_open[n]<>closed then
+  begin lua_a_close_in(read_file[n],(n+1)); read_open[n]:=closed;
+  end;
+if c<>0 then
+  begin scan_optional_equals; scan_file_name;
+  if cur_ext="" then cur_ext:=".tex";
+  pack_cur_name;
+  if lua_a_open_in(read_file[n],(n+1)) then begin
+     read_file[n]:= name_file_pointer;
+     read_open[n]:=just_open;
+     end;
+  end;
+end;
+
+@ The user can issue messages to the terminal, regardless of the
+current mode.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(message):issue_message;
+
+@ @<Put each...@>=
+primitive("message",message,0);
+@!@:message_}{\.{\\message} primitive@>
+primitive("errmessage",message,1);
+@!@:err_message_}{\.{\\errmessage} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+message: if chr_code=0 then print_esc("message")
+  else print_esc("errmessage");
+
+@ @<Declare act...@>=
+procedure issue_message;
+var old_setting:0..max_selector; {holds |selector| setting}
+junk:pointer;
+@!c:0..1; {identifies \.{\\message} and \.{\\errmessage}}
+@!s:str_number; {the message}
+begin c:=cur_chr; junk:=scan_toks(false,true);
+old_setting:=selector; selector:=new_string;
+token_show(def_ref); selector:=old_setting;
+flush_list(def_ref);
+str_room(1); s:=make_string;
+if c=0 then @<Print string |s| on the terminal@>
+else @<Print string |s| as an error message@>;
+flush_string;
+end;
+
+@ @<Print string |s| on the terminal@>=
+begin if term_offset+length(s)>max_print_line-2 then print_ln
+else if (term_offset>0)or(file_offset>0) then print_char(" ");
+slow_print(s); update_terminal;
+end
+
+@ If \.{\\errmessage} occurs often in |scroll_mode|, without user-defined
+\.{\\errhelp}, we don't want to give a long help message each time. So we
+give a verbose explanation only once.
+
+@<Glob...@>=
+@!long_help_seen:boolean; {has the long \.{\\errmessage} help been used?}
+
+@ @<Set init...@>=long_help_seen:=false;
+
+@ @<Print string |s| as an error message@>=
+begin print_err(""); slow_print(s);
+if err_help<>null then use_err_help:=true
+else if long_help_seen then help1("(That was another \errmessage.)")
+else  begin if interaction<error_stop_mode then long_help_seen:=true;
+  help4("This error message was generated by an \errmessage")@/
+  ("command, so I can't give any explicit help.")@/
+  ("Pretend that you're Hercule Poirot: Examine all clues,")@/
+@^Poirot, Hercule@>
+  ("and deduce the truth by order and method.");
+  end;
+error; use_err_help:=false;
+end
+
+@ The |error| routine calls on |give_err_help| if help is requested from
+the |err_help| parameter.
+
+@p procedure give_err_help;
+begin token_show(err_help);
+end;
+
+@ The \.{\\uppercase} and \.{\\lowercase} commands are implemented by
+building a token list and then changing the cases of the letters in it.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(case_shift):shift_case;
+
+@ @<Put each...@>=
+primitive("lowercase",case_shift,lc_code_base);
+@!@:lowercase_}{\.{\\lowercase} primitive@>
+primitive("uppercase",case_shift,uc_code_base);
+@!@:uppercase_}{\.{\\uppercase} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+case_shift:if chr_code=lc_code_base then print_esc("lowercase")
+  else print_esc("uppercase");
+
+@ @<Declare act...@>=
+procedure shift_case;
+var b:pointer; {|lc_code_base| or |uc_code_base|}
+@!p:pointer; {runs through the token list}
+@!t:halfword; {token}
+@!c:halfword; {character code}
+@!i:halfword; {inbetween}
+begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
+while p<>null do
+  begin @<Change the case of the token in |p|, if a change is appropriate@>;
+  p:=link(p);
+  end;
+back_list(link(def_ref)); free_avail(def_ref); {omit reference count}
+end;
+
+@ When the case of a |chr_code| changes, we don't change the |cmd|.
+We also change active characters, using the fact that
+|cs_token_flag+active_base| is a multiple of~|string_offset|.
+@^data structure assumptions@>
+
+@<Change the case of the token in |p|, if a change is appropriate@>=
+t:=info(p);
+if t<cs_token_flag+null_cs then
+  begin 
+  c:=t mod string_offset;
+  if b=uc_code_base then begin 
+     i:=get_uc_code(c);
+	 if i<>0 then info(p):=t-c+i; 
+     end
+  else 
+     begin if get_lc_code(c)<>0 then info(p):=t-c+get_lc_code(c); end;
+  end
+
+@ We come finally to the last pieces missing from |main_control|, namely the
+`\.{\\show}' commands that are useful when debugging.
+
+@<Cases of |main_control| that don't...@>=
+any_mode(xray): show_whatever;
+
+@ @d show_code=0 { \.{\\show} }
+@d show_box_code=1 { \.{\\showbox} }
+@d show_the_code=2 { \.{\\showthe} }
+@d show_lists=3 { \.{\\showlists} }
+
+@<Put each...@>=
+primitive("show",xray,show_code);
+@!@:show_}{\.{\\show} primitive@>
+primitive("showbox",xray,show_box_code);
+@!@:show_box_}{\.{\\showbox} primitive@>
+primitive("showthe",xray,show_the_code);
+@!@:show_the_}{\.{\\showthe} primitive@>
+primitive("showlists",xray,show_lists);
+@!@:show_lists_}{\.{\\showlists} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+xray: case chr_code of
+  show_box_code:print_esc("showbox");
+  show_the_code:print_esc("showthe");
+  show_lists:print_esc("showlists");
+  @<Cases of |xray| for |print_cmd_chr|@>@;@/
+  othercases print_esc("show")
+  endcases;
+
+@ @<Declare act...@>=
+procedure show_whatever;
+label common_ending;
+var p:pointer; {tail of a token list to show}
+@!t:small_number; {type of conditional being shown}
+@!m:normal..or_code; {upper bound on |fi_or_else| codes}
+@!l:integer; {line where that conditional began}
+@!n:integer; {level of \.{\\if...\\fi} nesting}
+begin case cur_chr of
+show_lists: begin begin_diagnostic; show_activities;
+  end;
+show_box_code: @<Show the current contents of a box@>;
+show_code: @<Show the current meaning of a token, then |goto common_ending|@>;
+@<Cases for |show_whatever|@>@;@/
+othercases @<Show the current value of some parameter or register,
+  then |goto common_ending|@>
+endcases;@/
+@<Complete a potentially long \.{\\show} command@>;
+common_ending: if interaction<error_stop_mode then
+  begin help0; decr(error_count);
+  end
+else if tracing_online>0 then
+  begin@t@>@;@/
+  help3("This isn't an error message; I'm just \showing something.")@/
+  ("Type `I\show...' to show more (e.g., \show\cs,")@/
+  ("\showthe\count10, \showbox255, \showlists).");
+  end
+else  begin@t@>@;@/
+  help5("This isn't an error message; I'm just \showing something.")@/
+  ("Type `I\show...' to show more (e.g., \show\cs,")@/
+  ("\showthe\count10, \showbox255, \showlists).")@/
+  ("And type `I\tracingonline=1\show...' to show boxes and")@/
+  ("lists on your terminal as well as in the transcript file.");
+  end;
+error;
+end;
+
+@ @<Show the current meaning of a token...@>=
+begin get_token;
+if interaction=error_stop_mode then wake_up_terminal;
+print_nl("> ");
+if cur_cs<>0 then
+  begin sprint_cs(cur_cs); print_char("=");
+  end;
+print_meaning; goto common_ending;
+end
+
+@ @<Cases of |print_cmd_chr|...@>=
+undefined_cs: print("undefined");
+call,long_call,outer_call,long_outer_call: begin n:=cmd-call;
+  if info(link(chr_code))=protected_token then n:=n+4;
+  if odd(n div 4) then print_esc("protected");
+  if odd(n) then print_esc("long");
+  if odd(n div 2) then print_esc("outer");
+  if n>0 then print_char(" ");
+  print("macro");
+  end;
+end_template: print_esc("outer endtemplate");
+
+@ @<Show the current contents of a box@>=
+begin scan_register_num; begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if box(cur_val)=null then print("void")
+else show_box(box(cur_val));
+end
+
+@ @<Show the current value of some parameter...@>=
+begin p:=the_toks;
+if interaction=error_stop_mode then wake_up_terminal;
+print_nl("> "); token_show(temp_token_head);
+flush_list(link(temp_token_head)); goto common_ending;
+end
+
+@ @<Complete a potentially long \.{\\show} command@>=
+end_diagnostic(true); print_err("OK");
+@.OK@>
+if selector=term_and_log then if tracing_online<=0 then
+  begin selector:=term_only; print(" (see the transcript file)");
+  selector:=term_and_log;
+  end
+
+@* \[50] Dumping and undumping the tables.
+After \.{INITEX} has seen a collection of fonts and macros, it
+can write all the necessary information on an auxiliary file so
+that production versions of \TeX\ are able to initialize their
+memory at high speed. The present section of the program takes
+care of such output and input. We shall consider simultaneously
+the processes of storing and restoring,
+so that the inverse relation between them is clear.
+@.INITEX@>
+
+The global variable |format_ident| is a string that is printed right
+after the |banner| line when \TeX\ is ready to start. For \.{INITEX} this
+string says simply `\.{(INITEX)}'; for other versions of \TeX\ it says,
+for example, `\.{(preloaded format=plain 82.11.19)}', showing the year,
+month, and day that the format file was created. We have |format_ident=0|
+before \TeX's tables are loaded.
+
+@<Glob...@>=
+@!format_ident:str_number;
+@!format_name:str_number; {principal file name}
+
+@ @<Set init...@>=
+format_ident:=0;
+format_name:="";
+
+@ @<Initialize table entries...@>=
+format_ident:=" (INITEX)";
+
+@ @<Declare act...@>=
+@!init procedure store_fmt_file;
+label found1,found2,done1,done2;
+var j,@!k,@!l:integer; {all-purpose indices}
+@!p: pointer; {all-purpose pointer}
+@!x: integer; {something to dump}
+@!w: four_quarters; {four ASCII codes}
+begin @<If dumping is not allowed, abort@>;
+@<Create the |format_ident|, open the format file,
+  and inform the user that dumping has begun@>;
+@<Dump constants for consistency check@>;
+@<Dump the string pool@>;
+@<Dump the dynamic memory@>;
+@<Dump the table of equivalents@>;
+@<Dump the font information@>;
+@<Dump the active ocp information@>;
+@<Dump the ocp information@>;
+@<Dump the ocp list information@>;
+@<Dump the hyphenation tables@>;
+@<Dump a couple more things and the closing check word@>;
+@<Dump the lua bytecodes@>;
+@<Close the format file@>;
+end;
+tini
+
+@ Corresponding to the procedure that dumps a format file, we have a function
+that reads one in. The function returns |false| if the dumped format is
+incompatible with the present \TeX\ table sizes, etc.
+
+@d bad_fmt=6666 {go here if the format file is unacceptable}
+@d too_small(#)==begin wake_up_terminal;
+  wterm_ln('---! Must increase the ',#);
+@.Must increase the x@>
+  goto bad_fmt;
+  end
+
+@p @t\4@>@<Declare the function called |open_fmt_file|@>@;
+function load_fmt_file:boolean;
+label bad_fmt,exit;
+var j,@!k:integer; {all-purpose indices}
+@!p: pointer; {all-purpose pointer}
+@!x: integer; {something undumped}
+@!w: four_quarters; {four ASCII codes}
+begin @<Undump constants for consistency check@>;
+@<Undump the string pool@>;
+@<Undump the dynamic memory@>;
+@<Undump the table of equivalents@>;
+@<Undump the font information@>;
+@<Undump the active ocp information@>;
+@<Undump the ocp information@>;
+@<Undump the ocp list information@>;
+@<Undump the hyphenation tables@>;
+@<Undump a couple more things and the closing check word@>;
+@<Undump the lua bytecodes@>;
+load_fmt_file:=true; return; {it worked!}
+bad_fmt: wake_up_terminal;
+  wterm_ln('(Fatal format file error; I''m stymied)');
+@.Fatal format file error@>
+load_fmt_file:=false;
+exit:end;
+
+@ The user is not allowed to dump a format file unless |save_ptr=0|.
+This condition implies that |cur_level=level_one|, hence
+the |xeq_level| array is constant and it need not be dumped.
+
+@<If dumping is not allowed, abort@>=
+if save_ptr<>0 then
+  begin print_err("You can't dump inside a group");
+@.You can't dump...@>
+  help1("`{...\dump}' is a no-no."); succumb;
+  end
+
+@ Format files consist of |memory_word| items, and we use the following
+macros to dump words of different types:
+
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+
+@<Glob...@>=
+@!fmt_file:word_file; {for input or output of format information}
+
+@ The inverse macros are slightly more complicated, since we need to check
+the range of the values we are reading in. We say `|undump(a)(b)(x)|' to
+read an integer value |x| that is supposed to be in the range |a<=x<=b|.
+
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@d undump_end_end(#)==#:=x;@+end
+@d undump_end(#)==(x>#) then goto bad_fmt@+else undump_end_end
+@d undump(#)==begin undump_int(x); if (x<#) or undump_end
+@d undump_size_end_end(#)==too_small(#)@+else undump_end_end
+@d undump_size_end(#)==if x># then undump_size_end_end
+@d undump_size(#)==begin undump_int(x);
+  if x<# then goto bad_fmt; undump_size_end
+
+@ The next few sections of the program should make it clear how we use the
+dump/undump macros.
+
+@<Dump constants for consistency check@>=
+dump_int(@$);@/
+dump_int(eqtb_size);@/
+dump_int(hash_prime)
+
+@ Sections of a \.{WEB} program that are ``commented out'' still contribute
+strings to the string pool; therefore \.{INITEX} and \TeX\ will have
+the same strings. (And it is, of course, a good thing that they do.)
+@.WEB@>
+@^string pool@>
+
+@<Undump constants for consistency check@>=
+x:=fmt_file^.int;
+if x<>@$ then goto bad_fmt; {check that strings are the same}
+undump_int(x);@/
+if x<>eqtb_size then goto bad_fmt;
+undump_int(x);
+if x<>hash_prime then goto bad_fmt
+
+@ @d dump_four_ASCII==
+  w.b0:=qi(so(str_pool[k])); w.b1:=qi(so(str_pool[k+1]));
+  w.b2:=qi(so(str_pool[k+2])); w.b3:=qi(so(str_pool[k+3]));
+  dump_qqqq(w)
+
+@<Dump the string pool@>=
+dump_int(pool_ptr);
+dump_int(str_ptr);
+for k:=string_offset to str_ptr do dump_int(str_start_macro(k));
+k:=0;
+while k+4<pool_ptr do
+  begin dump_four_ASCII; k:=k+4;
+  end;
+k:=pool_ptr-4; dump_four_ASCII;
+print_ln; print_int(str_ptr-string_offset); print(" strings of total length ");
+print_int(pool_ptr)
+
+@ @d undump_four_ASCII==
+  undump_qqqq(w);
+  str_pool[k]:=si(qo(w.b0)); str_pool[k+1]:=si(qo(w.b1));
+  str_pool[k+2]:=si(qo(w.b2)); str_pool[k+3]:=si(qo(w.b3))
+
+@<Undump the string pool@>=
+undump_size(0)(pool_size)('string pool size')(pool_ptr);
+undump_size(0)(max_strings)('max strings')(str_ptr);
+for k:=string_offset to str_ptr do undump(0)(pool_ptr)(str_start_macro(k));
+k:=0;
+while k+4<pool_ptr do
+  begin undump_four_ASCII; k:=k+4;
+  end;
+k:=pool_ptr-4; undump_four_ASCII;
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr
+
+@ By sorting the list of available spaces in the variable-size portion of
+|mem|, we are usually able to get by without having to dump very much
+of the dynamic memory.
+
+We recompute |var_used| and |dyn_used|, so that \.{INITEX} dumps valid
+information even when it has not been gathering statistics.
+
+@<Dump the dynamic memory@>=
+dump_node_mem;
+@#
+dump_int(temp_token_head); dump_int(hold_token_head);
+dump_int(omit_template); dump_int(null_list);
+dump_int(backup_head); dump_int(garbage);
+dump_int(fix_mem_min); dump_int(fix_mem_max);
+dump_int(fix_mem_end);
+dump_int(avail);
+dyn_used:=fix_mem_end+1;
+for k:=fix_mem_min to fix_mem_end do dump_wd(mem(k));
+x:=x+(fix_mem_end+1-fix_mem_min);
+p:=avail;
+while p<>null do
+  begin decr(dyn_used); p:=link(p);
+  end;
+dump_int(dyn_used);
+print_ln; print_int(x);
+print(" memory locations dumped; current usage is ");
+print_int(var_used); print_char("&"); print_int(dyn_used)
+
+@ @<Undump the dynamic memory@>=
+undump_node_mem;
+@#
+undump_int(temp_token_head); undump_int(hold_token_head);
+undump_int(omit_template); undump_int(null_list); 
+undump_int(backup_head); undump_int(garbage);
+undump_int(fix_mem_min);undump_int(fix_mem_max);
+fixmem:= xmallocarray (smemory_word, fix_mem_max+1);
+memset (voidcast(fixmem),0,(fix_mem_max+1)*sizeof(smemory_word));
+undump_int(fix_mem_end);
+undump_int(avail);
+for k:=fix_mem_min to fix_mem_end do undump_wd(mem(k));
+undump_int(dyn_used)
+
+@ @<Dump the table of equivalents@>=
+@<Dump regions 1 to 4 of |eqtb|@>;
+@<Dump regions 5 and 6 of |eqtb|@>;
+dump_int(par_loc); dump_int(write_loc);@/
+dump_math_codes;
+dump_text_codes;
+@<Dump the hash table@>
+
+@ @<Undump the table of equivalents@>=
+@<Undump regions 1 to 6 of |eqtb|@>;
+undump(hash_base)(frozen_control_sequence)(par_loc);
+par_token:=cs_token_flag+par_loc;@/
+undump(hash_base)(frozen_control_sequence)(write_loc);@/
+undump_math_codes;
+undump_text_codes;
+@<Undump the hash table@>
+
+@ The table of equivalents usually contains repeated information, so we dump it
+in compressed form: The sequence of $n+2$ values $(n,x_1,\ldots,x_n,m)$ in the
+format file represents $n+m$ consecutive entries of |eqtb|, with |m| extra
+copies of $x_n$, namely $(x_1,\ldots,x_n,x_n,\ldots,x_n)$.
+
+@<Dump regions 1 to 4 of |eqtb|@>=
+k:=active_base;
+repeat j:=k;
+while j<int_base-1 do
+  begin if (equiv(j)=equiv(j+1))and(eq_type(j)=eq_type(j+1))and@|
+    (eq_level(j)=eq_level(j+1)) then goto found1;
+  incr(j);
+  end;
+l:=int_base; goto done1; {|j=int_base-1|}
+found1: incr(j); l:=j;
+while j<int_base-1 do
+  begin if (equiv(j)<>equiv(j+1))or(eq_type(j)<>eq_type(j+1))or@|
+    (eq_level(j)<>eq_level(j+1)) then goto done1;
+  incr(j);
+  end;
+done1:
+dump_int(l-k);
+while k<l do
+  begin dump_wd(eqtb[k]); incr(k);
+  end;
+k:=j+1; dump_int(k-l);
+until k=int_base
+
+@ @<Dump regions 5 and 6 of |eqtb|@>=
+repeat j:=k;
+while j<eqtb_size do
+  begin if eqtb[j].int=eqtb[j+1].int then goto found2;
+  incr(j);
+  end;
+l:=eqtb_size+1; goto done2; {|j=eqtb_size|}
+found2: incr(j); l:=j;
+while j<eqtb_size do
+  begin if eqtb[j].int<>eqtb[j+1].int then goto done2;
+  incr(j);
+  end;
+done2:dump_int(l-k);
+while k<l do
+  begin dump_wd(eqtb[k]); incr(k);
+  end;
+k:=j+1; dump_int(k-l);
+until k>eqtb_size
+
+@ @<Undump regions 1 to 6 of |eqtb|@>=
+k:=active_base;
+repeat undump_int(x);
+if (x<1)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do undump_wd(eqtb[j]);
+k:=k+x;
+undump_int(x);
+if (x<0)or(k+x>eqtb_size+1) then goto bad_fmt;
+for j:=k to k+x-1 do eqtb[j]:=eqtb[k-1];
+k:=k+x;
+until k>eqtb_size
+
+@ A different scheme is used to compress the hash table, since its lower
+region is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output
+two words, |p| and |hash[p]|. The hash table is, of course, densely packed
+for |p>=hash_used|, so the remaining entries are output in a~block.
+
+@<Dump the hash table@>=
+for p:=0 to prim_size do dump_hh(prim[p]);
+for p:=0 to prim_size do dump_wd(prim_eqtb[p]);
+dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
+for p:=hash_base to hash_used do if text(p)<>0 then
+  begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
+  end;
+for p:=hash_used+1 to undefined_control_sequence-1 do dump_hh(hash[p]);
+dump_int(cs_count);@/
+print_ln; print_int(cs_count); print(" multiletter control sequences")
+
+@ @<Undump the hash table@>=
+for p:=0 to prim_size do undump_hh(prim[p]);
+for p:=0 to prim_size do undump_wd(prim_eqtb[p]);
+undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
+repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
+until p=hash_used;
+for p:=hash_used+1 to undefined_control_sequence-1 do undump_hh(hash[p]);
+undump_int(cs_count)
+
+@ @<Dump the font information@>=
+dump_int(max_font_id);
+for k:=0 to max_font_id do
+  @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(max_font_id); print(" preloaded font");
+if max_font_id<>1 then print_char("s")
+
+@ @<Undump the font information@>=
+undump_int(x);
+set_max_font_id(x);
+for k:=0 to max_font_id do
+  @<Undump the array info for internal font number |k|@>
+
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_font(k);
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(tex_font_name(k),tex_font_area(k),"");
+flush_string; flush_string;
+if font_size(k)<>font_dsize(k) then
+  begin print(" at "); print_scaled(font_size(k)); print("pt");
+  end;
+end
+
+@ @<Undump the array info for internal font number |k|@>=
+begin undump_font(k);@/
+end
+
+@ @<Dump the active ocp information@>=
+dump_int(active_min_ptr);
+dump_int(active_max_ptr);
+for k:=0 to active_max_ptr-1 do dump_wd(active_info[k]);
+if active_max_ptr>0 then begin
+  print_ln; print_int(active_max_ptr); print(" words of active ocps");
+  end;
+
+@ @<Undump the active ocp information@>=
+undump_size(0)(active_mem_size)('active start point')(active_min_ptr);
+undump_size(0)(active_mem_size)('active mem size')(active_max_ptr);
+for k:=0 to active_max_ptr-1 do undump_wd(active_info[k]);
+
+@ @<Dump the ocp information@>=
+dump_int(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+  @<Dump the array info for internal ocp number |k|@>;
+if ocp_ptr-ocp_base>0 then begin
+  print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp");
+  if ocp_ptr<>ocp_base+1 then print_char("s");
+  end
+
+@ @<Undump the ocp information@>=
+undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr);
+for k:=null_ocp to ocp_ptr do
+  @<Undump the array info for internal ocp number |k|@>
+
+@ @<Dump the array info for internal ocp number |k|@>=
+begin dump_ocp_table(k);
+if ocp_ptr-ocp_base>0 then begin
+  print_nl("\ocp"); print_esc(ocp_id_text(k)); print_char("=");
+  print_file_name(ocp_name(k),ocp_area(k),"");
+  end;
+end
+
+@ @<Undump the array info for internal ocp number |k|@>=
+begin undump_ocp_table(k);
+end
+
+@ @<Dump the ocp list information@>=
+dump_int(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do dump_wd(ocp_list_info[k]);
+dump_int(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do begin
+  dump_int(ocp_list_list[k]);
+  if null_ocp_list<>ocp_list_ptr then begin
+    print_nl("\ocplist"); 
+    print_esc(ocp_list_id_text(k)); 
+    print_char("=");
+    print_ocp_list(ocp_list_list[k]);
+    end;
+  end;
+dump_int(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do dump_wd(ocp_lstack_info[k])
+
+@ @<Undump the ocp list information@>=
+undump_size(1)(1000000)('ocp list mem size')(ocp_listmem_ptr);
+for k:=0 to ocp_listmem_ptr-1 do undump_wd(ocp_list_info[k]);
+undump_size(ocp_list_base)(ocp_list_biggest)('ocp list max')(ocp_list_ptr);
+for k:=null_ocp_list to ocp_list_ptr do
+  undump_int(ocp_list_list[k]);
+undump_size(1)(1000000)('ocp lstack mem size')(ocp_lstackmem_ptr);
+for k:=0 to ocp_lstackmem_ptr-1 do undump_wd(ocp_lstack_info[k])
+
+@ This is done in C
+
+@<Dump the hyphenation tables@>=
+dump_language_data
+
+@ @<Undump the hyphenation tables@>=
+undump_language_data
+
+@ This is also done in C
+
+@<Dump the lua bytecodes@>=
+dump_luac_registers;
+
+@ @<Undump the lua bytecodes@>=
+undump_luac_registers;
+
+@ We have already printed a lot of statistics, so we set |tracing_stats:=0|
+to prevent them from appearing again.
+
+@<Dump a couple more things and the closing check word@>=
+dump_int(interaction); dump_int(format_ident); dump_int(format_name); dump_int(69069);
+tracing_stats:=0
+
+@ @<Undump a couple more things and the closing check word@>=
+undump(batch_mode)(error_stop_mode)(interaction);
+undump(0)(str_ptr)(format_ident);
+undump(0)(str_ptr)(format_name);
+undump_int(x);
+if (x<>69069)or eof(fmt_file) then goto bad_fmt
+
+@ @<Create the |format_ident|...@>=
+selector:=new_string;
+print(" (preloaded format="); print(job_name); print_char(" ");
+print_int(year); print_char(".");
+print_int(month); print_char("."); print_int(day); print_char(")");
+str_room(2);
+format_ident:=make_string;
+print(job_name);
+format_name:=make_string;
+if interaction=batch_mode then selector:=log_only
+else selector:=term_and_log;
+pack_job_name(format_extension);
+while not w_open_out(fmt_file) do
+  prompt_file_name("format file name",format_extension);
+print_nl("Beginning to dump on file ");
+@.Beginning to dump...@>
+slow_print(w_make_name_string(fmt_file)); flush_string;
+print_nl(""); slow_print(format_ident)
+
+@ @<Close the format file@>=
+w_close(fmt_file)
+
+@* \[51] The main program.
+This is it: the part of \TeX\ that executes all those procedures we have
+written.
+
+Well---almost. Let's leave space for a few more routines that we may
+have forgotten.
+
+@p @<Last-minute procedures@>
+
+@ We have noted that there are two versions of \TeX82. One, called \.{INITEX},
+@.INITEX@>
+has to be run first; it initializes everything from scratch, without
+reading a format file, and it has the capability of dumping a format file.
+The other one is called `\.{VIRTEX}'; it is a ``virgin'' program that needs
+@.VIRTEX@>
+to input a format file in order to get started. \.{VIRTEX} typically has
+more memory capacity than \.{INITEX}, because it does not need the space
+consumed by the auxiliary hyphenation tables and the numerous calls on
+|primitive|, etc.
+
+The \.{VIRTEX} program cannot read a format file instantaneously, of course;
+the best implementations therefore allow for production versions of \TeX\ that
+not only avoid the loading routine for \PASCAL\ object code, they also have
+a format file pre-loaded. This is impossible to do if we stick to standard
+\PASCAL; but there is a simple way to fool many systems into avoiding the
+initialization, as follows:\quad(1)~We declare a global integer variable
+called |ready_already|. The probability is negligible that this
+variable holds any particular value like 314159 when \.{VIRTEX} is first
+loaded.\quad(2)~After we have read in a format file and initialized
+everything, we set |ready_already:=314159|.\quad(3)~Soon \.{VIRTEX}
+will print `\.*', waiting for more input; and at this point we
+interrupt the program and save its core image in some form that the
+operating system can reload speedily.\quad(4)~When that core image is
+activated, the program starts again at the beginning; but now
+|ready_already=314159| and all the other global variables have
+their initial values too. The former chastity has vanished!
+
+In other words, if we allow ourselves to test the condition
+|ready_already=314159|, before |ready_already| has been
+assigned a value, we can avoid the lengthy initialization. Dirty tricks
+rarely pay off so handsomely.
+@^dirty \PASCAL@>
+@^system dependencies@>
+
+On systems that allow such preloading, the standard program called \.{TeX}
+should be the one that has \.{plain} format preloaded, since that agrees
+with {\sl The \TeX book}. Other versions, e.g., \.{AmSTeX}, should also
+@:TeXbook}{\sl The \TeX book@>
+@.AmSTeX@>
+@.plain@>
+be provided for commonly used formats.
+
+@<Glob...@>=
+@!ready_already:integer; {a sacrifice of purity for economy}
+
+@ Now this is really it: \TeX\ starts and ends here.
+
+The initial test involving |ready_already| should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+@^system dependencies@>
+
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+if ready_already=314159 then goto start_of_TEX;
+@<Check the ``constant'' values...@>@;
+if bad>0 then
+  begin wterm_ln('Ouch---my internal constants have been clobbered!',
+    '---case ',bad:1);
+@.Ouch...clobbered@>
+  goto final_end;
+  end;
+initialize; {set global variables to their starting values}
+@!init if not get_strings_started then goto final_end;
+init_prim; {call |primitive| for each primitive}
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr; fix_date_and_time;
+tini@/
+ready_already:=314159;
+start_of_TEX: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+history:=spotless; {ready to go!}
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+end.
+
+@ Put this in a function because two extra variables are needed
+for callback testing, and putting those inside the main body is
+ugly
+
+@<Basic print...@>=
+procedure print_banner;
+var res:boolean;
+   callback_id:integer;
+begin
+callback_id:=callback_defined(start_run_callback);
+if callback_id=0 then begin
+  wterm(banner);
+  if format_ident=0 then wterm_ln(' (no format preloaded)')
+  else  begin slow_print(format_ident); print_ln;
+    end;
+  end
+else
+  res:= run_callback(callback_id,'->');
+update_terminal;
+end;
+@#
+procedure print_version_banner;
+begin
+wterm(banner);
+end;
+
+
+@ Here we do whatever is needed to complete \TeX's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+Actually there's one way to get error messages, via |prepare_mag|;
+but that can't cause infinite recursion.
+@^recursion@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+label done, done1;
+var a, b, c, i, j, k, l: integer; {all-purpose index}
+    is_root: boolean; {|pdf_last_pages| is root of Pages tree?}
+    is_names: boolean; {flag for name tree output: is it Names or Kids?}
+    root, outlines, threads, names_tree, dests: integer;
+    xref_offset_width, names_head, names_tail: integer;
+	callback_id:integer;
+	res:boolean;
+begin 
+callback_id:=callback_defined(stop_run_callback);
+@<Finish the extensions@>;
+@!stat if tracing_stats>0 then
+  if callback_id=0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal;
+if not fixed_pdfoutput_set then
+    fix_pdfoutput;
+if fixed_pdfoutput > 0 then begin
+    if history = fatal_error_stop then begin
+        remove_pdffile;
+        print_err(" ==> Fatal error occurred, no output PDF file produced!")
+        end
+    else begin
+        @<Finish the PDF file@>;
+	    if callback_id=0 then begin
+        if log_opened then
+            begin wlog_cr;
+            wlog_ln('PDF statistics:');
+            wlog_ln(' ',obj_ptr:1,' PDF objects out of ',obj_tab_size:1,
+                ' (max. ',sup_obj_tab_size:1,')');
+            if pdf_os_cntr > 0 then begin
+                wlog(' ',((pdf_os_cntr - 1) * pdf_os_max_objs + pdf_os_objidx + 1):1,
+                    ' compressed objects within ',pdf_os_cntr:1,' object stream');
+                if pdf_os_cntr > 1 then
+                    wlog('s');
+                wlog_cr;
+            end;
+            wlog_ln(' ',pdf_dest_names_ptr:1,' named destinations out of ',dest_names_size:1,
+                ' (max. ',sup_dest_names_size:1,')');
+            wlog_ln(' ',pdf_mem_ptr:1,' words of extra memory for PDF output out of ',pdf_mem_size:1,
+                ' (max. ',sup_pdf_mem_size:1,')');
+        end;
+        end;
+    end;
+end
+else begin
+    @<Finish the \.{DVI} file@>;
+end;
+if log_opened then
+  begin wlog_cr; selector:=selector-2;
+  if (selector=term_only)and(callback_id=0) then begin
+     print_nl("Transcript written on ");
+@.Transcript written...@>
+     slow_print(log_name); print_char(".");
+    end;
+  lua_a_close_out(log_file);
+  end;
+end;
+
+@ The present section goes directly to the log file instead of using
+|print| commands, because there's no need for these strings to take
+up |str_pool| memory when a non-{\bf stat} version of \TeX\ is being used.
+
+@<Output statistics...@>=
+if log_opened then
+  begin wlog_ln(' ');
+  wlog_ln('Here is how much of TeX''s memory',' you used:');
+@.Here is how much...@>
+  wlog(' ',str_ptr-init_str_ptr:1,' string');
+  if str_ptr<>init_str_ptr+1 then wlog('s');
+  wlog_ln(' out of ', max_strings-init_str_ptr+string_offset:1);@/
+  wlog_ln(' ',pool_ptr-init_pool_ptr:1,' string characters out of ',
+    pool_size-init_pool_ptr:1);@/
+  wlog_ln(' ',var_mem_max:1,',',fix_mem_max:1,@|
+    ' words of node,token memory allocated');@/
+  print_node_mem_stats(tracing_stats, tracing_online);
+  wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+    hash_size:1);@/
+  wlog(' ',max_font_id,' font');
+  if max_font_id<>1 then wlog('s');
+  wlog_ln(' using ', font_bytes:1, ' bytes');
+  wlog_ln(' ',max_in_stack:1,'i,',max_nest_stack:1,'n,',@|
+    max_param_stack:1,'p,',@|
+    max_buf_stack+1:1,'b,',@|
+    max_save_stack+6:1,'s stack positions out of ',@|
+    stack_size:1,'i,',
+    nest_size:1,'n,',
+    param_size:1,'p,',
+    buf_size:1,'b,',
+    save_size:1,'s');
+  end
+
+@ We get to the |final_cleanup| routine when \.{\\end} or \.{\\dump} has
+been scanned and |its_all_over|\kern-2pt.
+
+@<Last-minute...@>=
+procedure final_cleanup;
+label exit;
+var c:small_number; {0 for \.{\\end}, 1 for \.{\\dump}}
+i:halfword; { for looping marks }
+begin c:=cur_chr;
+if job_name=0 then open_log_file;
+while input_ptr>0 do
+  if state=token_list then end_token_list@+else end_file_reading;
+while open_parens>0 do
+  begin 
+	if tracefilenames then print(" )"); 
+	decr(open_parens);
+  end;
+if cur_level>level_one then
+  begin print_nl("("); print_esc("end occurred ");
+  print("inside a group at level ");
+@:end_}{\.{(\\end occurred...)}@>
+  print_int(cur_level-level_one); print_char(")");
+  show_save_groups;
+  end;
+while cond_ptr<>null do
+  begin print_nl("("); print_esc("end occurred ");
+  print("when "); print_cmd_chr(if_test,cur_if);
+  if if_line<>0 then
+    begin print(" on line "); print_int(if_line);
+    end;
+  print(" was incomplete)");
+  if_line:=if_line_field(cond_ptr);
+  cur_if:=subtype(cond_ptr); temp_ptr:=cond_ptr;
+  cond_ptr:=vlink(cond_ptr); flush_node(temp_ptr);
+  end;
+if not callback_defined(stop_run_callback) then 
+  if history<>spotless then
+    if ((history=warning_issued)or(interaction<error_stop_mode)) then
+      if selector=term_and_log then
+        begin selector:=term_only;
+        print_nl("(see the transcript file for additional information)");
+@.see the transcript file...@>
+        selector:=term_and_log;
+        end;
+if c=1 then
+  begin @!init for i:=0 to biggest_used_mark do begin
+    delete_top_mark(i); delete_first_mark(i); delete_bot_mark(i);
+    delete_split_first_mark(i); delete_split_bot_mark(i);
+    end;
+  for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+  @<Close the pseudo files@>;
+  store_fmt_file; return;@+tini@/
+  print_nl("(\dump is performed only by INITEX)"); return;
+@:dump_}{\.{\\dump...only by INITEX}@>
+  end;
+exit:end;
+
+@ @<Last-minute...@>=
+@!init procedure init_prim; {initialize all the primitives}
+begin no_new_control_sequence:=false;
+first:=0;
+@<Put each...@>;
+no_new_control_sequence:=true;
+end;
+tini
+
+@ When we begin the following code, \TeX's tables may still contain garbage;
+the strings might not even be present. Thus we must proceed cautiously to get
+bootstrapped in.
+
+But when we finish this part of the program, \TeX\ is ready to call on the
+|main_control| routine to do its work.
+
+@<Get the first line...@>=
+begin @<Initialize the input routines@>;
+@<Enable \eTeX, if requested@>@;@/
+if (format_ident=0)or(buffer[loc]="&") then
+  begin if format_ident<>0 then initialize; {erase preloaded format}
+  if not open_fmt_file then goto final_end;
+  if not load_fmt_file then
+    begin w_close(fmt_file); goto final_end;
+    end;
+  w_close(fmt_file);
+  while (loc<limit)and(buffer[loc]=" ") do incr(loc);
+  end;
+if (pdf_output_option <> 0) then pdf_output := pdf_output_value;
+if (pdf_draftmode_option <> 0) then pdf_draftmode := pdf_draftmode_value;
+pdf_init_map_file('pdftex.map');
+if false then wterm_ln('entering extended mode');
+if end_line_char_inactive then decr(limit)
+else  buffer[limit]:=end_line_char;
+fix_date_and_time;@/
+random_seed :=(microseconds*1000)+(epochseconds mod 1000000);@/
+init_randoms(random_seed);@/
+@<Compute the magic offset@>;
+@<Initialize the print |selector|...@>;
+if (loc<limit)and(get_cat_code(cat_code_table,buffer[loc])<>escape) then start_input;
+  {\.{\\input} assumed}
+@<DIR: Initialize |text_dir_ptr|@>;
+end
+
+@* \[52] Debugging.
+Once \TeX\ is working, you should be able to diagnose most errors with
+the \.{\\show} commands and other diagnostic features. But for the initial
+stages of debugging, and for the revelation of really deep mysteries, you
+can compile \TeX\ with a few more aids, including the \PASCAL\ runtime
+checks and its debugger. An additional routine called |debug_help|
+will also come into play when you type `\.D' after an error message;
+|debug_help| also occurs just before a fatal error causes \TeX\ to succumb.
+@^debugging@>
+@^system dependencies@>
+
+The interface to |debug_help| is primitive, but it is good enough when used
+with a \PASCAL\ debugger that allows you to set breakpoints and to read
+variables and change their values. After getting the prompt `\.{debug \#}', you
+type either a negative number (this exits |debug_help|), or zero (this
+goes to a location where you can set a breakpoint, thereby entering into
+dialog with the \PASCAL\ debugger), or a positive number |m| followed by
+an argument |n|. The meaning of |m| and |n| will be clear from the
+program below. (If |m=13|, there is an additional argument, |l|.)
+@.debug \#@>
+
+@d breakpoint=888 {place where a breakpoint is desirable}
+
+@<Last-minute...@>=
+@!debug procedure debug_help; {routine to display various things}
+label breakpoint,exit;
+var k,@!l,@!m,@!n:integer;
+begin loop begin wake_up_terminal;
+  print_nl("debug # (-1 to exit):"); update_terminal;
+@.debug \#@>
+  read(term_in,m);
+  if m<0 then return
+  else if m=0 then
+    begin goto breakpoint;@\ {go to every label at least once}
+    breakpoint: m:=0; @{'BREAKPOINT'@}@\
+    end
+  else  begin read(term_in,n);
+    case m of
+    @t\4@>@<Numbered cases for |debug_help|@>@;
+    othercases print("?")
+    endcases;
+    end;
+  end;
+exit:end;
+gubed
+
+@ @<Numbered cases...@>=
+1: print_word(mem(n)); {display |mem[n]| in all forms}
+2: print_int(info(n));
+3: print_int(link(n));
+4: print_word(eqtb[n]);
+5: ;
+6: print_word(save_stack[n]);
+7: show_box(n);
+  {show a box, abbreviated by |show_box_depth| and |show_box_breadth|}
+8: begin breadth_max:=10000; depth_threshold:=pool_size-pool_ptr-10;
+  show_node_list(n); {show a box in its entirety}
+  end;
+9: show_token_list(n,null,1000);
+10: slow_print(n);
+13: begin read(term_in,l); print_cmd_chr(n,l);
+  end;
+14: for k:=0 to n do print(buffer[k]);
+15: begin font_in_short_display:=null_font; short_display(n);
+  end;
+
+@* \[53] Extensions.
+The program above includes a bunch of ``hooks'' that allow further
+capabilities to be added without upsetting \TeX's basic structure.
+Most of these hooks are concerned with ``whatsit'' nodes, which are
+intended to be used for special purposes; whenever a new extension to
+\TeX\ involves a new kind of whatsit node, a corresponding change needs
+to be made to the routines below that deal with such nodes,
+but it will usually be unnecessary to make many changes to the
+other parts of this program.
+
+In order to demonstrate how extensions can be made, we shall treat
+`\.{\\write}', `\.{\\openout}', `\.{\\closeout}', `\.{\\immediate}',
+and `\.{\\special}' as if they were extensions.
+These commands are actually primitives of \TeX, and they should
+appear in all implementations of the system; but let's try to imagine
+that they aren't. Then the program below illustrates how a person
+could add them.
+
+Sometimes, of course, an extension will require changes to \TeX\ itself;
+no system of hooks could be complete enough for all conceivable extensions.
+The features associated with `\.{\\write}' are almost all confined to the
+following paragraphs, but there are small parts of the |print_ln| and
+|print_char| procedures that were introduced specifically to \.{\\write}
+characters. Furthermore one of the token lists recognized by the scanner
+is a |write_text|; and there are a few other miscellaneous places where we
+have already provided for some aspect of \.{\\write}.  The goal of a \TeX\
+extender should be to minimize alterations to the standard parts of the
+program, and to avoid them completely if possible. He or she should also
+be quite sure that there's no easy way to accomplish the desired goals
+with the standard features that \TeX\ already has. ``Think thrice before
+extending,'' because that may save a lot of work, and it will also keep
+incompatible extensions of \TeX\ from proliferating.
+@^system dependencies@>
+@^extensions to \TeX@>
+
+@ First let's consider the format of whatsit nodes that are used to represent
+the data associated with \.{\\write} and its relatives. Recall that a whatsit
+has |type=whatsit_node|, and the |subtype| is supposed to distinguish
+different kinds of whatsits. Each node occupies two or more words; the
+exact number is immaterial, as long as it is readily determined from the
+|subtype| or other data.
+
+We shall introduce five |subtype| values here, corresponding to the
+control sequences \.{\\openout}, \.{\\write}, \.{\\closeout}, and \.{\\special}. 
+The second word of I/O whatsits has a |write_stream| field
+that identifies the write-stream number (0 to 15, or 16 for out-of-range and
+positive, or 17 for out-of-range and negative).
+In the case of \.{\\write} and \.{\\special}, there is also a field that
+points to the reference count of a token list that should be sent. In the
+case of \.{\\openout}, we need three words and three auxiliary subfields
+to hold the string numbers for name, area, and extension.
+
+@d open_node=0 {|subtype| in whatsits that represent files to \.{\\openout}}
+@d open_node_size==4 {number of words in an open/whatsit node}
+@d write_node=1 {|subtype| in whatsits that represent things to \.{\\write}}
+@d write_node_size==3 {number of words in a write/whatsit node}
+@d close_node=2 {|subtype| in whatsits that represent streams to \.{\\closeout}}
+@d close_node_size==3 {number of words in a write/whatsit node}
+@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things}
+@d special_node_size==3 {number of words in a write/whatsit node}
+@d dir_node_size=4 {number of words in change direction node}
+@d dir_dir(#)==vinfo(#+2) {keep the direction to be taken}
+@d dir_level(#)==vlink(#+2) {the save level at which the direction was defined}
+@d dir_dvi_ptr(#)==vinfo(#+3) {for reflecting dvi output}
+@d dir_dvi_h(#)==vlink(#+3) {for reflecting dvi output}
+@d what_lang(#)==vlink(#+2) {language number, in the range |0..255|}
+@d what_lhm(#)==type(#+2) {minimum left fragment, in the range |1..63|}
+@d what_rhm(#)==subtype(#+2) {minimum right fragment, in the range |1..63|}
+@d write_tokens(#) == vlink(#+2) {reference count of token list to write}
+@d write_stream(#) == vinfo(#+2) {stream number (0 to 17)}
+@d open_name(#) == vlink(#+2) {string number of file name to open}
+@d open_area(#) == vinfo(#+3) {string number of file area for |open_name|}
+@d open_ext(#) == vlink(#+3) {string number of file extension for |open_name|}
+
+@ The sixteen possible \.{\\write} streams are represented by the |write_file|
+array. The |j|th file is open if and only if |write_open[j]=true|. The last
+two streams are special; |write_open[16]| represents a stream number
+greater than 15, while |write_open[17]| represents a negative stream number,
+and both of these variables are always |false|.
+
+@<Glob...@>=
+@!write_file:array[0..15] of alpha_file;
+@!write_file_mode:array[0..15] of halfword;
+@!write_file_translation:array[0..15] of halfword;
+@!write_open:array[0..17] of boolean;
+@!neg_wd:scaled;
+@!pos_wd:scaled;
+@!neg_ht:scaled;
+@!dvi_direction:integer;
+@!dir_primary:array[0..31] of 0..31;
+@!dir_secondary:array[0..31] of 0..31;
+@!dir_tertiary:array[0..31] of 0..31;
+@!dir_rearrange:array[0..3] of 0..31;
+@!dir_names:array[0..3] of str_number;
+@!text_dir_ptr:pointer;
+@!text_dir_tmp:pointer;
+
+@ 
+@<Set init...@>=
+for k:=0 to 17 do write_open[k]:=false;
+pack_direction:=-1;
+for k:= 0 to 7 do begin
+  dir_primary  [k   ]:=dir_T;
+  dir_primary  [k+ 8]:=dir_L;
+  dir_primary  [k+16]:=dir_B;
+  dir_primary  [k+24]:=dir_R;
+  end;
+for k:= 0 to 3 do begin
+  dir_secondary[k   ]:=dir_L;
+  dir_secondary[k+ 4]:=dir_R;
+  dir_secondary[k+ 8]:=dir_T;
+  dir_secondary[k+12]:=dir_B;
+
+  dir_secondary[k+16]:=dir_L;
+  dir_secondary[k+20]:=dir_R;
+  dir_secondary[k+24]:=dir_T;
+  dir_secondary[k+28]:=dir_B;
+  end;
+for k:=0 to 7 do begin
+  dir_tertiary[k*4  ]:=dir_T;
+  dir_tertiary[k*4+1]:=dir_L;
+  dir_tertiary[k*4+2]:=dir_B;
+  dir_tertiary[k*4+3]:=dir_R;
+  end;
+dir_rearrange[0]:=0;
+dir_rearrange[1]:=0;
+dir_rearrange[2]:=1;
+dir_rearrange[3]:=1;
+dir_names[0]:="T";
+dir_names[1]:="L";
+dir_names[2]:="B";
+dir_names[3]:="R";
+
+@ Extensions might introduce new command codes; but it's best to use
+|extension| with a modifier, whenever possible, so that |main_control|
+stays the same.
+
+@d immediate_code=4 {command modifier for \.{\\immediate}}
+@d local_par_node==6 {|subtype| in whatsits for local paragraph node}
+{|local_par_node| has to be a macro, not numeric }
+@d dir_node=7 {|subtype| in whatsits for change direction node}
+@d pdftex_first_extension_code = 8
+@d pdf_literal_node            == pdftex_first_extension_code + 0
+@d pdf_obj_code                == pdftex_first_extension_code + 1
+@d pdf_refobj_node             == pdftex_first_extension_code + 2
+@d pdf_xform_code              == pdftex_first_extension_code + 3
+@d pdf_refxform_node           == pdftex_first_extension_code + 4
+@d pdf_ximage_code             == pdftex_first_extension_code + 5
+@d pdf_refximage_node          == pdftex_first_extension_code + 6
+@d pdf_annot_node              == pdftex_first_extension_code + 7
+@d pdf_start_link_node         == pdftex_first_extension_code + 8
+@d pdf_end_link_node           == pdftex_first_extension_code + 9
+@d pdf_end_link_node_size==3
+@d pdf_outline_code            == pdftex_first_extension_code + 10
+@d pdf_dest_node               == pdftex_first_extension_code + 11
+@d pdf_thread_node             == pdftex_first_extension_code + 12
+@d pdf_start_thread_node       == pdftex_first_extension_code + 13
+@d pdf_end_thread_node         == pdftex_first_extension_code + 14
+@d pdf_end_thread_node_size==3
+@d pdf_save_pos_node           == pdftex_first_extension_code + 15
+@d pdf_save_pos_node_size==3
+@d pdf_info_code               == pdftex_first_extension_code + 16
+@d pdf_thread_data_node        == pdftex_first_extension_code + 16
+@d pdf_catalog_code            == pdftex_first_extension_code + 17
+@d pdf_link_data_node          == pdftex_first_extension_code + 17
+@d pdf_names_code              == pdftex_first_extension_code + 18
+@d pdf_font_attr_code          == pdftex_first_extension_code + 19
+@d pdf_include_chars_code      == pdftex_first_extension_code + 20
+@d pdf_map_file_code           == pdftex_first_extension_code + 21
+@d pdf_map_line_code           == pdftex_first_extension_code + 22
+@d pdf_trailer_code            == pdftex_first_extension_code + 23
+@d pdf_font_expand_code        == pdftex_first_extension_code + 24
+@d set_random_seed_code        == pdftex_first_extension_code + 25
+@d pdf_glyph_to_unicode_code   == pdftex_first_extension_code + 26
+@d late_lua_node               == pdftex_first_extension_code + 27
+@d close_lua_node              == pdftex_first_extension_code + 28
+@d save_cat_code_table_code    == pdftex_first_extension_code + 29
+@d init_cat_code_table_code    == pdftex_first_extension_code + 30
+@d pdf_colorstack_node         == pdftex_first_extension_code + 31
+@d pdf_setmatrix_node          == pdftex_first_extension_code + 32
+@d pdf_save_node               == pdftex_first_extension_code + 33
+@d pdf_restore_node            == pdftex_first_extension_code + 34
+@d pdftex_last_extension_code  == pdftex_first_extension_code + 34
+
+@<Put each...@>=
+primitive("openout",extension,open_node);@/
+@!@:open_out_}{\.{\\openout} primitive@>
+primitive("write",extension,write_node); write_loc:=cur_val;@/
+@!@:write_}{\.{\\write} primitive@>
+primitive("closeout",extension,close_node);@/
+@!@:close_out_}{\.{\\closeout} primitive@>
+primitive("special",extension,special_node);@/
+@!@:special_}{\.{\\special} primitive@>
+primitive("immediate",extension,immediate_code);@/
+@!@:immediate_}{\.{\\immediate} primitive@>
+primitive("localinterlinepenalty",assign_int,local_inter_line_penalty_code);@/
+primitive("localbrokenpenalty",assign_int,local_broken_penalty_code);@/
+primitive("pagedir",assign_dir,dir_base+page_direction_code);@/
+primitive("bodydir",assign_dir,dir_base+body_direction_code);@/
+primitive("pardir",assign_dir,dir_base+par_direction_code);@/
+primitive("textdir",assign_dir,dir_base+text_direction_code);@/
+primitive("mathdir",assign_dir,dir_base+math_direction_code);@/
+primitive("pagerightoffset",assign_dimen,dimen_base+page_right_offset_code);
+primitive("pagebottomoffset",assign_dimen,dimen_base+page_bottom_offset_code);
+primitive("pdfliteral",extension,pdf_literal_node);@/
+@!@:pdf_literal_}{\.{\\pdfliteral} primitive@>
+primitive("pdfcolorstack",extension,pdf_colorstack_node);@/
+@!@:pdf_colorstack_}{\.{\\pdfcolorstack} primitive@>
+primitive("pdfsetmatrix",extension,pdf_setmatrix_node);@/
+@!@:pdf_setmatrix_}{\.{\\pdfsetmatrix} primitive@>
+primitive("pdfsave",extension,pdf_save_node);@/
+@!@:pdf_save_}{\.{\\pdfsave} primitive@>
+primitive("pdfrestore",extension,pdf_restore_node);@/
+@!@:pdf_restore_}{\.{\\pdfrestore} primitive@>
+primitive("pdfobj",extension,pdf_obj_code);@/
+@!@:pdf_obj_}{\.{\\pdfobj} primitive@>
+primitive("pdfrefobj",extension,pdf_refobj_node);@/
+@!@:pdf_refobj_}{\.{\\pdfrefobj} primitive@>
+primitive("pdfxform",extension,pdf_xform_code);@/
+@!@:pdf_xform_}{\.{\\pdfxform} primitive@>
+primitive("pdfrefxform",extension,pdf_refxform_node);@/
+@!@:pdf_refxform_}{\.{\\pdfrefxform} primitive@>
+primitive("pdfximage",extension,pdf_ximage_code);@/
+@!@:pdf_ximage_}{\.{\\pdfximage} primitive@>
+primitive("pdfrefximage",extension,pdf_refximage_node);@/
+@!@:pdf_refximage_}{\.{\\pdfrefximage} primitive@>
+primitive("pdfannot",extension,pdf_annot_node);@/
+@!@:pdf_annot_}{\.{\\pdfannot} primitive@>
+primitive("pdfstartlink",extension,pdf_start_link_node);@/
+@!@:pdf_start_link_}{\.{\\pdfstartlink} primitive@>
+primitive("pdfendlink",extension,pdf_end_link_node);@/
+@!@:pdf_end_link_}{\.{\\pdfendlink} primitive@>
+primitive("pdfoutline",extension,pdf_outline_code);@/
+@!@:pdf_outline_}{\.{\\pdfoutline} primitive@>
+primitive("pdfdest",extension,pdf_dest_node);@/
+@!@:pdf_dest_}{\.{\\pdfdest} primitive@>
+primitive("pdfthread",extension,pdf_thread_node);@/
+@!@:pdf_thread_}{\.{\\pdfthread} primitive@>
+primitive("pdfstartthread",extension,pdf_start_thread_node);@/
+@!@:pdf_start_thread_}{\.{\\pdfstartthread} primitive@>
+primitive("pdfendthread",extension,pdf_end_thread_node);@/
+@!@:pdf_end_thread_}{\.{\\pdfendthread} primitive@>
+primitive("pdfsavepos",extension,pdf_save_pos_node);@/
+@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
+primitive("pdfinfo",extension,pdf_info_code);@/
+@!@:pdf_info_}{\.{\\pdfinfo} primitive@>
+primitive("pdfcatalog",extension,pdf_catalog_code);@/
+@!@:pdf_catalog_}{\.{\\pdfcatalog} primitive@>
+primitive("pdfnames",extension,pdf_names_code);@/
+@!@:pdf_names_}{\.{\\pdfnames} primitive@>
+primitive("pdfincludechars",extension,pdf_include_chars_code);@/
+@!@:pdf_include_chars_}{\.{\\pdfincludechars} primitive@>
+primitive("pdffontattr",extension,pdf_font_attr_code);@/
+@!@:pdf_font_attr_}{\.{\\pdffontattr} primitive@>
+primitive("pdfmapfile",extension,pdf_map_file_code);@/
+@!@:pdf_map_file_}{\.{\\pdfmapfile} primitive@>
+primitive("pdfmapline",extension,pdf_map_line_code);@/
+@!@:pdf_map_line_}{\.{\\pdfmapline} primitive@>
+primitive("pdftrailer",extension,pdf_trailer_code);@/
+@!@:pdf_trailer_}{\.{\\pdftrailer} primitive@>
+primitive("savecatcodetable",extension,save_cat_code_table_code);@/
+@!@:save_cat_code_table_}{\.{\\savecatcodetable} primitive@>
+primitive("initcatcodetable",extension,init_cat_code_table_code);@/
+@!@:init_cat_code_table_}{\.{\\initcatcodetable} primitive@>
+primitive("pdfsetrandomseed",extension,set_random_seed_code);@/
+@!@:set_random_seed_code}{\.{\\pdfsetrandomseed} primitive@>
+primitive("latelua",extension,late_lua_node);@/
+@!@:late_lua_node_}{\.{\\latelua} primitive@>
+primitive("closelua",extension,close_lua_node);@/
+@!@:close_lua_node_}{\.{\\closelua} primitive@>
+primitive("pdffontexpand",extension,pdf_font_expand_code);@/
+@!@:pdf_font_expand_}{\.{\\pdffontexpand} primitive@>
+primitive("pdfglyphtounicode",extension,pdf_glyph_to_unicode_code);@/
+@!@:pdf_glyph_to_unicode_}{\.{\\pdfglyphtounicode} primitive@>
+
+@ The variable |write_loc| just introduced is used to provide an
+appropriate error message in case of ``runaway'' write texts.
+
+@<Glob...@>=
+@!write_loc:pointer; {|eqtb| address of \.{\\write}}
+
+@ @<Cases of |print_cmd_chr|...@>=
+extension: case chr_code of
+  open_node:print_esc("openout");
+  write_node:print_esc("write");
+  close_node:print_esc("closeout");
+  special_node:print_esc("special");
+  immediate_code:print_esc("immediate");
+  pdf_annot_node: print_esc("pdfannot");
+  pdf_catalog_code: print_esc("pdfcatalog");
+  pdf_dest_node: print_esc("pdfdest");
+  pdf_end_link_node: print_esc("pdfendlink");
+  pdf_end_thread_node: print_esc("pdfendthread");
+  pdf_font_attr_code: print_esc("pdffontattr");
+  pdf_font_expand_code: print_esc("pdffontexpand");
+  pdf_include_chars_code: print_esc("pdfincludechars");
+  pdf_info_code: print_esc("pdfinfo");
+  pdf_literal_node: print_esc("pdfliteral");
+  pdf_colorstack_node: print_esc("pdfcolorstack");
+  pdf_setmatrix_node: print_esc("pdfsetmatrix");
+  pdf_save_node: print_esc("pdfsave");
+  pdf_restore_node: print_esc("pdfrestore");
+  pdf_map_file_code: print_esc("pdfmapfile");
+  pdf_map_line_code: print_esc("pdfmapline");
+  pdf_names_code: print_esc("pdfnames");
+  pdf_obj_code: print_esc("pdfobj");
+  pdf_outline_code: print_esc("pdfoutline");
+  pdf_refobj_node: print_esc("pdfrefobj");
+  pdf_refxform_node: print_esc("pdfrefxform");
+  pdf_refximage_node: print_esc("pdfrefximage");
+  pdf_save_pos_node: print_esc("pdfsavepos");
+  pdf_start_link_node: print_esc("pdfstartlink");
+  pdf_start_thread_node: print_esc("pdfstartthread");
+  pdf_thread_node: print_esc("pdfthread");
+  pdf_trailer_code: print_esc("pdftrailer");
+  pdf_xform_code: print_esc("pdfxform");
+  pdf_ximage_code: print_esc("pdfximage");
+  save_cat_code_table_code: print_esc("savecatcodetable");
+  init_cat_code_table_code: print_esc("initcatcodetable");
+  set_random_seed_code: print_esc("pdfsetrandomseed");
+  pdf_glyph_to_unicode_code: print_esc("pdfglyphtounicode");
+  late_lua_node: print_esc("latelua");
+  close_lua_node: print_esc("closelua");
+  cancel_boundary_node: print_esc("noboundary");
+  othercases print("[unknown extension!]")
+  endcases;
+
+@ When an |extension| command occurs in |main_control|, in any mode,
+the |do_extension| routine is called.
+
+@<Cases of |main_control| that are for extensions...@>=
+any_mode(extension):do_extension;
+
+@ @<Declare act...@>=
+@t\4@>@<Declare procedures needed in |do_extension|@>@;
+procedure do_extension;
+var i,@!j,@!k:integer; {all-purpose integers}
+@!p,@!q,@!r:pointer; {all-purpose pointers}
+begin case cur_chr of
+  open_node:@<Implement \.{\\openout}@>;
+  write_node:@<Implement \.{\\write}@>;
+  close_node:@<Implement \.{\\closeout}@>;
+  special_node:@<Implement \.{\\special}@>;
+  immediate_code:@<Implement \.{\\immediate}@>;
+  pdf_annot_node: @<Implement \.{\\pdfannot}@>;
+  pdf_catalog_code: @<Implement \.{\\pdfcatalog}@>;
+  pdf_dest_node: @<Implement \.{\\pdfdest}@>;
+  pdf_end_link_node: @<Implement \.{\\pdfendlink}@>;
+  pdf_end_thread_node: @<Implement \.{\\pdfendthread}@>;
+  pdf_font_attr_code: @<Implement \.{\\pdffontattr}@>;
+  pdf_font_expand_code: @<Implement \.{\\pdffontexpand}@>;
+  pdf_include_chars_code: @<Implement \.{\\pdfincludechars}@>;
+  pdf_info_code: @<Implement \.{\\pdfinfo}@>;
+  pdf_literal_node: @<Implement \.{\\pdfliteral}@>;
+  pdf_colorstack_node: @<Implement \.{\\pdfcolorstack}@>;
+  pdf_setmatrix_node: @<Implement \.{\\pdfsetmatrix}@>;
+  pdf_save_node: @<Implement \.{\\pdfsave}@>;
+  pdf_restore_node: @<Implement \.{\\pdfrestore}@>;
+  pdf_map_file_code: @<Implement \.{\\pdfmapfile}@>;
+  pdf_map_line_code: @<Implement \.{\\pdfmapline}@>;
+  pdf_names_code: @<Implement \.{\\pdfnames}@>;
+  pdf_obj_code: @<Implement \.{\\pdfobj}@>;
+  pdf_outline_code: @<Implement \.{\\pdfoutline}@>;
+  pdf_refobj_node: @<Implement \.{\\pdfrefobj}@>;
+  pdf_refxform_node: @<Implement \.{\\pdfrefxform}@>;
+  pdf_refximage_node: @<Implement \.{\\pdfrefximage}@>;
+  pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
+  pdf_start_link_node: @<Implement \.{\\pdfstartlink}@>;
+  pdf_start_thread_node: @<Implement \.{\\pdfstartthread}@>;
+  pdf_thread_node: @<Implement \.{\\pdfthread}@>;
+  pdf_trailer_code: @<Implement \.{\\pdftrailer}@>;
+  pdf_xform_code: @<Implement \.{\\pdfxform}@>;
+  pdf_ximage_code: @<Implement \.{\\pdfximage}@>;
+  save_cat_code_table_code: @<Implement \.{\\savecatcodetable}@>;
+  init_cat_code_table_code: @<Implement \.{\\initcatcodetable}@>;
+  set_random_seed_code: @<Implement \.{\\pdfsetrandomseed}@>;
+  pdf_glyph_to_unicode_code: @<Implement \.{\\pdfglyphtounicode}@>;
+  late_lua_node: @<Implement \.{\\latelua}@>;
+  close_lua_node: @<Implement \.{\\closelua}@>;
+othercases confusion("ext1")
+@:this can't happen ext1}{\quad ext1@>
+endcases;
+end;
+
+@ Here is a subroutine that creates a whatsit node having a given |subtype|
+and a given number of words. It initializes only the first word of the whatsit,
+and appends it to the current list.
+
+@<Declare procedures needed in |do_extension|@>=
+procedure new_whatsit(@!s:small_number);
+var p:pointer; {the new node}
+begin p:=new_node(whatsit_node,s);
+vlink(tail):=p; tail:=p;
+end;
+
+@ The next subroutine uses |cur_chr| to decide what sort of whatsit is
+involved, and also inserts a |write_stream| number.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure new_write_whatsit(@!w:small_number);
+begin new_whatsit(cur_chr);
+if w<>write_node_size then scan_four_bit_int
+else  begin scan_int;
+  if cur_val<0 then cur_val:=17
+  else if cur_val>15 then cur_val:=16;
+  end;
+write_stream(tail):=cur_val;
+end;
+
+@ @<Implement \.{\\openout}@>=
+begin new_write_whatsit(open_node_size);
+scan_optional_equals; scan_file_name;@/
+open_name(tail):=cur_name; open_area(tail):=cur_area; open_ext(tail):=cur_ext;
+end
+
+@ When `\.{\\write 12\{...\}}' appears, we scan the token list `\.{\{...\}}'
+without expanding its macros; the macros will be expanded later when this
+token list is rescanned.
+
+@<Implement \.{\\write}@>=
+begin k:=cur_cs; new_write_whatsit(write_node_size);@/
+cur_cs:=k; p:=scan_toks(false,false); write_tokens(tail):=def_ref;
+end
+
+@ @<Implement \.{\\closeout}@>=
+begin new_write_whatsit(write_node_size); write_tokens(tail):=null;
+end
+
+@ When `\.{\\special\{...\}}' appears, we expand the macros in the token
+list as in \.{\\xdef} and \.{\\mark}.
+
+@<Implement \.{\\special}@>=
+begin new_whatsit(special_node); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ @<Implement \.{\\pdffontexpand}@>=
+    read_expand_font
+
+@ The following macros are needed for further manipulation with whatsit nodes
+for \pdfTeX{} extensions (copying, destroying etc.)
+
+@d add_action_ref(#) == incr(pdf_action_refcount(#)) {increase count of
+references to this action}
+
+@d delete_action_ref(#) == {decrease count of references to this
+action; free it if there is no reference to this action}
+begin
+    if pdf_action_refcount(#) = null then begin
+        if pdf_action_type(#) = pdf_action_user then
+            delete_token_ref(pdf_action_tokens(#))
+        else begin
+            if pdf_action_file(#) <> null then
+                delete_token_ref(pdf_action_file(#));
+            if pdf_action_type(#) = pdf_action_page then
+                delete_token_ref(pdf_action_tokens(#))
+            else if pdf_action_named_id(#) > 0 then
+                delete_token_ref(pdf_action_id(#));
+        end;
+        flush_node(#);
+    end
+    else
+        decr(pdf_action_refcount(#));
+end
+
+@ We have to check whether \.{\\pdfoutput} is set for using \pdfTeX{}
+  extensions.
+@<Declare procedures needed in |do_ext...@>=
+procedure check_pdfoutput(s: str_number; is_error : boolean);
+begin
+    if pdf_output <= 0 then
+        begin
+        if is_error then
+            pdf_error(s, "not allowed in DVI mode (\pdfoutput <= 0)")
+        else
+            pdf_warning(s, "not allowed in DVI mode (\pdfoutput <= 0); ignoring it", true,true);
+        end
+end;
+
+procedure scan_pdf_ext_toks;
+begin
+    call_func(scan_toks(false, true)); {like \.{\\special}}
+end;
+
+@ @<Implement \.{\\pdfliteral}@>=
+begin
+    check_pdfoutput("\pdfliteral", true);
+    new_whatsit(pdf_literal_node);
+    if scan_keyword("direct") then
+        pdf_literal_mode(tail) := direct_always
+    else if scan_keyword("page") then
+        pdf_literal_mode(tail) := direct_page
+    else
+        pdf_literal_mode(tail) := set_origin;
+    scan_pdf_ext_toks;
+    pdf_literal_data(tail) := def_ref;
+end
+
+@ @<Implement \.{\\pdfcolorstack}@>=
+begin
+    check_pdfoutput("\pdfcolorstack", true);
+    {Scan and check the stack number and store in |cur_val|}
+    scan_int;
+    if cur_val >= colorstackused then begin
+        print_err("Unknown color stack number ");
+        print_int(cur_val);
+@.Unknown color stack@>
+        help3("Allocate and initialize a color stack with \\pdfcolorstackinit.")@/
+        ("I'll use default color stack 0 here.")@/
+        ("Proceed, with fingers crossed.");
+        error;
+        cur_val := 0;
+    end;
+    if cur_val < 0 then begin
+        print_err("Invalid negative color stack number");
+@.Invalid negative color stack number@>
+        help2("I'll use default color stack 0 here.")@/
+        ("Proceed, with fingers corssed.");
+        error;
+        cur_val := 0;
+    end;
+    if scan_keyword("set") then begin
+        i := colorstack_set;
+    end
+    else if scan_keyword("push") then begin
+        i := colorstack_push;
+    end
+    else if scan_keyword("pop") then begin
+        i := colorstack_pop;
+    end
+    else if scan_keyword("current") then begin
+        i := colorstack_current;
+    end
+    else begin
+        i := -1; {error}
+    end;
+    if i >= 0 then begin
+        new_whatsit(pdf_colorstack_node);
+        pdf_colorstack_stack(tail) := cur_val;
+        pdf_colorstack_cmd(tail)   := i;
+	    pdf_colorstack_data(tail)  := null;
+        if i <= colorstack_data then begin
+            scan_pdf_ext_toks;
+            pdf_colorstack_data(tail) := def_ref;
+        end;
+    end
+    else begin
+        print_err("Color stack action is missing");
+@.Color stack action is missing@>
+        help3("The expected actions for \pdfcolorstack:")@/
+        ("    set, push, pop, current")@/
+        ("I'll ignore the color stack command.");
+        error;
+    end
+end
+
+@ @<Implement \.{\\pdfsetmatrix}@>=
+begin
+    check_pdfoutput("\pdfsetmatrix", true);
+    new_whatsit(pdf_setmatrix_node);
+    scan_pdf_ext_toks;
+    pdf_setmatrix_data(tail) := def_ref;
+end
+
+@ @<Implement \.{\\pdfsave}@>=
+begin
+    check_pdfoutput("\pdfsave", true);
+    new_whatsit(pdf_save_node);
+end
+
+@ @<Implement \.{\\pdfrestore}@>=
+begin
+    check_pdfoutput("\pdfrestore", true);
+    new_whatsit(pdf_restore_node);
+end
+
+
+@ @<Implement \.{\\latelua}@>=
+begin
+    check_pdfoutput("\latelua", true);
+    new_whatsit(late_lua_node);
+    scan_register_num;
+    late_lua_reg(tail) := cur_val;
+    scan_pdf_ext_toks;
+    late_lua_data(tail) := def_ref;
+end
+
+@ @<Implement \.{\\closelua}@>=
+begin
+    check_pdfoutput("\closelua", true);
+    new_whatsit(close_lua_node);
+	scan_register_num;
+	late_lua_reg(tail) := cur_val;
+end
+
+@ The \.{\\pdfobj} primitive is used to create a ``raw'' object in the PDF
+  output file. The object contents will be hold in memory and will be written
+  out only when the object is referenced by \.{\\pdfrefobj}. When \.{\\pdfobj}
+  is used with \.{\\immediate}, the object contents will be written out
+  immediately. Objects referenced in the current page are appended into
+  |pdf_obj_list|.
+
+@<Glob...@>=
+@!pdf_last_obj: integer;
+
+@ @<Implement \.{\\pdfobj}@>=
+begin
+    check_pdfoutput("\pdfobj", true);
+    if scan_keyword("reserveobjnum") then begin
+        @<Scan an optional space@>;
+        incr(pdf_obj_count);
+        pdf_create_obj(obj_type_obj, pdf_obj_count);
+        pdf_last_obj := obj_ptr;
+    end
+    else begin
+        k := -1;
+        if scan_keyword("useobjnum") then begin
+            scan_int;
+            k := cur_val;
+            if (k <= 0) or (k > obj_ptr) or (obj_data_ptr(k) <> 0) then begin
+                pdf_warning("\pdfobj", "invalid object number being ignored", true, true);
+                pdf_retval := -1; {signal the problem}
+                k := -1; {will be generated again}
+            end;
+        end;
+        if k < 0 then begin
+            incr(pdf_obj_count);
+            pdf_create_obj(obj_type_obj, pdf_obj_count);
+            k := obj_ptr;
+        end;
+        obj_data_ptr(k) := pdf_get_mem(pdfmem_obj_size);
+        if scan_keyword("stream") then begin
+            obj_obj_is_stream(k) := 1;
+            if scan_keyword("attr") then begin
+                scan_pdf_ext_toks;
+                obj_obj_stream_attr(k) := def_ref;
+            end
+            else
+                obj_obj_stream_attr(k) := null;
+        end
+        else
+            obj_obj_is_stream(k) := 0;
+        if scan_keyword("file") then
+            obj_obj_is_file(k) := 1
+        else
+            obj_obj_is_file(k) := 0;
+        scan_pdf_ext_toks;
+        obj_obj_data(k) := def_ref;
+        pdf_last_obj := k;
+    end;
+end
+
+@ We need to check whether the referenced object exists.
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+function prev_rightmost(s, e: pointer): pointer;
+{finds the node preceding the rightmost node |e|; |s| is some node
+before |e|}
+var p: pointer;
+begin
+    prev_rightmost := null;
+    p := s;
+    if p = null then
+        return;
+    while vlink(p) <> e do begin
+        p := vlink(p);
+        if p = null then
+            return;
+    end;
+    prev_rightmost := p;
+end;
+
+procedure pdf_check_obj(t, n: integer);
+var k: integer;
+begin
+    k := head_tab[t];
+    while (k <> 0) and (k <> n) do
+        k := obj_link(k);
+    if k = 0 then
+        pdf_error("ext1", "cannot find referenced object");
+end;
+
+@ @<Implement \.{\\pdfrefobj}@>=
+begin
+    check_pdfoutput("\pdfrefobj", true);
+    scan_int;
+    pdf_check_obj(obj_type_obj, cur_val);
+    new_whatsit(pdf_refobj_node);
+    pdf_obj_objnum(tail) := cur_val;
+end
+
+@ \.{\\pdfxform} and \.{\\pdfrefxform} are similiar to \.{\\pdfobj} and
+  \.{\\pdfrefobj}
+
+@<Glob...@>=
+@!pdf_last_xform: integer;
+
+@ @<Implement \.{\\pdfxform}@>=
+begin
+    check_pdfoutput("\pdfxform", true);
+    incr(pdf_xform_count);
+    pdf_create_obj(obj_type_xform, pdf_xform_count);
+    k := obj_ptr;
+    obj_data_ptr(k) := pdf_get_mem(pdfmem_xform_size);
+    if scan_keyword("attr") then begin
+        scan_pdf_ext_toks;
+        obj_xform_attr(k) := def_ref;
+    end
+    else
+        obj_xform_attr(k) := null;
+    if scan_keyword("resources") then begin
+        scan_pdf_ext_toks;
+        obj_xform_resources(k) := def_ref;
+    end
+    else
+        obj_xform_resources(k) := null;
+    scan_int;
+	p:=box(cur_val);
+    if p = null then
+        pdf_error("ext1", "\pdfxform cannot be used with a void box");
+    obj_xform_width(k) := width(p);
+    obj_xform_height(k) := height(p);
+    obj_xform_depth(k) := depth(p);
+    obj_xform_box(k) := p; {save pointer to the box}
+	box(cur_val):=null;
+    pdf_last_xform := k;
+end
+
+@ @<Implement \.{\\pdfrefxform}@>=
+begin
+    check_pdfoutput("\pdfrefxform", true);
+    scan_int;
+    pdf_check_obj(obj_type_xform, cur_val);
+    new_whatsit(pdf_refxform_node);
+    pdf_xform_objnum(tail) := cur_val;
+    pdf_width(tail) := obj_xform_width(cur_val);
+    pdf_height(tail) := obj_xform_height(cur_val);
+    pdf_depth(tail) := obj_xform_depth(cur_val);
+end
+
+@ \.{\\pdfximage} and \.{\\pdfrefximage} are similiar to \.{\\pdfxform} and
+  \.{\\pdfrefxform}. As we have to scan |<rule spec>| quite often, it is better
+  have a |rule_node| that holds the most recently scanned |<rule spec>|.
+
+@<Glob...@>=
+@!pdf_last_ximage: integer;
+@!pdf_last_ximage_pages: integer;
+@!pdf_last_ximage_colordepth: integer;
+@!alt_rule: pointer;
+@!warn_pdfpagebox: boolean;
+
+@ @<Set init...@>=
+alt_rule := null;
+warn_pdfpagebox := true;
+
+@ @<Declare procedures needed in |do_ext...@>=
+
+function scan_pdf_box_spec: integer; {scans PDF pagebox specification}
+begin
+    scan_pdf_box_spec := 0;
+    if scan_keyword("mediabox") then
+        scan_pdf_box_spec := pdf_box_spec_media
+    else if scan_keyword("cropbox") then
+        scan_pdf_box_spec := pdf_box_spec_crop
+    else if scan_keyword("bleedbox") then
+        scan_pdf_box_spec := pdf_box_spec_bleed
+    else if scan_keyword("trimbox") then
+        scan_pdf_box_spec := pdf_box_spec_trim
+    else if scan_keyword("artbox") then
+        scan_pdf_box_spec := pdf_box_spec_art
+end;
+
+procedure scan_alt_rule; {scans rule spec to |alt_rule|}
+label reswitch;
+begin
+    if alt_rule = null then
+        alt_rule := new_rule;
+    width(alt_rule) := null_flag;
+    height(alt_rule) := null_flag;
+    depth(alt_rule) := null_flag;
+reswitch:
+    if scan_keyword("width") then begin
+        scan_normal_dimen;
+        width(alt_rule) := cur_val;
+        goto reswitch;
+    end;
+    if scan_keyword("height") then begin
+        scan_normal_dimen;
+        height(alt_rule) := cur_val;
+        goto reswitch;
+    end;
+    if scan_keyword("depth") then begin
+        scan_normal_dimen;
+        depth(alt_rule) := cur_val;
+        goto reswitch;
+    end;
+end;
+
+procedure scan_image;
+label reswitch;
+var i, k, img_wd, img_ht, img_dp, ref: integer;
+    named, attr: str_number;
+    s: str_number;
+    page, pagebox, colorspace: integer;
+begin
+    incr(pdf_ximage_count);
+    pdf_create_obj(obj_type_ximage, pdf_ximage_count);
+    k := obj_ptr;
+    scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+    img_wd := width(alt_rule);
+    img_ht := height(alt_rule);
+    img_dp := depth(alt_rule);
+    attr := 0;
+    named := 0;
+    page := 1;
+    colorspace := 0;
+    if scan_keyword("attr") then begin
+        scan_pdf_ext_toks;
+        attr := tokens_to_string(def_ref);
+        delete_token_ref(def_ref);
+    end;
+    if scan_keyword("named") then begin
+        scan_pdf_ext_toks;
+        named := tokens_to_string(def_ref);
+        delete_token_ref(def_ref);
+        page := 0;
+    end
+    else if scan_keyword("page") then begin
+        scan_int;
+        page := cur_val;
+    end;
+    if scan_keyword("colorspace") then begin
+        scan_int;
+        colorspace := cur_val;
+    end;
+    pagebox := scan_pdf_box_spec;
+    if pagebox = 0 then
+        pagebox := pdf_pagebox;
+    scan_pdf_ext_toks;
+    s := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    if pdf_option_always_use_pdfpagebox <> 0 then begin
+        pdf_warning("PDF inclusion", "Primitive \pdfoptionalwaysusepdfpagebox is obsolete; use \pdfpagebox instead.", true, true);
+        pdf_force_pagebox := pdf_option_always_use_pdfpagebox;
+        pdf_option_always_use_pdfpagebox := 0; {warn once}
+        warn_pdfpagebox := false;
+    end;
+    if pdf_option_pdf_inclusion_errorlevel <> 0 then begin
+        pdf_warning("PDF inclusion", "Primitive \pdfoptionpdfinclusionerrorlevel is obsolete; use \pdfinclusionerrorlevel instead.", true, true);
+        pdf_inclusion_errorlevel := pdf_option_pdf_inclusion_errorlevel;
+        pdf_option_pdf_inclusion_errorlevel := 0; {warn once}
+    end;
+    if pdf_force_pagebox > 0 then begin
+        if warn_pdfpagebox then begin
+            pdf_warning("PDF inclusion", "Primitive \pdfforcepagebox is obsolete; use \pdfpagebox instead.", true, true);
+            warn_pdfpagebox := false;
+        end;
+        pagebox := pdf_force_pagebox;
+    end;
+    if pagebox = 0 then {no pagebox specification given}
+        pagebox := pdf_box_spec_crop;
+    ref := read_image(k, pdf_ximage_count, s, page, named, attr, colorspace, pagebox,
+                      pdf_minor_version, pdf_inclusion_errorlevel);
+    flush_str(s);
+    obj_data_ptr(k) := ref;
+    if named <> 0 then flush_str(named);
+    set_image_dimensions(ref, img_wd, img_ht, img_dp);
+    if attr <> 0 then flush_str(attr);
+    scale_image(ref);
+    pdf_last_ximage := k;
+    pdf_last_ximage_pages := image_pages(ref);
+    pdf_last_ximage_colordepth := image_colordepth(ref);
+end;
+
+@ @<Implement \.{\\pdfximage}@>=
+begin
+    check_pdfoutput("\pdfximage", true);
+    check_pdfminorversion;
+    scan_image;
+end
+
+@ @<Implement \.{\\pdfrefximage}@>=
+begin
+    check_pdfoutput("\pdfrefximage", true);
+    scan_int;
+    pdf_check_obj(obj_type_ximage, cur_val);
+    new_whatsit(pdf_refximage_node);
+    j := obj_data_ptr(cur_val);
+    pdf_ximage_ref(tail) := j;
+    pdf_width(tail) := image_width(j);
+    pdf_height(tail) := image_height(j);
+    pdf_depth(tail) := image_depth(j);
+end
+
+@ The following function finds object with identifier |i| and type |t|.
+  |i < 0| indicates that |-i| should be treated as a string number. If no
+  such object exists then it will be created. This function is used mainly to
+  find destination for link annotations and outlines; however it is also used
+  in |pdf_ship_out| (to check whether a Page object already exists) so we need
+  to declare it together with subroutines needed in |pdf_hlist_out| and
+  |pdf_vlist_out|.
+
+@<Declare procedures that need to be declared forward for \pdfTeX@>=
+function find_obj(t, i: integer; byname: boolean): integer;
+begin
+    find_obj := avl_find_obj(t, i, byname);
+end;
+
+procedure flush_str(s: str_number); {flush a string if possible}
+begin
+    if flushable(s) then
+        flush_string;
+end;
+
+function get_obj(t, i: integer; byname: boolean): integer;
+var r: integer;
+    s: str_number;
+begin
+    if byname > 0 then begin
+        s := tokens_to_string(i);
+        r := find_obj(t, s, true);
+    end
+    else begin
+        s := 0;
+        r := find_obj(t, i, false);
+    end;
+    if r = 0 then begin
+        if byname > 0 then begin
+            pdf_create_obj(t, -s);
+            s := 0;
+        end
+        else
+            pdf_create_obj(t, i);
+        r := obj_ptr;
+        if t = obj_type_dest then
+            obj_dest_ptr(r) := null;
+    end;
+    if s <> 0 then
+        flush_str(s);
+    get_obj := r;
+end;
+
+function get_microinterval:integer;
+var s,@!m:integer; {seconds and microseconds}
+begin
+   seconds_and_micros(s,m);
+   if (s-epochseconds)>32767 then
+     get_microinterval := max_integer
+   else if (microseconds>m)  then
+     get_microinterval := ((s-1-epochseconds)*65536)+ (((m+1000000-microseconds)/100)*65536)/10000
+   else
+     get_microinterval := ((s-epochseconds)*65536)  + (((m-microseconds)/100)*65536)/10000;
+end;
+
+
+@ @<Declare procedures needed in |do_ext...@>=
+function scan_action: pointer; {read an action specification}
+var p: integer;
+begin
+    p := new_node(action_node,0);
+    scan_action := p;
+    if scan_keyword("user") then
+        pdf_action_type(p) := pdf_action_user
+    else if scan_keyword("goto") then
+        pdf_action_type(p) := pdf_action_goto
+    else if scan_keyword("thread") then
+        pdf_action_type(p) := pdf_action_thread
+    else
+        pdf_error("ext1", "action type missing");
+    if pdf_action_type(p) = pdf_action_user then begin
+        scan_pdf_ext_toks;
+        pdf_action_tokens(p) := def_ref;
+        return;
+    end;
+    if scan_keyword("file") then begin
+        scan_pdf_ext_toks;
+        pdf_action_file(p) := def_ref;
+    end;
+    if scan_keyword("page") then begin
+        if pdf_action_type(p) <> pdf_action_goto then
+            pdf_error("ext1", "only GoTo action can be used with `page'");
+        pdf_action_type(p) := pdf_action_page;
+        scan_int;
+        if cur_val <= 0 then
+            pdf_error("ext1", "page number must be positive");
+        pdf_action_id(p) := cur_val;
+        pdf_action_named_id(p) := 0;
+        scan_pdf_ext_toks;
+        pdf_action_tokens(p) := def_ref;
+    end
+    else if scan_keyword("name") then begin
+        scan_pdf_ext_toks;
+        pdf_action_named_id(p) := 1;
+        pdf_action_id(p) := def_ref;
+    end
+    else if scan_keyword("num") then begin
+        if (pdf_action_type(p) = pdf_action_goto) and
+            (pdf_action_file(p) <> null) then
+            pdf_error("ext1",
+                "`goto' option cannot be used with both `file' and `num'");
+        scan_int;
+        if cur_val <= 0 then
+            pdf_error("ext1", "num identifier must be positive");
+        pdf_action_named_id(p) := 0;
+        pdf_action_id(p) := cur_val;
+    end
+    else
+        pdf_error("ext1", "identifier type missing");
+    if scan_keyword("newwindow") then begin
+        pdf_action_new_window(p) := 1;
+        @<Scan an optional space@>; end
+    else if scan_keyword("nonewwindow") then begin
+        pdf_action_new_window(p) := 2;
+        @<Scan an optional space@>; end
+    else
+        pdf_action_new_window(p) := 0;
+    if (pdf_action_new_window(p) > 0) and
+        (((pdf_action_type(p) <> pdf_action_goto) and
+          (pdf_action_type(p) <> pdf_action_page)) or
+         (pdf_action_file(p) = null)) then
+            pdf_error("ext1",
+                "`newwindow'/`nonewwindow' must be used with `goto' and `file' option");
+end;
+
+procedure new_annot_whatsit(w: small_number); {create a new whatsit node for
+annotation}
+begin
+    new_whatsit(w);
+    scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+    pdf_width(tail) := width(alt_rule);
+    pdf_height(tail) := height(alt_rule);
+    pdf_depth(tail) := depth(alt_rule);
+    if (w = pdf_thread_node) or (w = pdf_start_thread_node) then begin
+        if scan_keyword("attr") then begin
+            scan_pdf_ext_toks;
+            pdf_thread_attr(tail) := def_ref;
+        end
+        else
+            pdf_thread_attr(tail) := null;
+    end;
+end;
+
+@ @<Glob...@>=
+@!pdf_last_annot: integer;
+
+@ @<Implement \.{\\pdfannot}@>=
+begin
+    check_pdfoutput("\pdfannot", true);
+    if scan_keyword("reserveobjnum") then begin
+        pdf_last_annot := pdf_new_objnum;
+        @<Scan an optional space@>; end
+    else begin
+        if scan_keyword("useobjnum") then begin
+            scan_int;
+            k := cur_val;
+            if (k <= 0) or (k > obj_ptr) or (obj_annot_ptr(k) <> 0) then
+                pdf_error("ext1", "invalid object number");
+        end
+        else
+            k := pdf_new_objnum;
+        new_annot_whatsit(pdf_annot_node);
+        pdf_annot_objnum(tail) := k;
+        scan_pdf_ext_toks;
+        pdf_annot_data(tail) := def_ref;
+        pdf_last_annot := k;
+    end
+end
+
+@ pdflastlink needs an extra global variable
+@<Glob...@>=
+@!pdf_last_link: integer;
+
+@ @<Implement \.{\\pdfstartlink}@>=
+begin
+    check_pdfoutput("\pdfstartlink", true);
+    if abs(mode) = vmode then
+        pdf_error("ext1", "\pdfstartlink cannot be used in vertical mode");
+    k := pdf_new_objnum;
+    new_annot_whatsit(pdf_start_link_node);
+	    pdf_link_attr(tail) := null;
+        if scan_keyword("attr") then begin
+            scan_pdf_ext_toks;
+            pdf_link_attr(tail) := def_ref;
+        end;
+    r := scan_action; pdf_link_action(tail) := r;
+    pdf_link_objnum(tail) := k;
+    pdf_last_link := k;
+    {N.B.: although it is possible to set |obj_annot_ptr(k) := tail| here, it
+     is not safe if nodes are later copied/destroyed/moved; a better place
+     to do this is inside |do_link|, when the whatsit node is written out}
+end
+
+@ @<Implement \.{\\pdfendlink}@>=
+begin
+    check_pdfoutput("\pdfendlink", true);
+    if abs(mode) = vmode then
+        pdf_error("ext1", "\pdfendlink cannot be used in vertical mode");
+    new_whatsit(pdf_end_link_node);
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+function outline_list_count(p: pointer): integer; {return number of outline
+entries in the same level with |p|}
+var k: integer;
+begin
+    k := 1;
+    while obj_outline_prev(p) <> 0 do begin
+        incr(k);
+        p := obj_outline_prev(p);
+    end;
+    outline_list_count := k;
+end;
+
+@ @<Implement \.{\\pdfoutline}@>=
+begin
+    check_pdfoutput("\pdfoutline", true);
+    if scan_keyword("attr") then begin
+        scan_pdf_ext_toks;
+        r := def_ref;
+    end
+    else
+        r := 0;
+    p := scan_action;
+    if scan_keyword("count") then begin
+        scan_int;
+        i := cur_val;
+    end
+    else
+        i := 0;
+    scan_pdf_ext_toks;
+    q := def_ref;
+    pdf_new_obj(obj_type_others, 0, 1);
+    j := obj_ptr;
+    write_action(p);
+    pdf_end_obj;
+    delete_action_ref(p);
+    pdf_create_obj(obj_type_outline, 0);
+    k := obj_ptr;
+    obj_outline_ptr(k) := pdf_get_mem(pdfmem_outline_size);
+    obj_outline_action_objnum(k) := j;
+    obj_outline_count(k) := i;
+    pdf_new_obj(obj_type_others, 0, 1);
+    pdf_print_str_ln(tokens_to_string(q));
+    flush_str(last_tokens_string);
+    delete_token_ref(q);
+    pdf_end_obj;
+    obj_outline_title(k) := obj_ptr;
+    obj_outline_prev(k) := 0;
+    obj_outline_next(k) := 0;
+    obj_outline_first(k) := 0;
+    obj_outline_last(k) := 0;
+    obj_outline_parent(k) := pdf_parent_outline;
+    obj_outline_attr(k) := r;
+    if pdf_first_outline = 0 then
+        pdf_first_outline :=  k;
+    if pdf_last_outline = 0 then begin
+        if pdf_parent_outline <> 0 then
+            obj_outline_first(pdf_parent_outline) := k;
+    end
+    else begin
+        obj_outline_next(pdf_last_outline) := k;
+        obj_outline_prev(k) := pdf_last_outline;
+    end;
+    pdf_last_outline := k;
+    if obj_outline_count(k) <> 0 then begin
+        pdf_parent_outline := k;
+        pdf_last_outline := 0;
+    end
+    else if (pdf_parent_outline <> 0) and
+    (outline_list_count(k) = abs(obj_outline_count(pdf_parent_outline))) then
+    begin
+        j := pdf_last_outline;
+        repeat
+            obj_outline_last(pdf_parent_outline) := j;
+            j := pdf_parent_outline;
+            pdf_parent_outline := obj_outline_parent(pdf_parent_outline);
+        until (pdf_parent_outline = 0) or
+        (outline_list_count(j) < abs(obj_outline_count(pdf_parent_outline)));
+        if pdf_parent_outline = 0 then
+            pdf_last_outline := pdf_first_outline
+        else
+            pdf_last_outline := obj_outline_first(pdf_parent_outline);
+        while obj_outline_next(pdf_last_outline) <> 0 do
+            pdf_last_outline := obj_outline_next(pdf_last_outline);
+    end;
+end
+
+@ When a destination is created we need to check whether another destination
+with the same identifier already exists and give a warning if needed.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure warn_dest_dup(id: integer; byname: small_number; s1, s2: str_number);
+begin
+    pdf_warning(s1, "destination with the same identifier (", false, false);
+    if byname > 0 then begin
+        print("name");
+        print_mark(id);
+    end
+    else begin
+        print("num");
+        print_int(id);
+    end;
+    print(") ");
+    print(s2);
+    print_ln;
+    show_context;
+end;
+
+@ Notice that |scan_keyword| doesn't care if two words have same prefix; so
+we should be careful when scan keywords with same prefix. The main rule: if
+there are two or more keywords with the same prefix, then always test in
+order from the longest one to the shortest one.
+
+@<Implement \.{\\pdfdest}@>=
+begin
+    check_pdfoutput("\pdfdest", true);
+    q := tail;
+    new_whatsit(pdf_dest_node);
+    if scan_keyword("num") then begin
+        scan_int;
+        if cur_val <= 0 then
+            pdf_error("ext1", "num identifier must be positive");
+        if cur_val > max_halfword then
+            pdf_error("ext1", "number too big");
+        pdf_dest_id(tail) := cur_val;
+        pdf_dest_named_id(tail) := 0;
+    end
+    else if scan_keyword("name") then begin
+        scan_pdf_ext_toks;
+        pdf_dest_id(tail) := def_ref;
+        pdf_dest_named_id(tail) := 1;
+    end
+    else
+        pdf_error("ext1", "identifier type missing");
+    if scan_keyword("xyz") then begin
+        pdf_dest_type(tail) := pdf_dest_xyz;
+        if scan_keyword("zoom") then begin
+            scan_int;
+            if cur_val > max_halfword then
+                pdf_error("ext1", "number too big");
+            pdf_dest_xyz_zoom(tail) := cur_val;
+        end
+        else
+            pdf_dest_xyz_zoom(tail) := null;
+    end
+    else if scan_keyword("fitbh") then
+        pdf_dest_type(tail) := pdf_dest_fitbh
+    else if scan_keyword("fitbv") then
+        pdf_dest_type(tail) := pdf_dest_fitbv
+    else if scan_keyword("fitb") then
+        pdf_dest_type(tail) := pdf_dest_fitb
+    else if scan_keyword("fith") then
+        pdf_dest_type(tail) := pdf_dest_fith
+    else if scan_keyword("fitv") then
+        pdf_dest_type(tail) := pdf_dest_fitv
+    else if scan_keyword("fitr") then
+        pdf_dest_type(tail) := pdf_dest_fitr
+    else if scan_keyword("fit") then
+        pdf_dest_type(tail) := pdf_dest_fit
+    else
+        pdf_error("ext1", "destination type missing");
+    @<Scan an optional space@>;
+    if pdf_dest_type(tail) = pdf_dest_fitr then begin
+        scan_alt_rule; {scans |<rule spec>| to |alt_rule|}
+        pdf_width(tail) := width(alt_rule);
+        pdf_height(tail) := height(alt_rule);
+        pdf_depth(tail) := depth(alt_rule);
+    end;
+    if pdf_dest_named_id(tail) <> 0 then begin
+        i := tokens_to_string(pdf_dest_id(tail));
+        k := find_obj(obj_type_dest, i, true);
+        flush_str(i);
+    end
+    else
+        k := find_obj(obj_type_dest, pdf_dest_id(tail), false);
+    if (k <> 0) and (obj_dest_ptr(k) <> null) then begin
+        warn_dest_dup(pdf_dest_id(tail), pdf_dest_named_id(tail),
+                      "ext4", "has been already used, duplicate ignored");
+        flush_node_list(tail);
+        tail := q;
+        vlink(q) := null;
+    end;
+end
+
+@ @<Declare procedures needed in |do_ext...@>=
+procedure scan_thread_id;
+begin
+    if scan_keyword("num") then begin
+        scan_int;
+        if cur_val <= 0 then
+            pdf_error("ext1", "num identifier must be positive");
+        if cur_val > max_halfword then
+            pdf_error("ext1", "number too big");
+        pdf_thread_id(tail) := cur_val;
+        pdf_thread_named_id(tail) := 0;
+    end
+    else if scan_keyword("name") then begin
+        scan_pdf_ext_toks;
+        pdf_thread_id(tail) := def_ref;
+        pdf_thread_named_id(tail) := 1;
+    end
+    else
+        pdf_error("ext1", "identifier type missing");
+end;
+
+@ @<Implement \.{\\pdfthread}@>=
+begin
+    check_pdfoutput("\pdfthread", true);
+    new_annot_whatsit(pdf_thread_node);
+    scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfstartthread}@>=
+begin
+    check_pdfoutput("\pdfstartthread", true);
+    new_annot_whatsit(pdf_start_thread_node);
+    scan_thread_id;
+end
+
+@ @<Implement \.{\\pdfendthread}@>=
+begin
+    check_pdfoutput("\pdfendthread", true);
+    new_whatsit(pdf_end_thread_node);
+end
+
+@ @<Glob...@>=
+@!pdf_last_x_pos: integer;
+@!pdf_last_y_pos: integer;
+
+@ @<Implement \.{\\pdfsavepos}@>=
+begin
+    new_whatsit(pdf_save_pos_node);
+end
+
+@ To implement primitives as \.{\\pdfinfo}, \.{\\pdfcatalog} or
+\.{\\pdfnames} we need to concatenate tokens lists.
+
+@<Declare procedures needed in |do_ext...@>=
+function concat_tokens(q, r: pointer): pointer; {concat |q| and |r| and
+returns the result tokens list}
+var p: pointer;
+begin
+    if q = null then begin
+        concat_tokens := r;
+        return;
+    end;
+    p := q;
+    while link(p) <> null do
+        p := link(p);
+    link(p) := link(r);
+    free_avail(r);
+    concat_tokens := q;
+end;
+
+@ @<Implement \.{\\pdfinfo}@>=
+begin
+    check_pdfoutput("\pdfinfo", false);
+    scan_pdf_ext_toks;
+    if pdf_output > 0 then
+        pdf_info_toks := concat_tokens(pdf_info_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdfcatalog}@>=
+begin
+    check_pdfoutput("\pdfcatalog", false);
+    scan_pdf_ext_toks;
+    if pdf_output > 0 then
+        pdf_catalog_toks := concat_tokens(pdf_catalog_toks, def_ref);
+    if scan_keyword("openaction") then begin
+        if pdf_catalog_openaction <> 0 then
+            pdf_error("ext1", "duplicate of openaction")
+        else begin
+            p := scan_action;
+            pdf_new_obj(obj_type_others, 0, 1);
+            if pdf_output > 0 then
+                pdf_catalog_openaction := obj_ptr;
+            write_action(p);
+            pdf_end_obj;
+            delete_action_ref(p);
+        end;
+    end
+end
+
+@ @<Implement \.{\\pdfnames}@>=
+begin
+    check_pdfoutput("\pdfnames", true);
+    scan_pdf_ext_toks;
+    pdf_names_toks := concat_tokens(pdf_names_toks, def_ref);
+end
+
+@ @<Implement \.{\\pdftrailer}@>=
+begin
+    check_pdfoutput("\pdftrailer", false);
+    scan_pdf_ext_toks;
+    if pdf_output > 0 then
+        pdf_trailer_toks := concat_tokens(pdf_trailer_toks, def_ref);
+end
+
+@ @<Glob...@>=
+@!pdf_retval: integer; {global multi-purpose return value}
+
+@ @<Set initial values of key variables@>=
+  seconds_and_micros(epochseconds,microseconds);
+  init_start_time;
+
+@ Negative random seed values are silently converted to positive ones
+
+@<Implement \.{\\pdfsetrandomseed}@>=
+begin
+  scan_int;
+  if cur_val<0 then negate(cur_val);
+  random_seed := cur_val;
+  init_randoms(random_seed);
+end
+
+@ @<Implement \.{\\savecatcodetable}@>=
+begin
+  scan_int;
+  if (cur_val<0)or(cur_val>@"FFFFFFF) then begin
+	print_err("Invalid \catcode table");
+	help1("All \catcode table ids must be between 0 and 0xFFFFFFF");
+	error;
+    end 
+  else begin if cur_val=cat_code_table then begin
+      print_err("Invalid \catcode table");
+  	  help1("You cannot overwrite the current \catcode table");
+      error;
+      end
+    else
+      copy_cat_codes(cat_code_table,cur_val);
+    end;
+end
+
+@ @<Implement \.{\\initcatcodetable}@>=
+begin
+  scan_int;
+  if (cur_val<0)or(cur_val>@"FFFFFFF) then begin
+	print_err("Invalid \catcode table");
+	help1("All \catcode table ids must be between 0 and 0xFFFFFFF");
+	error;
+    end 
+  else begin if cur_val=cat_code_table then begin
+    print_err("Invalid \catcode table");
+  	help1("You cannot overwrite the current \catcode table");
+	error;
+    end
+  else
+    initex_cat_codes(cur_val);
+    end;
+end
+
+@ The following subroutines are about PDF-specific font issues.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure pdf_include_chars;
+var s: str_number;
+    k: pool_pointer; {running indices}
+    f: internal_font_number;
+begin
+    scan_font_ident;
+    f := cur_val;
+    if f = null_font then
+        pdf_error("font", "invalid font identifier");
+    pdf_check_vf_cur_val;
+    if not font_used(f) then
+        pdf_init_font(f);
+    scan_pdf_ext_toks;
+    s := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    k := str_start_macro(s);
+    while k < str_start_macro(s + 1) do begin
+       pdf_mark_char(f, str_pool[k]);
+       incr(k);
+    end;
+    flush_str(s);
+end;
+
+procedure glyph_to_unicode;
+var s1, s2: str_number;
+begin
+    scan_pdf_ext_toks;
+    s1 := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    scan_pdf_ext_toks;
+    s2 := tokens_to_string(def_ref);
+    delete_token_ref(def_ref);
+    def_tounicode(s1, s2);
+    flush_str(s2);
+    flush_str(s1);
+end;
+
+@ @<Implement \.{\\pdfincludechars}@>=
+begin
+    check_pdfoutput("\pdfincludechars", true);
+    pdf_include_chars;
+end
+
+@ @<Implement \.{\\pdfglyphtounicode}@>=
+begin
+    glyph_to_unicode;
+end
+
+@ A change from \THANH's original code: the font attributes are simply
+initialized to zero now, this is easier to deal with from C than an
+empty \TeX{} string, and surely nobody will want to set
+\.{\\pdffontattr} to a string containing a single zero, as that
+would be nonsensical in the PDF output.
+
+@<Implement \.{\\pdffontattr}@>=
+begin
+    check_pdfoutput("\pdffontattr", true);
+    scan_font_ident;
+    k := cur_val;
+    if k = null_font then
+        pdf_error("font", "invalid font identifier");
+    scan_pdf_ext_toks;
+    set_pdf_font_attr(k, tokens_to_string(def_ref));
+    if length(pdf_font_attr(k)) = 0 then begin
+      flush_string;
+      set_pdf_font_attr(k,0);
+      end;
+end
+
+@ @<Implement \.{\\pdfmapfile}@>=
+begin
+    check_pdfoutput("\pdfmapfile", true);
+    scan_pdf_ext_toks;
+    pdfmapfile(def_ref);
+    delete_token_ref(def_ref);
+end
+
+@ @<Implement \.{\\pdfmapline}@>=
+begin
+    check_pdfoutput("\pdfmapline", true);
+    scan_pdf_ext_toks;
+    pdfmapline(def_ref);
+    delete_token_ref(def_ref);
+end
+
+@ The following function are needed for outputing article thread.
+
+@<Declare procedures needed in |do_ext...@>=
+procedure thread_title(thread: integer);
+begin
+    pdf_print("/Title (");
+    if obj_info(thread) < 0 then
+        pdf_print(-obj_info(thread))
+    else
+        pdf_print_int(obj_info(thread));
+    pdf_print_ln(")");
+end;
+
+procedure pdf_fix_thread(thread: integer);
+var a: pointer;
+begin
+    pdf_warning("thread", "destination ", false, false);
+    if obj_info(thread) < 0 then begin
+        print("name{");
+        print(-obj_info(thread));
+        print("}");
+    end
+    else begin
+        print("num");
+        print_int(obj_info(thread));
+    end;
+    print(" has been referenced but does not exist, replaced by a fixed one");
+    print_ln; print_ln;
+    pdf_new_dict(obj_type_others, 0, 0);
+    a := obj_ptr;
+    pdf_indirect_ln("T", thread);
+    pdf_indirect_ln("V", a);
+    pdf_indirect_ln("N", a);
+    pdf_indirect_ln("P", head_tab[obj_type_page]);
+    pdf_print("/R [0 0 ");
+    pdf_print_bp(page_width); pdf_out(" ");
+    pdf_print_bp(page_height);
+    pdf_print_ln("]");
+    pdf_end_dict;
+    pdf_begin_dict(thread, 1);
+    pdf_print_ln("/I << ");
+    thread_title(thread);
+    pdf_print_ln(">>");
+    pdf_indirect_ln("F", a);
+    pdf_end_dict;
+end;
+
+procedure out_thread(thread: integer);
+var a, b: pointer;
+    last_attr: integer;
+begin
+    if obj_thread_first(thread) = 0 then begin
+        pdf_fix_thread(thread);
+        return;
+    end;
+    pdf_begin_dict(thread, 1);
+    a := obj_thread_first(thread);
+    b := a;
+    last_attr := 0;
+    repeat
+        if obj_bead_attr(a) <> 0 then
+            last_attr := obj_bead_attr(a);
+        a := obj_bead_next(a);
+    until a = b;
+    if last_attr <> 0 then
+        pdf_print_ln(last_attr)
+    else begin
+        pdf_print_ln("/I << ");
+        thread_title(thread);
+        pdf_print_ln(">>");
+    end;
+    pdf_indirect_ln("F", a);
+    pdf_end_dict;
+    repeat
+        pdf_begin_dict(a, 1);
+        if a = b then
+            pdf_indirect_ln("T", thread);
+        pdf_indirect_ln("V", obj_bead_prev(a));
+        pdf_indirect_ln("N", obj_bead_next(a));
+        pdf_indirect_ln("P", obj_bead_page(a));
+        pdf_indirect_ln("R", obj_bead_rect(a));
+        pdf_end_dict;
+        a := obj_bead_next(a);
+    until a = b;
+end;
+
+@ @<Display <rule spec> for whatsit node created by \pdfTeX@>=
+print("(");
+print_rule_dimen(pdf_height(p));
+print_char("+");
+print_rule_dimen(pdf_depth(p));
+print(")x");
+print_rule_dimen(pdf_width(p))
+
+@ Each new type of node that appears in our data structure must be capable
+of being displayed, copied, destroyed, and so on. The routines that we
+need for write-oriented whatsits are somewhat like those for mark nodes;
+other extensions might, of course, involve more subtlety here.
+
+@<Basic printing...@>=
+procedure print_write_whatsit(@!s:str_number;@!p:pointer);
+begin print_esc(s);
+if write_stream(p)<16 then print_int(write_stream(p))
+else if write_stream(p)=16 then print_char("*")
+@.*\relax@>
+else print_char("-");
+end;
+
+@ Three extra node types carry information from |main_control|.
+
+@ |cancel_boundary_nodes| indicate that the next left boundary be
+ignored. These are created by the \.{\\noboundary} command in
+horizontal mode.
+
+@d cancel_boundary_node==pdf_restore_node+1
+@d cancel_boundary_size==3
+
+@<Append a |cancel_boundary_node| @>=
+begin new_whatsit(cancel_boundary_node);
+end
+
+@ User defined whatsits can be inserted into node lists to pass data
+along from one lua call to anotherb without interference from the
+typesetting engine itself. Each has an id, a type, and a value. The
+type of the value depends on the |user_node_type| field. 
+
+@d user_defined_node==cancel_boundary_node+1
+@d user_defined_node_size=4
+@d user_node_id(#)==vlink(#+2)
+@d user_node_type(#)==vinfo(#+2)
+@d user_node_value(#)==vinfo(#+3)
+
+@ @<Display the whatsit...@>=
+case subtype(p) of
+open_node:begin print_write_whatsit("openout",p);
+  print_char("="); print_file_name(open_name(p),open_area(p),open_ext(p));
+  end;
+write_node:begin print_write_whatsit("write",p);
+  print_mark(write_tokens(p));
+  end;
+close_node:print_write_whatsit("closeout",p);
+special_node:begin print_esc("special");
+  print_mark(write_tokens(p));
+  end;
+dir_node:
+  if dir_dir(p)<0 then begin
+    print_esc("enddir"); print(" "); print_dir(dir_dir(p)+64);
+    end
+  else begin
+    print_esc("begindir"); print(" "); print_dir(dir_dir(p));
+    end;
+@<LOCAL: print out |local_paragraph| node@>;
+pdf_literal_node: begin
+    print_esc("pdfliteral");
+    case pdf_literal_mode(p) of
+    set_origin:
+        do_nothing;
+    direct_page:
+        print(" page");
+    direct_always:
+        print(" direct");
+    othercases confusion("literal2")
+    endcases;
+    print_mark(pdf_literal_data(p));
+end;
+pdf_colorstack_node: begin
+    print_esc("pdfcolorstack ");
+    print_int(pdf_colorstack_stack(p));
+    case  pdf_colorstack_cmd(p) of
+    colorstack_set:
+        print(" set ");
+    colorstack_push:
+        print(" push ");
+    colorstack_pop:
+        print(" pop");
+    colorstack_current:
+        print(" current");
+    othercases confusion("pdfcolorstack")
+    endcases;
+    if pdf_colorstack_cmd(p) <= colorstack_data then
+        print_mark(pdf_colorstack_data(p));
+end;
+pdf_setmatrix_node: begin
+    print_esc("pdfsetmatrix");
+    print_mark(pdf_setmatrix_data(p));
+end;
+pdf_save_node: begin
+    print_esc("pdfsave");
+end;
+pdf_restore_node: begin
+    print_esc("pdfrestore");
+end;
+cancel_boundary_node: begin
+    print_esc("noboundary");
+end;
+late_lua_node: begin
+    print_esc("latelua");
+    print_int(late_lua_reg(p));
+    print_mark(late_lua_data(p));
+end;
+close_lua_node: begin
+    print_esc("closelua");
+	print_int(late_lua_reg(p));
+end;
+pdf_refobj_node: begin
+    print_esc("pdfrefobj");
+    if obj_obj_is_stream(pdf_obj_objnum(p)) > 0 then begin
+        if obj_obj_stream_attr(pdf_obj_objnum(p)) <> null then begin
+            print(" attr");
+            print_mark(obj_obj_stream_attr(pdf_obj_objnum(p)));
+        end;
+        print(" stream");
+    end;
+    if obj_obj_is_file(pdf_obj_objnum(p)) > 0 then
+        print(" file");
+    print_mark(obj_obj_data(pdf_obj_objnum(p)));
+end;
+pdf_refxform_node: begin
+    print_esc("pdfrefxform");
+    print("(");
+    print_scaled(obj_xform_height(pdf_xform_objnum(p)));
+    print_char("+");
+    print_scaled(obj_xform_depth(pdf_xform_objnum(p)));
+    print(")x");
+    print_scaled(obj_xform_width(pdf_xform_objnum(p)));
+end;
+pdf_refximage_node: begin
+    print_esc("pdfrefximage");
+    print("(");
+    print_scaled(pdf_height(p));
+    print_char("+");
+    print_scaled(pdf_depth(p));
+    print(")x");
+    print_scaled(pdf_width(p));
+end;
+pdf_annot_node: begin
+    print_esc("pdfannot");
+    @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+    print_mark(pdf_annot_data(p));
+end;
+pdf_start_link_node: begin
+    print_esc("pdflink");
+    @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+    if pdf_link_attr(p) <> null then begin
+        print(" attr");
+        print_mark(pdf_link_attr(p));
+    end;
+    print(" action");
+    if pdf_action_type(pdf_link_action(p)) = pdf_action_user then begin
+        print(" user");
+        print_mark(pdf_action_tokens(pdf_link_action(p)));
+        return;
+    end;
+    if pdf_action_file(pdf_link_action(p)) <> null then begin
+        print(" file");
+        print_mark(pdf_action_file(pdf_link_action(p)));
+    end;
+    case pdf_action_type(pdf_link_action(p)) of
+    pdf_action_goto: begin
+        if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+            print(" goto name");
+            print_mark(pdf_action_id(pdf_link_action(p)));
+        end
+        else begin
+            print(" goto num");
+            print_int(pdf_action_id(pdf_link_action(p)))
+        end;
+    end;
+    pdf_action_page: begin
+        print(" page");
+        print_int(pdf_action_id(pdf_link_action(p)));
+        print_mark(pdf_action_tokens(pdf_link_action(p)));
+    end;
+    pdf_action_thread: begin
+        if pdf_action_named_id(pdf_link_action(p)) > 0 then begin
+            print(" thread name");
+            print_mark(pdf_action_id(pdf_link_action(p)));
+        end
+        else begin
+            print(" thread num");
+            print_int(pdf_action_id(pdf_link_action(p)));
+        end;
+    end;
+    othercases pdf_error("displaying", "unknown action type");
+    endcases;
+end;
+pdf_end_link_node: print_esc("pdfendlink");
+pdf_dest_node: begin
+    print_esc("pdfdest");
+    if pdf_dest_named_id(p) > 0 then begin
+        print(" name");
+        print_mark(pdf_dest_id(p));
+    end
+    else begin
+        print(" num");
+        print_int(pdf_dest_id(p));
+    end;
+    print(" ");
+    case pdf_dest_type(p) of
+    pdf_dest_xyz: begin
+        print("xyz");
+        if pdf_dest_xyz_zoom(p) <> null then begin
+            print(" zoom");
+            print_int(pdf_dest_xyz_zoom(p));
+        end;
+    end;
+    pdf_dest_fitbh: print("fitbh");
+    pdf_dest_fitbv: print("fitbv");
+    pdf_dest_fitb: print("fitb");
+    pdf_dest_fith: print("fith");
+    pdf_dest_fitv: print("fitv");
+    pdf_dest_fitr: begin
+        print("fitr");
+        @<Display <rule spec> for whatsit node created by \pdfTeX@>;
+    end;
+    pdf_dest_fit: print("fit");
+    othercases print("unknown!");
+    endcases;
+end;
+pdf_thread_node,
+pdf_start_thread_node: begin
+    if subtype(p) = pdf_thread_node then
+        print_esc("pdfthread")
+    else
+        print_esc("pdfstartthread");
+    print("("); print_rule_dimen(pdf_height(p)); print_char("+");
+    print_rule_dimen(pdf_depth(p)); print(")x");
+    print_rule_dimen(pdf_width(p));
+    if pdf_thread_attr(p) <> null then begin
+        print(" attr");
+        print_mark(pdf_thread_attr(p));
+    end;
+    if pdf_thread_named_id(p) > 0 then begin
+        print(" name");
+        print_mark(pdf_thread_id(p));
+    end
+    else begin
+        print(" num");
+        print_int(pdf_thread_id(p));
+    end;
+end;
+pdf_end_thread_node: print_esc("pdfendthread");
+pdf_save_pos_node: print_esc("pdfsavepos");
+user_defined_node: begin
+    print_esc("whatsit");
+	print_int(user_node_id(p));
+    print_char("=");
+    case user_node_type(p) of 
+    "a": print("<>");
+    "n": begin print("["); show_node_list(user_node_value(p)); print("]"); end;
+    "s": begin print(""""); print(user_node_value(p)); print(""""); end;
+    "t": print_mark(user_node_value(p));
+    othercases  { only d }
+      print_int(user_node_value(p));
+    endcases;
+	end;
+othercases print("whatsit?")
+endcases
+
+@ @<Incorporate a whatsit node into a vbox@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+d+pdf_height(p); d:=pdf_depth(p);
+s:=0;
+if pdf_width(p)+s>w then w:=pdf_width(p)+s;
+end
+
+@ @<Incorporate a whatsit node into an hbox@>=
+begin
+if subtype(p)=dir_node then 
+  begin
+  @<DIR: Adjust the dir stack for the |hpack| routine@>;
+  end 
+else begin
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+begin x:=x+pdf_width(p);
+s:=0;
+if pdf_height(p)-s>h then h:=pdf_height(p)-s;
+if pdf_depth(p)+s>d then d:=pdf_depth(p)+s;
+end;
+end;
+end
+
+@ @<Let |d| be the width of the whatsit |p|@>=
+if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+    d := pdf_width(p)
+else
+    d := 0
+
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+begin
+  if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+  begin page_total:=page_total+page_depth+pdf_height(p);
+  page_depth:=pdf_depth(p);
+  end;
+  goto contribute;
+end
+
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+begin
+  if (subtype(p) = pdf_refxform_node) or (subtype(p) = pdf_refximage_node) then
+  begin cur_height:=cur_height+prev_dp+pdf_height(p); prev_dp:=pdf_depth(p);
+  end;
+  goto not_found;
+end
+
+@ @<Output the whatsit node |p| in a vlist@>=
+out_what(p)
+
+@ @<Output the whatsit node |p| in an hlist@>=
+if subtype(p)<>dir_node then out_what(p)
+else @<Output a reflection instruction if the direction has changed@>
+
+@ After all this preliminary shuffling, we come finally to the routines
+that actually send out the requested data. Let's do \.{\\special} first
+(it's easier).
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure special_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!k:pool_pointer; {index into |str_pool|}
+begin synch_h; synch_v;@/
+old_setting:=selector; selector:=new_string;
+show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
+selector:=old_setting;
+str_room(1);
+if cur_length<256 then
+  begin dvi_out(xxx1); dvi_out(cur_length);
+  end
+else  begin dvi_out(xxx4); dvi_four(cur_length);
+  end;
+for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start_macro(str_ptr); {erase the string}
+end;
+
+@ To write a token list, we must run it through \TeX's scanner, expanding
+macros and \.{\\the} and \.{\\number}, etc. This might cause runaways,
+if a delimited macro parameter isn't matched, and runaways would be
+extremely confusing since we are calling on \TeX's scanner in the middle
+of a \.{\\shipout} command. Therefore we will put a dummy control sequence as
+a ``stopper,'' right after the token list. This control sequence is
+artificially defined to be \.{\\outer}.
+@:end_write_}{\.{\\endwrite}@>
+
+@<Initialize table...@>=
+text(end_write):="endwrite"; eq_level(end_write):=level_one;
+eq_type(end_write):=outer_call; equiv(end_write):=null;
+
+@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure write_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+@!old_mode:integer; {saved |mode|}
+@!j:small_number; {write stream number}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+begin @<Expand macros in the token list
+  and make |link(def_ref)| point to the result@>;
+old_setting:=selector; j:=write_stream(p);
+if write_open[j] then selector:=j
+else  begin {write to the terminal if file isn't open}
+  if (j=17)and(selector=term_and_log) then selector:=log_only;
+  print_nl("");
+  end;
+token_show(def_ref); print_ln;
+flush_list(def_ref); selector:=old_setting;
+end;
+
+@ The final line of this routine is slightly subtle; at least, the author
+didn't think about it until getting burnt! There is a used-up token list
+@^Knuth, Donald Ervin@>
+on the stack, namely the one that contained |end_write_token|. (We
+insert this artificial `\.{\\endwrite}' to prevent runaways, as explained
+above.) If it were not removed, and if there were numerous writes on a
+single page, the stack would overflow.
+
+@d end_write_token==cs_token_flag+end_write
+
+@<Expand macros in the token list and...@>=
+q:=get_avail; info(q):=right_brace_token+"}";@/
+r:=get_avail; link(q):=r; info(r):=end_write_token; ins_list(q);@/
+begin_token_list(write_tokens(p),write_text);@/
+q:=get_avail; info(q):=left_brace_token+"{"; ins_list(q);
+{now we're ready to scan
+  `\.\{$\langle\,$token list$\,\rangle$\.{\} \\endwrite}'}
+old_mode:=mode; mode:=0;
+  {disable \.{\\prevdepth}, \.{\\spacefactor}, \.{\\lastskip}, \.{\\prevgraf}}
+cur_cs:=write_loc; q:=scan_toks(false,true); {expand macros, etc.}
+get_token;@+if cur_tok<>end_write_token then
+  @<Recover from an unbalanced write command@>;
+mode:=old_mode;
+end_token_list {conserve stack space}
+
+@ @<Recover from an unbalanced write command@>=
+begin print_err("Unbalanced write command");
+@.Unbalanced write...@>
+help2("On this page there's a \write with fewer real {'s than }'s.")@/
+("I can't handle that very well; good luck."); error;
+repeat get_token;
+until cur_tok=end_write_token;
+end
+
+@ The |out_what| procedure takes care of outputting whatsit nodes for
+|vlist_out| and |hlist_out|\kern-.3pt.
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure out_what(@!p:pointer);
+var j:small_number; {write stream number}
+begin case subtype(p) of
+open_node,write_node,close_node:@<Do some work that has been queued up
+  for \.{\\write}@>;
+special_node:special_out(p);
+pdf_save_pos_node:
+  @<Save current position in DVI mode@>;
+local_par_node:do_nothing;
+cancel_boundary_node: do_nothing;
+othercases  confusion("ext4") {TH: those will be pdf extension nodes in dvi mode, most likely}
+@:this can't happen ext4}{\quad ext4@>
+endcases;
+end;
+
+@ @<Save current position in DVI mode@>=
+begin
+    pdf_last_x_pos := cur_h + one_inch;
+    pdf_last_y_pos := cur_page_height - cur_v - one_inch;
+end
+
+@ We don't implement \.{\\write} inside of leaders. (The reason is that
+the number of times a leader box appears might be different in different
+implementations, due to machine-dependent rounding in the glue calculations.)
+@^leaders@>
+
+@<Do some work that has been queued up...@>=
+if not doing_leaders then
+  begin j:=write_stream(p);
+  if subtype(p)=write_node then write_out(p)
+  else  begin if write_open[j] then lua_a_close_out(write_file[j]);
+    if subtype(p)=close_node then write_open[j]:=false
+    else if j<16 then
+      begin cur_name:=open_name(p); cur_area:=open_area(p);
+      cur_ext:=open_ext(p);
+      if cur_ext="" then cur_ext:=".tex";
+      pack_cur_name;
+      while not lua_a_open_out(write_file[j],(j+1)) do
+        prompt_file_name("output file name",".tex");
+      write_file[j]:= name_file_pointer;
+      write_open[j]:=true;
+      end;
+    end;
+  end
+
+@ The presence of `\.{\\immediate}' causes the |do_extension| procedure
+to descend to one level of recursion. Nothing happens unless \.{\\immediate}
+is followed by `\.{\\openout}', `\.{\\write}', or `\.{\\closeout}'.
+@^recursion@>
+
+@<Implement \.{\\immediate}@>=
+begin get_x_token;
+if cur_cmd=extension then begin
+    if cur_chr<=close_node then
+      begin p:=tail; do_extension; {append a whatsit node}
+      out_what(tail); {do the action immediately}
+      flush_node_list(tail); tail:=p; vlink(p):=null;
+      end
+    else case cur_chr of
+      close_lua_node: begin
+        scan_register_num;
+	    closelua(cur_val);
+      end;
+        pdf_obj_code: begin
+            do_extension; {scan object and set |pdf_last_obj|}
+            if obj_data_ptr(pdf_last_obj) = 0 then {this object has not been initialized yet}
+                pdf_error("ext1", "`\pdfobj reserveobjnum' cannot be used with \immediate");
+            pdf_write_obj(pdf_last_obj);
+        end;
+        pdf_xform_code: begin
+            do_extension; {scan form and set |pdf_last_xform|}
+            pdf_cur_form := pdf_last_xform;
+            pdf_ship_out(obj_xform_box(pdf_last_xform), false);
+        end;
+        pdf_ximage_code: begin
+            do_extension; {scan image and set |pdf_last_ximage|}
+            pdf_write_image(pdf_last_ximage);
+        end;
+        othercases back_input
+    endcases;
+end
+else
+    back_input;
+end
+
+@ @<Finish the extensions@>=
+for k:=0 to 15 do if write_open[k] then lua_a_close_out(write_file[k])
+
+@ 
+@d local_pen_inter(#)==vinfo(#+2) {\.{\\localinterlinepenalty}}
+@d local_pen_broken(#)==vlink(#+2) {\.{\\localbrokenpenalty}}
+@d local_box_left(#)==vlink(#+3) {\.{\\localleftbox}}
+@d local_box_left_width(#)==vinfo(#+3)
+@d local_box_right(#)==vlink(#+4) {\.{\\localleftbox}}
+@d local_box_right_width(#)==vinfo(#+4)
+@d local_par_dir(#)==vinfo(#+5)
+@d local_par_size==6
+
+@<LOCAL: Declare |make_local_par_node|@>=
+function make_local_par_node:pointer;
+{This function creates a |local_paragraph| node}
+var p,q:pointer;
+begin
+p:=new_node(whatsit_node,local_par_node);
+local_pen_inter(p):=local_inter_line_penalty;
+local_pen_broken(p):=local_broken_penalty;
+if local_left_box<>null then begin
+  q:=copy_node_list(local_left_box); local_box_left(p):=q;
+  local_box_left_width(p):=width(local_left_box);
+  end;
+if local_right_box<>null then begin
+  q:=copy_node_list(local_right_box); local_box_right(p):=q;
+  local_box_right_width(p):=width(local_right_box);
+  end;
+local_par_dir(p):=par_direction;
+make_local_par_node:=p;
+end
+
+@ @<LOCAL: print out |local_paragraph| node@>=
+local_par_node: begin
+  print_esc("whatsit");
+  append_char(".");
+  print_ln; print_current_string;
+  print_esc("localinterlinepenalty"); print("=");
+  print_int(local_pen_inter(p));
+  print_ln; print_current_string;
+  print_esc("localbrokenpenalty"); print("=");
+  print_int(local_pen_broken(p));
+  print_ln; print_current_string;
+  print_esc("localleftbox");
+  if local_box_left(p)=null then print("=null")
+  else begin
+    append_char(".");
+    show_node_list(local_box_left(p));
+    decr(pool_ptr);
+    end;
+  print_ln; print_current_string;
+  print_esc("localrightbox");
+  if local_box_right(p)=null then print("=null")
+  else begin
+    append_char(".");
+    show_node_list(local_box_right(p));
+    decr(pool_ptr);
+    end;
+  decr(pool_ptr);
+  end
+
+@ @<LOCAL: Add local paragraph node@>=
+begin tail_append(make_local_par_node) end
+
+@ @<DIR: Assign direction codes@>=
+case cur_chr of
+dir_base+page_direction_code: begin
+  if its_all_over then begin
+    scan_direction;
+    eq_word_define(dir_base+page_direction_code,cur_val);
+    end;
+  end;
+dir_base+body_direction_code: begin
+  if its_all_over then begin
+    scan_direction;
+    eq_word_define(dir_base+body_direction_code,cur_val);
+    end;
+  end;
+dir_base+par_direction_code: begin
+  scan_direction;
+  eq_word_define(dir_base+par_direction_code,cur_val);
+  end;
+dir_base+text_direction_code: begin scan_direction;
+  if (no_local_dirs>0) and (abs(mode)=hmode) then begin
+    @<DIR: Add local dir node@>;
+    dir_dir(tail):=dir_dir(tail)-64;
+    end;
+  if dir_level(text_dir_ptr)=cur_level then
+    @<DIR: Remove from |text_dir_ptr|@>;
+  eq_word_define(dir_base+text_direction_code,cur_val);
+  @<DIR: Add to |text_dir_ptr|@>;
+  if abs(mode)=hmode then
+    begin
+    @<DIR: Add local dir node@>;
+    dir_level(tail):=cur_level;
+    end;
+  eq_word_define(int_base+no_local_dirs_code,no_local_dirs+1);
+  eq_word_define(int_base+level_local_dir_code,cur_level);
+  end;
+dir_base+math_direction_code: begin scan_direction;
+  eq_word_define(dir_base+math_direction_code,cur_val);
+  end;
+end;
+
+@
+@d push_dir(#)==
+begin dir_tmp:=new_dir(#);
+vlink(dir_tmp):=dir_ptr;
+dir_ptr:=dir_tmp;
+end
+
+@d push_dir_node(#)==
+begin dir_tmp:=copy_node(#);
+vlink(dir_tmp):=dir_ptr; 
+dir_ptr:=dir_tmp;
+end
+
+@d pop_dir_node==
+begin dir_tmp:=dir_ptr;
+dir_ptr:=vlink(dir_tmp);
+flush_node(dir_tmp);
+end
+
+@ @<DIR: Declare |new_dir|@>=
+function new_dir(s:small_number): pointer;
+var p:pointer; {the new node}
+begin p:=new_node(whatsit_node,dir_node);
+dir_dir(p):=s; dir_dvi_ptr(p):=-1;
+dir_level(p):=cur_level; new_dir:=p;
+end
+
+@ @<Append a begin direction to the tail of the current list@>=
+tail_append(new_dir(math_direction))
+
+@ @<Append an end direction to the tail of the current list@>=
+tail_append(new_dir(math_direction-64))
+
+@ @<DIR: Add local dir node@>=
+tail_append(new_dir(text_direction))
+
+@ @<DIR: Adjust the dir stack for the |hpack| routine@>=
+begin
+if dir_dir(p)>=0 then begin
+  hpack_dir:=dir_dir(p);
+  push_dir_node(p);
+  end
+else begin
+  pop_dir_node;
+  if dir_ptr<>null then
+    hpack_dir:=dir_dir(dir_ptr);
+  end
+end
+
+@ @<DIR: Reset |dir_ptr|@>=
+begin
+ while dir_ptr<>null do
+  pop_dir_node
+end
+
+@ @<DIR: |unsave| math@>=
+begin
+unsave;
+decr(save_ptr);
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(0);
+end
+
+@ @<DIR: |new_save_level| math@>=
+begin
+saved(0):=text_dir_ptr;
+text_dir_ptr:=new_dir(math_direction);
+incr(save_ptr); 
+new_save_level(c);
+eq_word_define(dir_base+body_direction_code,math_direction);
+eq_word_define(dir_base+par_direction_code,math_direction);
+eq_word_define(dir_base+text_direction_code,math_direction);
+eq_word_define(int_base+level_local_dir_code,cur_level);
+end
+
+@ @<DIR: Adjust |text_dir_ptr| for |scan_spec|@>=
+begin
+if spec_direction<>-1 then begin
+  saved(4):=text_dir_ptr;
+  text_dir_ptr:=new_dir(spec_direction);
+  end
+else saved(4):=null;
+end
+
+@ @<DIR: Adjust back |text_dir_ptr| for |scan_spec|@>=
+begin
+flush_node_list(text_dir_ptr);
+text_dir_ptr:=saved(4);
+end
+
+@ @<DIR: Add to |text_dir_ptr|@>=
+begin
+text_dir_tmp:=new_dir(text_direction);
+vlink(text_dir_tmp):=text_dir_ptr;
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Remove from |text_dir_ptr|@>=
+begin
+text_dir_tmp:=vlink(text_dir_ptr);
+flush_node(text_dir_ptr);
+text_dir_ptr:=text_dir_tmp;
+end
+
+@ @<DIR: Initialize |text_dir_ptr|@>=
+begin
+text_dir_ptr:=new_dir(0);
+end
+
+@ @<DIR: Initialize |dir_ptr| for |ship_out|@>=
+begin dir_ptr:=null; push_dir(dvi_direction);
+dir_dvi_ptr(dir_ptr):=dvi_ptr;
+end
+
+@ @<Output a reflection instruction if the direction has changed@>=
+begin
+if dir_dir(p)>=0 then
+  begin synch_h; synch_v;
+  push_dir_node(p);
+  if dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction])
+  then begin
+    if (dir_secondary[dvi_direction]=0) or
+       (dir_secondary[dvi_direction]=2) then
+      dvi_out(down4)
+    else
+      dvi_out(right4);
+    dir_dvi_ptr(dir_ptr):=dvi_ptr;
+    dir_dvi_h(dir_ptr):=dvi_h;
+    dvi_four(0);
+    cur_h:=0; dvi_h:=0;
+    end
+  else begin
+    dir_dvi_ptr(dir_ptr):=dvi_ptr;
+    dir_dvi_h(dir_ptr):=dvi_h;
+    end;
+  dvi_direction:=dir_dir(dir_ptr);
+  end
+else begin
+  dvi_dir_h:=dir_dvi_h(dir_ptr);
+  dvi_dir_ptr:=dir_dvi_ptr(dir_ptr);
+  pop_dir_node;
+  synch_h; synch_v;
+  if dir_ptr<>null then
+	 dvi_direction:=dir_dir(dir_ptr)
+  else
+	dvi_direction:=0;
+ if dir_opposite(dir_secondary[dir_dir(p)+64])(dir_secondary[dvi_direction])
+  then begin
+    dvi_temp_ptr:=dvi_ptr;
+    dvi_ptr:=dvi_dir_ptr;
+    if (dir_secondary[dvi_direction]=0) or
+       (dir_secondary[dvi_direction]=1) then
+      dvi_four(dvi_h)
+    else
+      dvi_four(-dvi_h);
+    dvi_ptr:=dvi_temp_ptr;
+    if (dir_secondary[dvi_direction]=0) or
+       (dir_secondary[dvi_direction]=2) then
+      dvi_out(down4)
+    else
+      dvi_out(right4);
+    if (dir_secondary[dvi_direction]=0) or
+       (dir_secondary[dvi_direction]=1) then
+      dvi_four(dvi_h)
+    else
+      dvi_four(-dvi_h);
+    end;
+    cur_h:=dvi_dir_h+dvi_h; dvi_h:=cur_h;
+  end
+end
+
+@ Many things regarding output work differently in pdf compared to dvi
+output. The easiest way to deal with in-line direction changes in pdf
+mode seems to be to move forward to find the needed width of the
+reversed section, then skip forward (or backward, depending on your
+viewpont) by that distance.
+
+@<(PDF) Output a reflection instruction if the direction has changed@>=
+begin
+if dir_dir(p)>=0 then begin
+  push_dir_node(p);
+  if dir_opposite(dir_secondary[dir_dir(dir_ptr)])(dir_secondary[dvi_direction])
+  then begin
+	@<(PDF) Calculate the needed width to the matching |enddir|, and store it in |w|, as
+      well as in the enddir's |dir_dvi_h|@>;
+    case box_direction(dvi_direction) of
+    dir_TL_,dir_BL_: pdf_dvicmd_right(w);
+    dir_TR_,dir_BR_: pdf_dvicmd_left(w);
+    end;
+  end;
+  dvi_direction:=dir_dir(dir_ptr);
+  end
+else begin
+  pop_dir_node;
+  if dir_ptr<>null then
+    dvi_direction:=dir_dir(dir_ptr)
+  else
+    dvi_direction:=0;
+  case box_direction(dvi_direction) of
+    dir_TL_,dir_BL_: pdf_dvicmd_right(dir_dvi_h(p));
+    dir_TR_,dir_BR_: pdf_dvicmd_left(dir_dvi_h(p));
+  end;
+  end
+end
+
+@ This code scans forward to the ending |dir_node| while keeping
+track of the needed width in |w|. When it finds the node that will end
+this segment, it stores the accumulated with in the |dir_dvi_h| field
+of that end node, so that when that node is found later in the
+processing, the correct glue correction can be applied.
+
+@<(PDF) Calculate the needed width to the matching |enddir|...@>=
+begin
+  q:=p; w:=0; 
+  save_cur_g:=cur_g;
+  save_cur_glue:=cur_glue;
+  { to me, it looks like the next is needed. but Aleph doesn't do that,
+   so let us not do it either }
+  {|w:=w-cur_g; cur_glue:=0;|}
+  dir_nest:=1;
+  while (q<>null) and (vlink(q)<>null) do begin
+	q:=vlink(q);
+    if is_char_node(q) then begin
+      w:=w+glyph_width(q); {TODO no vertical support for now}
+      end 
+    else begin
+      case type(q) of
+      hlist_node,vlist_node,rule_node,
+      margin_kern_node,kern_node:w:=w+width(q);
+	  glue_node: begin 
+        g:=glue_ptr(q);
+        w:=w+width(g)-cur_g; 
+        if g_sign<>normal then
+          begin if g_sign=stretching then
+            begin if stretch_order(g)=g_order then
+              begin cur_glue:=cur_glue+stretch(g);
+              vet_glue(float(glue_set(this_box))*cur_glue);
+              cur_g:=round(glue_temp);
+              end;
+            end
+          else if shrink_order(g)=g_order then
+             begin cur_glue:=cur_glue-shrink(g);
+             vet_glue(float(glue_set(this_box))*cur_glue);
+             cur_g:=round(glue_temp);
+             end;
+          end;
+        w:=w+cur_g; 
+        end;
+      math_node: w:=w+surround(q);
+      whatsit_node: begin
+        if subtype(q)=dir_node then begin 
+          if dir_dir(q)>=0 then incr(dir_nest) else decr(dir_nest);
+          if dir_nest=0 then begin
+            dir_dvi_h(q) := w;
+           q:=null;
+            end;
+          end 
+        else if (subtype(q) = pdf_refxform_node) or 
+                (subtype(q) = pdf_refximage_node) then
+         w:=w+pdf_width(q);
+      end;
+      othercases do_nothing;
+      endcases;
+    end;
+  end;
+  cur_g:=save_cur_g;
+  cur_glue:=save_cur_glue;
+end
+
+
+@ Shipping out PDF marks.
+
+@<Types...@>=
+dest_name_entry = record
+    objname: str_number; {destination name}
+    objnum: integer; {destination object number}
+end;
+
+@ @<Glob...@>=
+@!cur_page_width: scaled; {width of page being shipped}
+@!cur_page_height: scaled; {height of page being shipped}
+@!cur_right_offset: scaled; {horizontal inverted offset of page being shipped}
+@!cur_bottom_offset: scaled; {vertical inverted offset of page being shipped}
+@!pdf_obj_list: pointer; {list of objects in the current page}
+@!pdf_xform_list: pointer; {list of forms in the current page}
+@!pdf_ximage_list: pointer; {list of images in the current page}
+@!last_thread: pointer; {pointer to the last thread}
+@!pdf_thread_ht, pdf_thread_dp, pdf_thread_wd: scaled; {dimensions of the last
+thread}
+@!pdf_last_thread_id: halfword; {identifier of the last thread}
+@!pdf_last_thread_named_id: boolean; {is identifier of the last thread named}
+@!pdf_thread_level: integer; {depth of nesting of box containing the last thread}
+@!pdf_annot_list: pointer; {list of annotations in the current page}
+@!pdf_link_list: pointer; {list of link annotations in the current page}
+@!pdf_dest_list: pointer; {list of destinations in the current page}
+@!pdf_bead_list: pointer; {list of thread beads in the current page}
+@!pdf_obj_count: integer; {counter of objects}
+@!pdf_xform_count: integer; {counter of forms}
+@!pdf_ximage_count: integer; {counter of images}
+@!pdf_cur_form: integer; {the form being output}
+@!pdf_first_outline, pdf_last_outline, pdf_parent_outline: integer;
+@!pdf_info_toks: pointer; {additional keys of Info dictionary}
+@!pdf_catalog_toks: pointer; {additional keys of Catalog dictionary}
+@!pdf_catalog_openaction: integer;
+@!pdf_names_toks: pointer; {additional keys of Names dictionary}
+@!pdf_dest_names_ptr: integer; {first unused position in |dest_names|}
+@!dest_names_size: integer; {maximum number of names in name tree of PDF output file}
+@!dest_names: ^dest_name_entry;
+@!pk_dpi: integer; {PK pixel density value from \.{texmf.cnf}}
+@!image_orig_x, image_orig_y: integer; {origin of cropped PDF images}
+@!pdf_trailer_toks: pointer; {additional keys of Trailer dictionary}
+
+@ @<Set init...@>=
+pdf_first_outline:= 0;
+pdf_last_outline:= 0;
+pdf_parent_outline:= 0;
+pdf_obj_count := 0;
+pdf_xform_count := 0;
+pdf_ximage_count := 0;
+pdf_dest_names_ptr := 0;
+pdf_info_toks := null;
+pdf_catalog_toks := null;
+pdf_names_toks := null;
+pdf_catalog_openaction := 0;
+pdf_trailer_toks := null;
+
+@ The following procedures are needed for outputing whatsit nodes for
+\pdfTeX{}.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure write_action(p: pointer); {write an action specification}
+var s: str_number;
+    d: integer;
+begin d:=0;
+    if pdf_action_type(p) = pdf_action_user then begin
+        pdf_print_toks_ln(pdf_action_tokens(p));
+        return;
+    end;
+    pdf_print("<< ");
+    if pdf_action_file(p) <> null then begin
+        pdf_print("/F ");
+        s := tokens_to_string(pdf_action_file(p));
+        if (str_pool[str_start_macro(s)] = 40) and
+           (str_pool[str_start_macro(s) + length(s) - 1] = 41) then
+            pdf_print(s)
+        else begin
+            pdf_print_str(s);
+        end;
+        flush_str(s);
+        pdf_print(" ");
+        if pdf_action_new_window(p) > 0 then begin
+            pdf_print("/NewWindow ");
+            if pdf_action_new_window(p) = 1 then
+                pdf_print("true ")
+            else
+                pdf_print("false ");
+        end;
+    end;
+    case pdf_action_type(p) of
+    pdf_action_page: begin
+        if pdf_action_file(p) = null then begin
+            pdf_print("/S /GoTo /D [");
+            pdf_print_int(get_obj(obj_type_page, pdf_action_id(p), false));
+            pdf_print(" 0 R");
+        end
+        else begin
+            pdf_print("/S /GoToR /D [");
+            pdf_print_int(pdf_action_id(p) - 1);
+        end;
+        pdf_out(" ");
+        pdf_print(tokens_to_string(pdf_action_tokens(p)));
+        flush_str(last_tokens_string);
+        pdf_out("]");
+    end;
+    pdf_action_goto: begin
+        if pdf_action_file(p) = null then begin
+            pdf_print("/S /GoTo ");
+            d := get_obj(obj_type_dest, pdf_action_id(p),
+                         pdf_action_named_id(p));
+        end
+        else
+            pdf_print("/S /GoToR ");
+        if pdf_action_named_id(p) > 0 then begin
+            pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+            flush_str(last_tokens_string);
+        end
+        else if pdf_action_file(p) = null then
+            pdf _indirect("D", d)
+        else
+            pdf_error("ext4", "`goto' option cannot be used with both `file' and `num'");
+    end;
+    pdf_action_thread: begin
+        pdf_print("/S /Thread ");
+        if pdf_action_file(p) = null then
+            d := get_obj(obj_type_thread, pdf_action_id(p),
+                         pdf_action_named_id(p));
+        if pdf_action_named_id(p) > 0 then begin
+            pdf_str_entry("D", tokens_to_string(pdf_action_id(p)));
+            flush_str(last_tokens_string);
+        end
+        else if pdf_action_file(p) = null then
+            pdf_indirect("D", d)
+        else
+            pdf_int_entry("D", pdf_action_id(p));
+    end;
+    endcases;
+    pdf_print_ln(" >>");
+end;
+
+procedure set_rect_dimens(p, parent_box: pointer; x, y, w, h, d, margin: scaled);
+begin
+    pdf_left(p) := cur_h;
+    if is_running(w) then
+        pdf_right(p) := x + width(parent_box)
+    else
+        pdf_right(p) := cur_h + w;
+    if is_running(h) then
+        pdf_top(p) := y - height(parent_box)
+    else
+        pdf_top(p) := cur_v - h;
+    if is_running(d) then
+        pdf_bottom(p) := y  + depth(parent_box)
+    else
+        pdf_bottom(p) := cur_v + d;
+    if is_shipping_page and matrixused then begin
+        matrixtransformrect(pdf_left(p), cur_page_height - pdf_bottom(p),
+                            pdf_right(p), cur_page_height - pdf_top(p));
+        pdf_left(p)   := getllx;
+        pdf_bottom(p) := cur_page_height - getlly;
+        pdf_right(p)  := geturx;
+        pdf_top(p)    := cur_page_height - getury;
+    end;
+    pdf_left(p)   := pdf_left(p)   - margin;
+    pdf_top(p)    := pdf_top(p)    - margin;
+    pdf_right(p)  := pdf_right(p)  + margin;
+    pdf_bottom(p) := pdf_bottom(p) + margin;
+end;
+
+procedure do_annot(p, parent_box: pointer; x, y: scaled);
+begin
+    if not is_shipping_page then
+        pdf_error("ext4", "annotations cannot be inside an XForm");
+    if doing_leaders then
+        return;
+    set_rect_dimens(p, parent_box, x, y,
+                    pdf_width(p), pdf_height(p), pdf_depth(p), 0);
+    obj_annot_ptr(pdf_annot_objnum(p)) := p;
+    pdf_append_list(pdf_annot_objnum(p))(pdf_annot_list);
+end;
+
+@ To implement nesting link annotations, we need a stack to hold copy of
+|pdf_start_link_node|'s that are being written out, together with their box
+nesting level.
+
+@d pdf_link_stack_top == pdf_link_stack[pdf_link_stack_ptr]
+
+@<Constants...@>=
+@!pdf_max_link_level = 10; {maximum depth of link nesting}
+
+@ @<Types...@>=
+@!pdf_link_stack_record = record
+    nesting_level: small_number;
+    link_node: pointer; {holds a copy of the corresponding |pdf_start_link_node|}
+    ref_link_node: pointer; {points to original |pdf_start_link_node|, or a
+                             copy of |link_node| created by |append_link| in
+                             case of multi-line link}
+end;
+
+@ @<Glob...@>=
+@!pdf_link_stack: array[1..pdf_max_link_level] of pdf_link_stack_record;
+@!pdf_link_stack_ptr: small_number;
+
+@ @<Set init...@>=
+pdf_link_stack_ptr := 0;
+
+@ @<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure push_link_level(p: pointer);
+begin
+    if pdf_link_stack_ptr >= pdf_max_link_level then
+        overflow("pdf link stack size", pdf_max_link_level);
+    pdfassert((type(p) = whatsit_node) and (subtype(p) = pdf_start_link_node));
+    incr(pdf_link_stack_ptr);
+    pdf_link_stack_top.nesting_level := cur_s;
+    pdf_link_stack_top.link_node := copy_node_list(p);
+    pdf_link_stack_top.ref_link_node := p;
+end;
+
+procedure pop_link_level;
+begin
+    pdfassert(pdf_link_stack_ptr > 0);
+    flush_node_list(pdf_link_stack_top.link_node);
+    decr(pdf_link_stack_ptr);
+end;
+
+procedure do_link(p, parent_box: pointer; x, y: scaled);
+begin
+    if not is_shipping_page then
+        pdf_error("ext4", "link annotations cannot be inside an XForm");
+    pdfassert(type(parent_box) = hlist_node);
+    push_link_level(p);
+    set_rect_dimens(p, parent_box, x, y,
+                    pdf_width(p), pdf_height(p), pdf_depth(p),
+                    pdf_link_margin);
+    obj_annot_ptr(pdf_link_objnum(p)) := p; {the reference for the pdf annot object
+                                             must be set here}
+    pdf_append_list(pdf_link_objnum(p))(pdf_link_list);
+end;
+
+procedure end_link;
+var p: pointer;
+begin
+    if pdf_link_stack_ptr < 1 then
+        pdf_error("ext4", "pdf_link_stack empty, \pdfendlink used without \pdfstartlink?");
+    if pdf_link_stack_top.nesting_level <> cur_s then
+        pdf_error("ext4", "\pdfendlink ended up in different nesting level than \pdfstartlink");
+
+    {N.B.: test for running link must be done on |link_node| and not |ref_link_node|,
+     as |ref_link_node| can be set by |do_link| or |append_link| already}
+
+    if is_running(pdf_width(pdf_link_stack_top.link_node)) then begin
+        p := pdf_link_stack_top.ref_link_node;
+        if is_shipping_page and matrixused then begin
+            matrixrecalculate(cur_h + pdf_link_margin);
+            pdf_left(p)   := getllx - pdf_link_margin;
+            pdf_top(p)    := cur_page_height - getury - pdf_link_margin;
+            pdf_right(p)  := geturx + pdf_link_margin;
+            pdf_bottom(p) := cur_page_height - getlly + pdf_link_margin;
+         end
+         else
+            pdf_right(p) := cur_h + pdf_link_margin;
+    end;
+    pop_link_level;
+end;
+
+@ For ``running'' annotations we must append a new node when the end of
+annotation is in other box than its start. The new created node is identical to
+corresponding whatsit node representing the start of annotation,  but its
+|info| field is |max_halfword|. We set |info| field just before destroying the
+node, in order to use |flush_node_list| to do the job.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_link(parent_box: pointer; x, y: scaled; i: small_number); {append a new
+pdf annot to |pdf_link_list|}
+var p: pointer;
+begin
+    pdfassert(type(parent_box) = hlist_node);
+    p := copy_node(pdf_link_stack[i].link_node);
+    pdf_link_stack[i].ref_link_node := p;
+    subtype(p) := pdf_link_data_node; { this node is not a normal link node}
+    set_rect_dimens(p, parent_box, x, y,
+                    pdf_width(p), pdf_height(p), pdf_depth(p),
+                    pdf_link_margin);
+    pdf_create_obj(obj_type_others, 0);
+    obj_annot_ptr(obj_ptr) := p;
+    pdf_append_list(obj_ptr)(pdf_link_list);
+end;
+
+@ Threads are handled in similar way as link annotations.
+
+@<Declare procedures needed in |pdf_hlist_out|, |pdf_vlist_out|@>=
+procedure append_bead(p: pointer);
+var a, b, c, t: integer;
+begin
+    if not is_shipping_page then
+        pdf_error("ext4", "threads cannot be inside an XForm");
+    t := get_obj(obj_type_thread, pdf_thread_id(p), pdf_thread_named_id(p));
+    b := pdf_new_objnum;
+    obj_bead_ptr(b) := pdf_get_mem(pdfmem_bead_size);
+    obj_bead_page(b) := pdf_last_page;
+    obj_bead_data(b) := p;
+    if pdf_thread_attr(p) <> null then
+        obj_bead_attr(b) := tokens_to_string(pdf_thread_attr(p))
+    else
+        obj_bead_attr(b) := 0;
+    if obj_thread_first(t) = 0 then begin
+        obj_thread_first(t) := b;
+        obj_bead_next(b) := b;
+        obj_bead_prev(b) := b;
+    end
+    else begin
+        a := obj_thread_first(t);
+        c := obj_bead_prev(a);
+        obj_bead_prev(b) := c;
+        obj_bead_next(b) := a;
+        obj_bead_prev(a) := b;
+        obj_bead_next(c) := b;
+    end;
+    pdf_append_list(b)(pdf_bead_list);
+end;
+
+procedure do_thread(p, parent_box: pointer; x, y: scaled);
+begin
+    if doing_leaders then
+        return;
+    if subtype(p) = pdf_start_thread_node then begin
+        pdf_thread_wd := pdf_width(p);
+        pdf_thread_ht := pdf_height(p);
+        pdf_thread_dp := pdf_depth(p);
+        pdf_last_thread_id := pdf_thread_id(p);
+        pdf_last_thread_named_id := (pdf_thread_named_id(p) > 0);
+        if pdf_last_thread_named_id then
+            add_token_ref(pdf_thread_id(p));
+        pdf_thread_level := cur_s;
+    end;
+    set_rect_dimens(p, parent_box, x, y,
+                    pdf_width(p), pdf_height(p), pdf_depth(p),
+                    pdf_thread_margin);
+    append_bead(p);
+    last_thread := p;
+end;
+
+procedure append_thread(parent_box: pointer; x, y: scaled);
+var p: pointer;
+begin
+    p := new_node(whatsit_node,pdf_thread_data_node);
+    pdf_width(p) := pdf_thread_wd;
+    pdf_height(p) := pdf_thread_ht;
+    pdf_depth(p) := pdf_thread_dp;
+    pdf_thread_attr(p) := null;
+    pdf_thread_id(p) := pdf_last_thread_id;
+    if pdf_last_thread_named_id then begin
+        add_token_ref(pdf_thread_id(p));
+        pdf_thread_named_id(p) := 1;
+    end
+    else
+        pdf_thread_named_id(p) := 0;
+    set_rect_dimens(p, parent_box, x, y,
+                    pdf_width(p), pdf_height(p), pdf_depth(p),
+                    pdf_thread_margin);
+    append_bead(p);
+    last_thread := p;
+end;
+
+procedure end_thread;
+begin
+    if pdf_thread_level <> cur_s then
+        pdf_error("ext4", "\pdfendthread ended up in different nesting level than \pdfstartthread");
+    if is_running(pdf_thread_dp) and (last_thread <> null) then
+        pdf_bottom(last_thread) := cur_v + pdf_thread_margin;
+    if pdf_last_thread_named_id then
+        delete_token_ref(pdf_last_thread_id);
+    last_thread := null;
+end;
+
+function open_subentries(p: pointer): integer;
+var k, c: integer;
+    l, r: integer;
+begin
+    k := 0;
+    if obj_outline_first(p) <> 0 then begin
+        l := obj_outline_first(p);
+        repeat
+            incr(k);
+            c := open_subentries(l);
+            if obj_outline_count(l) > 0 then
+                k := k + c;
+            obj_outline_parent(l) := p;
+            r := obj_outline_next(l);
+            if r = 0 then
+                obj_outline_last(p) := l;
+            l := r;
+        until l = 0;
+    end;
+    if obj_outline_count(p) > 0 then
+        obj_outline_count(p) := k
+    else
+        obj_outline_count(p) := -k;
+    open_subentries := k;
+end;
+
+procedure do_dest(p, parent_box: pointer; x, y: scaled);
+var k: integer;
+begin
+    if not is_shipping_page then
+        pdf_error("ext4", "destinations cannot be inside an XForm");
+    if doing_leaders then
+        return;
+    k := get_obj(obj_type_dest, pdf_dest_id(p), pdf_dest_named_id(p));
+    if obj_dest_ptr(k) <> null then begin
+        warn_dest_dup(pdf_dest_id(p), pdf_dest_named_id(p),
+                      "ext4", "has been already used, duplicate ignored");
+        return;
+    end;
+    obj_dest_ptr(k) := p;
+    pdf_append_list(k)(pdf_dest_list);
+    case pdf_dest_type(p) of
+    pdf_dest_xyz:
+        if matrixused then
+            set_rect_dimens(p, parent_box, x, y,
+                            pdf_width(p), pdf_height(p), pdf_depth(p),
+                            pdf_dest_margin)
+        else begin
+        pdf_left(p) := cur_h;
+        pdf_top(p) := cur_v;
+    end;
+    pdf_dest_fith,
+    pdf_dest_fitbh:
+        if matrixused then
+            set_rect_dimens(p, parent_box, x, y,
+                            pdf_width(p), pdf_height(p), pdf_depth(p),
+                            pdf_dest_margin)
+        else
+        pdf_top(p) := cur_v;
+    pdf_dest_fitv,
+    pdf_dest_fitbv:
+       if matrixused then
+            set_rect_dimens(p, parent_box, x, y,
+                            pdf_width(p), pdf_height(p), pdf_depth(p),
+                            pdf_dest_margin)
+       else
+       pdf_left(p) := cur_h;
+    pdf_dest_fit,
+    pdf_dest_fitb:
+        do_nothing;
+    pdf_dest_fitr:
+        set_rect_dimens(p, parent_box, x, y,
+                        pdf_width(p), pdf_height(p), pdf_depth(p),
+                        pdf_dest_margin);
+    endcases;
+end;
+
+procedure out_form(p: pointer);
+var v: scaled;
+begin
+    pdf_end_text;
+    pdf_print_ln("q");
+    if pdf_lookup_list(pdf_xform_list, pdf_xform_objnum(p)) = null then
+        pdf_append_list(pdf_xform_objnum(p))(pdf_xform_list);
+    v := cur_v + obj_xform_depth(pdf_xform_objnum(p));
+    pdf_set_origin_temp(cur_h, v);
+    pdf_print("/Fm");
+    pdf_print_int(obj_info(pdf_xform_objnum(p)));
+    pdf_print_resname_prefix;
+    pdf_print_ln(" Do");
+    pdf_print_ln("Q");
+end;
+
+@ @<Output the whatsit node |p| in |pdf_vlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+    pdf_out_literal(p);
+pdf_colorstack_node:
+    pdf_out_colorstack(p);
+pdf_setmatrix_node:
+    pdf_out_setmatrix(p);
+pdf_save_node:
+    pdf_out_save;
+pdf_restore_node:
+    pdf_out_restore;
+late_lua_node:
+    do_late_lua(p);
+close_lua_node:
+    closelua(late_lua_reg(p));
+pdf_refobj_node:
+    pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+    @<Output a Form node in a vlist@>;
+pdf_refximage_node:
+    @<Output a Image node in a vlist@>;
+pdf_annot_node:
+    do_annot(p, this_box, left_edge, top_edge + height(this_box));
+pdf_start_link_node:
+    pdf_error("ext4", "\pdfstartlink ended up in vlist");
+pdf_end_link_node:
+    pdf_error("ext4", "\pdfendlink ended up in vlist");
+pdf_dest_node:
+    do_dest(p, this_box, left_edge, top_edge + height(this_box));
+pdf_thread_node,
+pdf_start_thread_node:
+    do_thread(p, this_box, left_edge, top_edge + height(this_box));
+pdf_end_thread_node:
+    end_thread;
+pdf_save_pos_node:
+    @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+    pdf_special(p);
+othercases out_what(p);
+endcases
+
+@ @<Glob...@>=
+@!is_shipping_page: boolean; {set to |shipping_page| when |pdf_ship_out| starts}
+
+@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
+begin
+    pdf_last_x_pos := cur_h;
+    pdf_last_y_pos := cur_page_height - cur_v
+end
+
+@ @<Output a Image node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p)+pdf_depth(p);
+  cur_h:=left_edge;
+  out_image(pdf_ximage_ref(p), cur_h-pdf_origin_h, pdf_origin_v-cur_v);
+  if pdf_lookup_list(pdf_ximage_list, image_objnum(pdf_ximage_ref(p))) = null then
+      pdf_append_list(image_objnum(pdf_ximage_ref(p)))(pdf_ximage_list);
+end
+
+@ @<Output a Form node in a vlist@>=
+begin cur_v:=cur_v+pdf_height(p);
+  cur_h:=left_edge;
+  out_form(p);
+  cur_v:=cur_v+pdf_depth(p);
+end
+
+@ @<Output the whatsit node |p| in |pdf_hlist_out|@>=
+case subtype(p) of
+pdf_literal_node:
+    pdf_out_literal(p);
+pdf_colorstack_node:
+    pdf_out_colorstack(p);
+pdf_setmatrix_node:
+    pdf_out_setmatrix(p);
+pdf_save_node:
+    pdf_out_save;
+pdf_restore_node:
+    pdf_out_restore;
+late_lua_node:
+    do_late_lua(p);
+close_lua_node:
+	closelua(late_lua_reg(p));
+pdf_refobj_node:
+    pdf_append_list(pdf_obj_objnum(p))(pdf_obj_list);
+pdf_refxform_node:
+    @<Output a Form node in a hlist@>;
+pdf_refximage_node:
+    @<Output a Image node in a hlist@>;
+pdf_annot_node:
+    do_annot(p, this_box, left_edge, base_line);
+pdf_start_link_node:
+    do_link(p, this_box, left_edge, base_line);
+pdf_end_link_node:
+    end_link;
+pdf_dest_node:
+    do_dest(p, this_box, left_edge, base_line);
+pdf_thread_node:
+    do_thread(p, this_box, left_edge, base_line);
+pdf_start_thread_node:
+    pdf_error("ext4", "\pdfstartthread ended up in hlist");
+pdf_end_thread_node:
+    pdf_error("ext4", "\pdfendthread ended up in hlist");
+pdf_save_pos_node:
+    @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+special_node:
+    pdf_special(p);
+othercases if subtype(p)<>dir_node then out_what(p)
+else @<(PDF) Output a reflection instruction if the direction has changed@>;
+endcases
+
+@ @<Output a Image node in a hlist@>=
+begin
+  cur_v:=base_line+pdf_depth(p);
+  out_image(pdf_ximage_ref(p), cur_h-pdf_origin_h, pdf_origin_v-cur_v);
+  if pdf_lookup_list(pdf_ximage_list, image_objnum(pdf_ximage_ref(p))) = null then
+      pdf_append_list(image_objnum(pdf_ximage_ref(p)))(pdf_ximage_list);
+  edge:=cur_h+pdf_width(p); cur_h:=edge; cur_v:=base_line;
+end
+
+@ @<Output a Form node in a hlist@>=
+begin
+  cur_v:=base_line;
+  out_form(p);
+  edge:=cur_h+pdf_width(p); cur_h:=edge;
+end
+
+@* \[53a] The extended features of \eTeX.
+The program has two modes of operation:  (1)~In \TeX\ compatibility mode
+it fully deserves the name \TeX\ and there are neither extended features
+nor additional primitive commands.  There are, however, a few
+modifications that would be legitimate in any implementation of \TeX\
+such as, e.g., preventing inadequate results of the glue to \.{DVI}
+unit conversion during |ship_out|.  (2)~In extended mode there are
+additional primitive commands and the extended features of \eTeX\ are
+available.
+
+The distinction between these two modes of operation initially takes
+place when a `virgin' \.{eINITEX} starts without reading a format file.
+Later on the values of all \eTeX\ state variables are inherited when
+\.{eVIRTEX} (or \.{eINITEX}) reads a format file.
+
+The code below is designed to work for cases where `$|init|\ldots|tini|$'
+is a run-time switch.
+
+@<Enable \eTeX, if requested@>=
+@!init if format_ident=" (INITEX)" then
+  begin no_new_control_sequence:=false;
+  @<Generate all \eTeX\ primitives@>@;
+  if buffer[loc]="*" then incr(loc); 
+  end;
+tini@;@/
+if not no_new_control_sequence then {just entered extended mode ?}
+  no_new_control_sequence:=true@+else
+
+@ The \eTeX\ features available in extended mode are grouped into two
+categories:  (1)~Some of them are permanently enabled and have no
+semantic effect as long as none of the additional primitives are
+executed.  (2)~The remaining \eTeX\ features are optional and can be
+individually enabled and disabled.  For each optional feature there is
+an \eTeX\ state variable named \.{\\...state}; the feature is enabled,
+resp.\ disabled by assigning a positive, resp.\ non-positive value to
+that integer.
+
+
+@d Aleph_version_code=Aleph_int {code for \.{\\Alephversion}}
+@d Omega_version_code=Aleph_int+1 {code for \.{\\Omegaversion}}
+@d Aleph_minor_version_code=Aleph_int+2 {code for \.{\\Alephminorversion}}
+@d Omega_minor_version_code=Aleph_int+3 {code for \.{\\Omegaminorversion}}
+@d eTeX_minor_version_code=Aleph_int+4 {code for \.{\\eTeXminorversion}}
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+@d Aleph_revision_code=job_name_code+1 {command code for \.{\\Alephrevision}}
+@d Omega_revision_code=job_name_code+2 {command code for \.{\\Omegarevision}}
+@d eTeX_revision_code=job_name_code+3 {command code for \.{\\eTeXrevision}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("Alephversion",last_item,Aleph_version_code);
+@!@:eTeX_version_}{\.{\\Alephversion} primitive@>
+primitive("Omegaversion",last_item,Omega_version_code);
+@!@:eTeX_version_}{\.{\\Omegaversion} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("Alephminorversion",last_item,Aleph_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\Alephminorversion} primitive@>
+primitive("Omegaminorversion",last_item,Omega_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\Omegaminorversion} primitive@>
+primitive("eTeXminorversion",last_item,eTeX_minor_version_code);
+@!@:eTeX_minor_version_}{\.{\\eTeXminorversion} primitive@>
+primitive("Alephrevision",convert,Aleph_revision_code);@/
+@!@:eTeX_revision_}{\.{\\Alephrevision} primitive@>
+primitive("Omegarevision",convert,Omega_revision_code);@/
+@!@:eTeX_revision_}{\.{\\Omegarevision} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+Aleph_version_code: print_esc("Alephversion");
+Omega_version_code: print_esc("Omegaversion");
+eTeX_version_code: print_esc("eTeXversion");
+Aleph_minor_version_code: print_esc("Alephminorversion");
+Omega_minor_version_code: print_esc("Omegaminorversion");
+eTeX_minor_version_code: print_esc("eTeXminorversion");
+
+
+@ @<Cases for fetching an integer value@>=
+Aleph_version_code: cur_val:=Aleph_version;
+Omega_version_code: cur_val:=Omega_version;
+eTeX_version_code: cur_val:=eTeX_version;
+Aleph_minor_version_code: cur_val:=Aleph_minor_version;
+Omega_minor_version_code: cur_val:=Omega_minor_version;
+eTeX_minor_version_code: cur_val:=eTeX_minor_version;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+Aleph_revision_code: print_esc("Alephrevision");
+Omega_revision_code: print_esc("Omegarevision");
+eTeX_revision_code: print_esc("eTeXrevision");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+Aleph_revision_code: do_nothing;
+Omega_revision_code: do_nothing;
+eTeX_revision_code: do_nothing;
+
+@ @<Cases of `Print the result of command |c|'@>=
+Aleph_revision_code: print(Aleph_revision);
+Omega_revision_code: print(Omega_revision);
+eTeX_revision_code: print(eTeX_revision);
+
+@ First we implement the additional \eTeX\ parameters in the table of
+equivalents.
+
+@<Generate all \eTeX...@>=
+primitive("everyeof",assign_toks,every_eof_loc);
+@!@:every_eof_}{\.{\\everyeof} primitive@>
+primitive("tracingassigns",assign_int,int_base+tracing_assigns_code);@/
+@!@:tracing_assigns_}{\.{\\tracingassigns} primitive@>
+primitive("tracinggroups",assign_int,int_base+tracing_groups_code);@/
+@!@:tracing_groups_}{\.{\\tracinggroups} primitive@>
+primitive("tracingifs",assign_int,int_base+tracing_ifs_code);@/
+@!@:tracing_ifs_}{\.{\\tracingifs} primitive@>
+primitive("tracingscantokens",assign_int,int_base+tracing_scan_tokens_code);@/
+@!@:tracing_scan_tokens_}{\.{\\tracingscantokens} primitive@>
+primitive("tracingnesting",assign_int,int_base+tracing_nesting_code);@/
+@!@:tracing_nesting_}{\.{\\tracingnesting} primitive@>
+primitive("predisplaydirection",
+  assign_int,int_base+pre_display_direction_code);@/
+@!@:pre_display_direction_}{\.{\\predisplaydirection} primitive@>
+primitive("lastlinefit",assign_int,int_base+last_line_fit_code);@/
+@!@:last_line_fit_}{\.{\\lastlinefit} primitive@>
+primitive("savingvdiscards",assign_int,int_base+saving_vdiscards_code);@/
+@!@:saving_vdiscards_}{\.{\\savingvdiscards} primitive@>
+primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
+@!@:saving_hyph_codes_}{\.{\\savinghyphcodes} primitive@>
+primitive("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code);@/
+@!@:suppress_fontnotfound_error_codes_}{\.{\\suppressfontnotfounderror} primitive@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+
+@ @<Cases for |print_param|@>=
+tracing_assigns_code:print_esc("tracingassigns");
+tracing_groups_code:print_esc("tracinggroups");
+tracing_ifs_code:print_esc("tracingifs");
+tracing_scan_tokens_code:print_esc("tracingscantokens");
+tracing_nesting_code:print_esc("tracingnesting");
+pre_display_direction_code:print_esc("predisplaydirection");
+last_line_fit_code:print_esc("lastlinefit");
+saving_vdiscards_code:print_esc("savingvdiscards");
+saving_hyph_codes_code:print_esc("savinghyphcodes");
+suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror");
+
+@ In order to handle \.{\\everyeof} we need an array |eof_seen| of
+boolean variables.
+
+@<Glob...@>=
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+
+@ The |print_group| procedure prints the current level of grouping and
+the name corresponding to |cur_group|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure print_group(@!e:boolean);
+label exit;
+begin case cur_group of
+  bottom_level: begin print("bottom level"); return;
+    end;
+  simple_group,semi_simple_group:
+    begin if cur_group=semi_simple_group then print("semi ");
+    print("simple");
+    end;
+  hbox_group,adjusted_hbox_group:
+    begin if cur_group=adjusted_hbox_group then print("adjusted ");
+    print("hbox");
+    end;
+  vbox_group: print("vbox");
+  vtop_group: print("vtop");
+  align_group,no_align_group:
+    begin if cur_group=no_align_group then print("no ");
+    print("align");
+    end;
+  output_group: print("output");
+  disc_group: print("disc");
+  insert_group: print("insert");
+  vcenter_group: print("vcenter");
+  math_group,math_choice_group,math_shift_group,math_left_group:
+    begin print("math");
+    if cur_group=math_choice_group then print(" choice")
+    else if cur_group=math_shift_group then print(" shift")
+    else if cur_group=math_left_group then print(" left");
+    end;
+  end; {there are no other cases}
+print(" group (level "); print_int(qo(cur_level)); print_char(")");
+if saved(-1)<>0 then
+  begin if e then print(" entered at line ") else print(" at line ");
+  print_int(saved(-1));
+  end;
+exit:end;
+
+@ The |group_trace| procedure is called when a new level of grouping
+begins (|e=false|) or ends (|e=true|) with |saved(-1)| containing the
+line number.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure group_trace(@!e:boolean);
+begin begin_diagnostic; print_char("{");
+if e then print("leaving ") else print("entering ");
+print_group(e); print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ The \.{\\currentgrouplevel} and \.{\\currentgrouptype} commands return
+the current level of grouping and the type of the current group
+respectively.
+
+@d current_group_level_code=eTeX_int+1 {code for \.{\\currentgrouplevel}}
+@d current_group_type_code=eTeX_int+2 {code for \.{\\currentgrouptype}}
+
+@<Generate all \eTeX...@>=
+primitive("currentgrouplevel",last_item,current_group_level_code);
+@!@:current_group_level_}{\.{\\currentgrouplevel} primitive@>
+primitive("currentgrouptype",last_item,current_group_type_code);
+@!@:current_group_type_}{\.{\\currentgrouptype} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_group_level_code: print_esc("currentgrouplevel");
+current_group_type_code: print_esc("currentgrouptype");
+
+@ @<Cases for fetching an integer value@>=
+current_group_level_code: cur_val:=cur_level-level_one;
+current_group_type_code: cur_val:=cur_group;
+
+@ The \.{\\currentiflevel}, \.{\\currentiftype}, and
+\.{\\currentifbranch} commands return the current level of conditionals
+and the type and branch of the current conditional.
+
+@d current_if_level_code=eTeX_int+3 {code for \.{\\currentiflevel}}
+@d current_if_type_code=eTeX_int+4 {code for \.{\\currentiftype}}
+@d current_if_branch_code=eTeX_int+5 {code for \.{\\currentifbranch}}
+
+@<Generate all \eTeX...@>=
+primitive("currentiflevel",last_item,current_if_level_code);
+@!@:current_if_level_}{\.{\\currentiflevel} primitive@>
+primitive("currentiftype",last_item,current_if_type_code);
+@!@:current_if_type_}{\.{\\currentiftype} primitive@>
+primitive("currentifbranch",last_item,current_if_branch_code);
+@!@:current_if_branch_}{\.{\\currentifbranch} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+current_if_level_code: print_esc("currentiflevel");
+current_if_type_code: print_esc("currentiftype");
+current_if_branch_code: print_esc("currentifbranch");
+
+@ @<Cases for fetching an integer value@>=
+current_if_level_code: begin q:=cond_ptr; cur_val:=0;
+  while q<>null do
+    begin incr(cur_val); q:=vlink(q);
+    end;
+  end;
+current_if_type_code: if cond_ptr=null then cur_val:=0
+  else if cur_if<unless_code then cur_val:=cur_if+1
+  else cur_val:=-(cur_if-unless_code+1);
+current_if_branch_code:
+  if (if_limit=or_code)or(if_limit=else_code) then cur_val:=1
+  else if if_limit=fi_code then cur_val:=-1
+  else cur_val:=0;
+
+@ The \.{\\fontcharwd}, \.{\\fontcharht}, \.{\\fontchardp}, and
+\.{\\fontcharic} commands return information about a character in a
+font.
+
+@d font_char_wd_code=eTeX_dim {code for \.{\\fontcharwd}}
+@d font_char_ht_code=eTeX_dim+1 {code for \.{\\fontcharht}}
+@d font_char_dp_code=eTeX_dim+2 {code for \.{\\fontchardp}}
+@d font_char_ic_code=eTeX_dim+3 {code for \.{\\fontcharic}}
+
+@<Generate all \eTeX...@>=
+primitive("charwd",last_item,font_char_wd_code);
+primitive("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("charht",last_item,font_char_ht_code);
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("chardp",last_item,font_char_dp_code);
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+primitive("charic",last_item,font_char_ic_code);
+primitive("fontcharic",last_item,font_char_ic_code);
+@!@:font_char_ic_}{\.{\\fontcharic} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+font_char_wd_code: print_esc("fontcharwd");
+font_char_ht_code: print_esc("fontcharht");
+font_char_dp_code: print_esc("fontchardp");
+font_char_ic_code: print_esc("fontcharic");
+
+@ @<Cases for fetching a dimension value@>=
+font_char_wd_code,
+font_char_ht_code,
+font_char_dp_code,
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
+  if char_exists(q,cur_val) then
+    begin
+    case m of
+    font_char_wd_code: cur_val:=char_width(q,cur_val);
+    font_char_ht_code: cur_val:=char_height(q,cur_val);
+    font_char_dp_code: cur_val:=char_depth(q,cur_val);
+    font_char_ic_code: cur_val:=char_italic(q,cur_val);
+    end; {there are no other cases}
+    end
+  else cur_val:=0;
+  end;
+
+@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
+commands return the indent and length parameters of the current
+\.{\\parshape} specification.
+
+@d par_shape_length_code=eTeX_dim+4 {code for \.{\\parshapelength}}
+@d par_shape_indent_code=eTeX_dim+5 {code for \.{\\parshapeindent}}
+@d par_shape_dimen_code=eTeX_dim+6 {code for \.{\\parshapedimen}}
+
+@<Generate all \eTeX...@>=
+primitive("parshapelength",last_item,par_shape_length_code);
+@!@:par_shape_length_}{\.{\\parshapelength} primitive@>
+primitive("parshapeindent",last_item,par_shape_indent_code);
+@!@:par_shape_indent_}{\.{\\parshapeindent} primitive@>
+primitive("parshapedimen",last_item,par_shape_dimen_code);
+@!@:par_shape_dimen_}{\.{\\parshapedimen} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+par_shape_length_code: print_esc("parshapelength");
+par_shape_indent_code: print_esc("parshapeindent");
+par_shape_dimen_code: print_esc("parshapedimen");
+
+@ @<Cases for fetching a dimension value@>=
+par_shape_length_code,
+par_shape_indent_code,
+par_shape_dimen_code: begin q:=cur_chr-par_shape_length_code; scan_int;
+  if (par_shape_ptr=null)or(cur_val<=0) then cur_val:=0
+  else  begin if q=2 then
+      begin q:=cur_val mod 2; cur_val:=(cur_val+q)div 2;
+      end;
+    if cur_val>vinfo(par_shape_ptr) then cur_val:=vinfo(par_shape_ptr);
+    cur_val:=vmem(par_shape_ptr+2*cur_val-q).sc;
+    end;
+  cur_val_level:=dimen_val;
+  end;
+
+@ The \.{\\showgroups} command displays all currently active grouping
+levels.
+
+@d show_groups=4 { \.{\\showgroups} }
+
+@<Generate all \eTeX...@>=
+primitive("showgroups",xray,show_groups);
+@!@:show_groups_}{\.{\\showgroups} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_groups:print_esc("showgroups");
+
+@ @<Cases for |show_whatever|@>=
+show_groups: begin begin_diagnostic; show_save_groups;
+  end;
+
+@ @<Types...@>=
+@!save_pointer=0..save_size; {index into |save_stack|}
+
+@ The modifications of \TeX\ required for the display produced by the
+|show_save_groups| procedure were first discussed by Donald~E. Knuth in
+{\sl TUGboat\/} {\bf 11}, 165--170 and 499--511, 1990.
+@^Knuth, Donald Ervin@>
+
+In order to understand a group type we also have to know its mode.
+Since unrestricted horizontal modes are not associated with grouping,
+they are skipped when traversing the semantic nest.
+
+@<Declare \eTeX\ procedures for use...@>=
+procedure show_save_groups;
+label found1,found2,found,done;
+var p:0..nest_size; {index into |nest|}
+@!m:-mmode..mmode; {mode}
+@!v:save_pointer; {saved value of |save_ptr|}
+@!l:quarterword; {saved value of |cur_level|}
+@!c:group_code; {saved value of |cur_group|}
+@!a:-1..1; {to keep track of alignments}
+@!i:integer;
+@!j:quarterword;
+@!s:str_number;
+begin p:=nest_ptr; nest[p]:=cur_list; {put the top level into the array}
+v:=save_ptr; l:=cur_level; c:=cur_group;
+save_ptr:=cur_boundary; decr(cur_level);@/
+a:=1; s:="";
+print_nl(""); print_ln;
+loop@+begin print_nl("### "); print_group(true);
+  if cur_group=bottom_level then goto done;
+  repeat m:=nest[p].mode_field;
+  if p>0 then decr(p) else m:=vmode;
+  until m<>hmode;
+  print(" (");
+  case cur_group of
+    simple_group: begin incr(p); goto found2;
+      end;
+    hbox_group,adjusted_hbox_group: s:="hbox";
+    vbox_group: s:="vbox";
+    vtop_group: s:="vtop";
+    align_group: if a=0 then
+        begin if m=-vmode then s:="halign" else s:="valign";
+        a:=1; goto found1;
+        end
+      else  begin if a=1 then print("align entry") else print_esc("cr");
+        if p>=a then p:=p-a;
+        a:=0; goto found;
+        end;
+    no_align_group:
+      begin incr(p); a:=-1; print_esc("noalign"); goto found2;
+      end;
+    output_group:
+      begin print_esc("output"); goto found;
+      end;
+    math_group: goto found2;
+    disc_group,math_choice_group:
+      begin if cur_group=disc_group then print_esc("discretionary")
+      else print_esc("mathchoice");
+      for i:=1 to 3 do if i<=saved(-2) then print("{}");
+      goto found2;
+      end;
+    insert_group:
+      begin if saved(-2)=255 then print_esc("vadjust")
+      else  begin print_esc("insert"); print_int(saved(-2));
+        end;
+      goto found2;
+      end;
+    vcenter_group: begin s:="vcenter"; goto found1;
+      end;
+    semi_simple_group: begin incr(p); print_esc("begingroup"); goto found;
+      end;
+    math_shift_group:
+      begin if m=mmode then print_char("$")
+      else if nest[p].mode_field=mmode then
+        begin print_cmd_chr(eq_no,saved(-2)); goto found;
+        end;
+      print_char("$"); goto found;
+      end;
+    math_left_group:
+      begin if type(nest[p+1].eTeX_aux_field)=left_noad then print_esc("left")
+      else print_esc("middle");
+      goto found;
+      end;
+    end; {there are no other cases}
+  @<Show the box context@>;
+  found1: print_esc(s); @<Show the box packaging info@>;
+  found2: print_char("{");
+  found: print_char(")"); decr(cur_level);
+  cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+  end;
+done: save_ptr:=v; cur_level:=l; cur_group:=c;
+end;
+
+@ @<Show the box packaging info@>=
+if saved(-2)<>0 then
+  begin print_char(" ");
+  if saved(-3)=exactly then print("to") else print("spread");
+  print_scaled(saved(-2)); print("pt");
+  end
+
+@ @<Show the box context@>=
+i:=saved(-4);
+if i<>0 then
+  if i<box_flag then
+    begin if abs(nest[p].mode_field)=vmode then j:=hmove else j:=vmove;
+    if i>0 then print_cmd_chr(j,0) else print_cmd_chr(j,1);
+    print_scaled(abs(i)); print("pt");
+    end
+  else if i<ship_out_flag then
+    begin if i>=global_box_flag then
+      begin print_esc("global"); i:=i-(global_box_flag-box_flag);
+      end;
+    print_esc("setbox"); print_int(i-box_flag); print_char("=");
+    end
+  else print_cmd_chr(leader_ship,i-(leader_flag-a_leaders))
+
+@ The |scan_general_text| procedure is much like |scan_toks(false,false)|,
+but will be invoked via |expand|, i.e., recursively.
+@^recursion@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_general_text; forward;@t\2@>
+
+@ The token list (balanced text) created by |scan_general_text| begins
+at |link(temp_token_head)| and ends at |cur_val|.  (If |cur_val=temp_token_head|,
+the list is empty.)
+
+@<Declare \eTeX\ procedures for tok...@>=
+procedure scan_general_text;
+label found;
+var s:normal..absorbing; {to save |scanner_status|}
+@!w:pointer; {to save |warning_index|}
+@!d:pointer; {to save |def_ref|}
+@!p:pointer; {tail of the token list being built}
+@!q:pointer; {new node being added to the token list via |store_new_token|}
+@!unbalance:halfword; {number of unmatched left braces}
+begin s:=scanner_status; w:=warning_index; d:=def_ref;
+scanner_status:=absorbing; warning_index:=cur_cs;
+p:=get_avail; def_ref:=p; token_ref_count(def_ref):=0; p:=def_ref;
+scan_left_brace; {remove the compulsory left brace}
+unbalance:=1;
+loop@+  begin get_token;
+  if cur_tok<right_brace_limit then
+    if cur_cmd<right_brace then incr(unbalance)
+    else  begin decr(unbalance);
+      if unbalance=0 then goto found;
+      end;
+  store_new_token(cur_tok);
+  end;
+found: q:=link(def_ref); free_avail(def_ref); {discard reference count}
+if q=null then cur_val:=temp_token_head @+ else cur_val:=p;
+link(temp_token_head):=q;
+scanner_status:=s; warning_index:=w; def_ref:=d;
+end;
+
+@ The \.{\\showtokens} command displays a token list.
+
+@d show_tokens=5 { \.{\\showtokens} , must be odd! }
+
+@<Generate all \eTeX...@>=
+primitive("showtokens",xray,show_tokens);
+@!@:show_tokens_}{\.{\\showtokens} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_tokens:print_esc("showtokens");
+
+@ The \.{\\unexpanded} primitive prevents expansion of tokens much as
+the result from \.{\\the} applied to a token variable.  The
+\.{\\detokenize} primitive converts a token list into a list of
+character tokens much as if the token list were written to a file.  We
+use the fact that the command modifiers for \.{\\unexpanded} and
+\.{\\detokenize} are odd whereas those for \.{\\the} and \.{\\showthe}
+are even.
+
+@<Generate all \eTeX...@>=
+primitive("unexpanded",the,1);@/
+@!@:unexpanded_}{\.{\\unexpanded} primitive@>
+primitive("detokenize",the,show_tokens);@/
+@!@:detokenize_}{\.{\\detokenize} primitive@>
+
+@ @<Cases of |the| for |print_cmd_chr|@>=
+else if chr_code=1 then print_esc("unexpanded")
+else print_esc("detokenize")
+
+@ @<Handle \.{\\unexpanded} or \.{\\detokenize} and |return|@>=
+if odd(cur_chr) then
+  begin c:=cur_chr; scan_general_text;
+  if c=1 then the_toks:=cur_val
+  else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+    p:=get_avail; link(p):=link(temp_token_head);
+    token_show(p); flush_list(p);
+    selector:=old_setting; the_toks:=str_toks(b);
+    end;
+  return;
+  end
+
+@ The \.{\\showifs} command displays all currently active conditionals.
+
+@d show_ifs=6 { \.{\\showifs} }
+
+@<Generate all \eTeX...@>=
+primitive("showifs",xray,show_ifs);
+@!@:show_ifs_}{\.{\\showifs} primitive@>
+
+@ @<Cases of |xray| for |print_cmd_chr|@>=
+show_ifs:print_esc("showifs");
+
+@
+@d print_if_line(#)==if #<>0 then
+  begin print(" entered on line "); print_int(#);
+  end
+
+@<Cases for |show_whatever|@>=
+show_ifs: begin begin_diagnostic; print_nl(""); print_ln;
+  if cond_ptr=null then
+    begin print_nl("### "); print("no active conditionals");
+    end
+  else  begin p:=cond_ptr; n:=0;
+    repeat incr(n); p:=vlink(p);@+until p=null;
+    p:=cond_ptr; t:=cur_if; l:=if_line; m:=if_limit;
+    repeat print_nl("### level "); print_int(n); print(": ");
+    print_cmd_chr(if_test,t);
+    if m=fi_code then print_esc("else");
+    print_if_line(l);
+    decr(n); t:=if_limit_subtype(p); l:=if_line_field(p); m:=if_limit_type(p); p:=vlink(p);
+    until p=null;
+    end;
+  end;
+
+@ The \.{\\interactionmode} primitive allows to query and set the
+interaction mode.
+
+@<Generate all \eTeX...@>=
+primitive("interactionmode",set_page_int,2);
+@!@:interaction_mode_}{\.{\\interactionmode} primitive@>
+
+@ @<Cases of |set_page_int| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("interactionmode")
+
+@ @<Cases for `Fetch the |dead_cycles| or the |insert_penalties|'@>=
+else if m=2 then cur_val:=interaction
+
+@ @<Declare \eTeX\ procedures for use...@>=
+procedure@?new_interaction; forward;@t\2@>
+
+@ @<Cases for |alter_integer|@>=
+else if c=2 then
+  begin if (cur_val<batch_mode)or(cur_val>error_stop_mode) then
+    begin print_err("Bad interaction mode");
+@.Bad interaction mode@>
+    help2("Modes are 0=batch, 1=nonstop, 2=scroll, and")@/
+    ("3=errorstop. Proceed, and I'll ignore this case.");
+    int_error(cur_val);
+    end
+  else  begin cur_chr:=cur_val; new_interaction;
+    end;
+  end
+
+@ The |middle| feature of \eTeX\ allows one ore several \.{\\middle}
+delimiters to appear between \.{\\left} and \.{\\right}.
+
+@<Generate all \eTeX...@>=
+primitive("middle",left_right,middle_noad);
+@!@:middle_}{\.{\\middle} primitive@>
+
+@ @<Cases of |left_right| for |print_cmd_chr|@>=
+else if chr_code=middle_noad then print_esc("middle")
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+primitive("scantextokens",input,3);
+@!@:scan_tex_tokens_}{\.{\\scantextokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+else if chr_code=3 then print_esc("scantextokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+else if cur_chr=3 then begin pseudo_start; name := 19; end
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files.  The |pseudo_lines| field of each pseudo file points to
+a linked list of variable size nodes representing lines not yet
+processed: the |subtype| field contains the size of this node, 
+all the following words contain ASCII codes.
+
+@<Glob...@>=
+@!pseudo_files:pointer; {stack of pseudo files}
+
+@ @<Set init...@>=
+pseudo_files:=null;
+
+@ The |pseudo_start| procedure initiates reading from a pseudo file.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?pseudo_start; forward;@t\2@>
+
+@ @<Declare \eTeX\ procedures for tok...@>=
+procedure pseudo_start;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!s:str_number; {string to be converted into a pseudo file}
+@!p:pointer; {for list construction}
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_token_head); selector:=old_setting;
+flush_list(link(temp_token_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+procedure pseudo_from_string;
+var @!s:str_number; {string to be converted into a pseudo file}
+@!p:pointer; {for list construction}
+begin 
+s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+procedure lua_string_start;
+begin 
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+name:=21; luacstring_start(index);
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" ");
+p:=string_to_pseudo(str_start_macro(s),pool_ptr,new_line_char);
+vlink(p):=pseudo_files; pseudo_files:=p
+
+@ @<Initiate input from new pseudo file@>=
+begin_file_reading; {set up |cur_file| and new level of input}
+line:=0; limit:=start; loc:=limit+1; {force line read}
+if tracing_scan_tokens>0 then
+  begin if term_offset>max_print_line-3 then print_ln
+  else if (term_offset>0)or(file_offset>0) then print_char(" ");
+  name:=20; print("( "); incr(open_parens); update_terminal;
+  end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@d pseudo_lines(#)==vlink(#+1)
+
+@<Declare \eTeX\ procedures for tr...@>=
+function pseudo_input: boolean; {inputs the next line or returns |false|}
+var p:pointer; {current line from pseudo file}
+@!sz:integer; {size of node |p|}
+@!w:four_quarters; {four ASCII codes}
+@!r:pointer; {loop index}
+begin last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+p:=pseudo_lines(pseudo_files);
+if p=null then begin pseudo_input:=false; end
+else  begin pseudo_lines(pseudo_files):=vlink(p); sz:=subtype(p);
+  if 4*sz-3>=buf_size-last then
+     check_buffer_overflow(last+4*sz);
+  last:=first;
+  for r:=p+1 to p+sz-1 do
+    begin w:=vmem(r).qqqq;
+    buffer[last]:=w.b0; buffer[last+1]:=w.b1;
+    buffer[last+2]:=w.b2; buffer[last+3]:=w.b3;
+    last:=last+4;
+    end;
+  if last>=max_buf_stack then max_buf_stack:=last+1;
+  while (last>first)and(buffer[last-1]=" ") do decr(last);
+  flush_node(p);
+  pseudo_input:=true;
+  end;
+end;
+
+@ When we are done with a pseudo file we `close' it.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure pseudo_close; {close the top level pseudo file}
+var p,@!q: pointer;
+begin p:=vlink(pseudo_files);
+flush_node(pseudo_files); 
+pseudo_files:=p;
+end;
+
+@ @<Close the pseudo files@>=
+while pseudo_files<>null do pseudo_close; {flush pseudo files}
+
+@ @<Generate all \eTeX...@>=
+primitive("readline",read_to_cs,1);@/
+@!@:read_line_}{\.{\\readline} primitive@>
+
+@ @<Cases of |read| for |print_cmd_chr|@>=
+else print_esc("readline")
+
+@ @<Handle \.{\\readline} and |goto done|@>=
+if j=1 then
+  begin while loc<=limit do {current line not yet finished}
+    begin cur_chr:=buffer[loc]; incr(loc);
+    if cur_chr=" " then cur_tok:=space_token
+    @+else cur_tok:=cur_chr+other_token;
+    store_new_token(cur_tok);
+    end;
+  goto done;
+  end
+
+@ Here we define the additional conditionals of \eTeX\ as well as the
+\.{\\unless} prefix.
+
+@d if_def_code=17 { `\.{\\ifdefined}' }
+@d if_cs_code=18 { `\.{\\ifcsname}' }
+@d if_font_char_code=19 { `\.{\\iffontchar}' }
+@d if_in_csname_code=20 { `\.{\\ifincsname}' }
+@d if_abs_num_code=22 { `\.{\\ifabsnum}' } { 21 = |if_primitive|}
+@d if_abs_dim_code=23 { `\.{\\ifabsdim}' }
+
+@<Generate all \eTeX...@>=
+primitive("unless",expand_after,1);@/
+@!@:unless_}{\.{\\unless} primitive@>
+primitive("ifdefined",if_test,if_def_code);
+@!@:if_defined_}{\.{\\ifdefined} primitive@>
+primitive("ifcsname",if_test,if_cs_code);
+@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
+primitive("iffontchar",if_test,if_font_char_code);
+@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+primitive("ifincsname",if_test,if_in_csname_code);
+@!@:if_in_csname_}{\.{\\ifincsname} primitive@>
+primitive("ifabsnum",if_test,if_abs_num_code);
+@!@:if_abs_num_}{\.{\\ifabsnum} primitive@>
+primitive("ifabsdim",if_test,if_abs_dim_code);
+@!@:if_abs_dim_}{\.{\\ifabsdim} primitive@>
+primitive("ifpdfabsnum",if_test,if_abs_num_code);
+@!@:if_abs_num_}{\.{\\ifpdfabsnum} primitive@>
+primitive("ifpdfabsdim",if_test,if_abs_dim_code);
+@!@:if_abs_dim_}{\.{\\ifpdfabsdim} primitive@>
+
+@ @<Cases of |expandafter| for |print_cmd_chr|@>=
+else print_esc("unless")
+
+@ @<Cases of |if_test| for |print_cmd_chr|@>=
+if_def_code:print_esc("ifdefined");
+if_cs_code:print_esc("ifcsname");
+if_font_char_code:print_esc("iffontchar");
+if_in_csname_code:print_esc("ifincsname");
+if_abs_num_code:print_esc("ifabsnum");
+if_abs_dim_code:print_esc("ifabsdim");
+
+@ The result of a boolean condition is reversed when the conditional is
+preceded by \.{\\unless}.
+
+@<Negate a boolean conditional and |goto reswitch|@>=
+begin get_token;
+if (cur_cmd=if_test)and(cur_chr<>if_case_code) then
+  begin cur_chr:=cur_chr+unless_code; goto reswitch;
+  end;
+print_err("You can't use `"); print_esc("unless"); print("' before `");
+@.You can't use \\unless...@>
+print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+help1("Continue, and I'll forget that it ever happened.");
+back_error;
+end
+
+@ The conditional \.{\\ifdefined} tests if a control sequence is
+defined.
+
+We need to reset |scanner_status|, since \.{\\outer} control sequences
+are allowed, but we might be scanning a macro definition or preamble.
+
+@<Cases for |conditional|@>=
+if_def_code:begin save_scanner_status:=scanner_status;
+  scanner_status:=normal;
+  get_filtered_next; b:=(cur_cmd<>undefined_cs);
+  scanner_status:=save_scanner_status;
+  end;
+
+@ The conditional \.{\\ifcsname} is equivalent to \.{\{\\expandafter}
+\.{\}\\expandafter} \.{\\ifdefined} \.{\\csname}, except that no new
+control sequence will be entered into the hash table (once all tokens
+preceding the mandatory \.{\\endcsname} have been expanded).
+
+@<Cases for |conditional|@>=
+if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+  b:=false;
+  repeat get_x_token;
+  if cur_cs=0 then store_new_token(cur_tok);
+  until cur_cs<>0;
+  if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+  @<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
+  flush_list(n);
+  b:=(eq_type(cur_cs)<>undefined_cs);
+  end;
+
+@ @<Look up the characters of list |n| in the hash table...@>=
+m:=first; p:=link(n);
+while p<>null do
+  begin if m>=max_buf_stack then
+    begin max_buf_stack:=m+4;
+    if max_buf_stack=buf_size then
+      check_buffer_overflow(max_buf_stack);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+    end;
+  s := info(p) mod string_offset;
+  if s <= @"7F then begin
+    buffer[m]:=s; incr(m);
+    end
+  else if s<=@"7FF then begin
+    buffer[m]:=@"C0 + s div @"40; incr(m);
+    buffer[m]:=@"80 + s mod @"40; incr(m);
+    end
+  else if s<=@"FFFF then begin
+    buffer[m]:=@"E0 + s div @"1000; incr(m);
+    buffer[m]:=@"80 + (s mod @"1000) div @"40; incr(m);
+    buffer[m]:=@"80 + (s mod @"1000) mod @"40; incr(m);
+    end 
+  else begin
+    buffer[m]:=@"F0 + s div @"40000;  incr(m);
+    buffer[m]:=@"80 + (s mod @"40000) div @"1000;  incr(m);
+    buffer[m]:=@"80 + ((s mod @"40000) mod @"1000) div @"40;  incr(m);
+    buffer[m]:=@"80 + ((s mod @"40000) mod @"1000) mod @"40;  incr(m);
+    end;
+  p:=link(p); 
+  end;
+if m>first then
+  cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
+else if m=first then cur_cs:=null_cs {the list is empty}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_in_csname_code: b := is_in_csname;
+if_abs_dim_code, if_abs_num_code: begin
+  if this_if=if_abs_num_code then scan_int@+else scan_normal_dimen;
+  n:=cur_val;
+  if n < 0 then negate(n);
+  @<Get the next non-blank non-call...@>;
+  if (cur_tok>=other_token+"<")and(cur_tok<=other_token+">") then
+    r:=cur_tok-other_token
+  else  begin print_err("Missing = inserted for ");
+  @.Missing = inserted@>
+    print_cmd_chr(if_test,this_if);
+    help1("I was expecting to see `<', `=', or `>'. Didn't.");
+    back_error; r:="=";
+    end;
+  if this_if=if_abs_num_code then scan_int@+else scan_normal_dimen;
+  if cur_val < 0 then negate(cur_val);
+  case r of
+  "<": b:=(n<cur_val);
+  "=": b:=(n=cur_val);
+  ">": b:=(n>cur_val);
+  end;
+  end;
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
+  b:=char_exists(n,cur_val);
+  end;
+
+@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
+command for macro definitions.  Such macros are protected against
+expansions when lists of expanded tokens are built, e.g., for \.{\\edef}
+or during \.{\\write}.
+
+@<Generate all \eTeX...@>=
+primitive("protected",prefix,8);
+@!@:protected_}{\.{\\protected} primitive@>
+
+@ @<Cases of |prefix| for |print_cmd_chr|@>=
+else if chr_code=8 then print_esc("protected")
+
+@ The |get_x_or_protected| procedure is like |get_x_token| except that
+protected macros are not expanded.
+
+@<Declare \eTeX\ procedures for sc...@>=
+procedure get_x_or_protected; {sets |cur_cmd|, |cur_chr|, |cur_tok|,
+  and expands non-protected macros}
+label exit;
+begin loop@+begin get_token;
+  if cur_cmd<=max_command then return;
+  if (cur_cmd>=call)and(cur_cmd<end_template) then
+    if info(link(cur_chr))=protected_token then return;
+  expand;
+  end;
+exit:end;
+
+@ A group entered (or a conditional started) in one file may end in a
+different file.  Such slight anomalies, although perfectly legitimate,
+may cause errors that are difficult to locate.  In order to be able to
+give a warning message when such anomalies occur, \eTeX\ uses the
+|grp_stack| and |if_stack| arrays to record the initial |cur_boundary|
+and |cond_ptr| values for each input file.
+
+@<Glob...@>=
+@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
+@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
+
+@ When a group ends that was apparently entered in a different input
+file, the |group_warning| procedure is invoked in order to update the
+|grp_stack|.  If moreover \.{\\tracingnesting} is positive we want to
+give a warning message.  The situation is, however, somewhat complicated
+by two facts:  (1)~There may be |grp_stack| elements without a
+corresponding \.{\\input} file or \.{\\scantokens} pseudo file (e.g.,
+error insertions from the terminal); and (2)~the relevant information is
+recorded in the |name_field| of the |input_stack| only loosely
+synchronized with the |in_open| variable indexing |grp_stack|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure group_warning;
+var i:0..max_in_open; {index into |grp_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+  {store current state}
+i:=in_open; w:=false;
+while (grp_stack[i]=cur_boundary)and(i>0) do
+  begin @<Set variable |w| to indicate if this case should be reported@>;
+  grp_stack[i]:=save_index(save_ptr); decr(i);
+  end;
+if w then
+  begin print_nl("Warning: end of "); print_group(true);
+@.Warning: end of...@>
+  print(" of a different file"); print_ln;
+  if tracing_nesting>1 then show_context;
+  if history=spotless then history:=warning_issued;
+  end;
+end;
+
+@ This code scans the input stack in order to determine the type of the
+current input file.
+
+@<Set variable |w| to...@>=
+if tracing_nesting>0 then
+  begin while (input_stack[base_ptr].state_field=token_list)or@|
+    (input_stack[base_ptr].index_field>i) do decr(base_ptr);
+  if input_stack[base_ptr].name_field>17 then w:=true;
+  end
+
+@ When a conditional ends that was apparently started in a different
+input file, the |if_warning| procedure is invoked in order to update the
+|if_stack|.  If moreover \.{\\tracingnesting} is positive we want to
+give a warning message (with the same complications as above).
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure if_warning;
+var i:0..max_in_open; {index into |if_stack|}
+@!w:boolean; {do we need a warning?}
+begin base_ptr:=input_ptr; input_stack[base_ptr]:=cur_input;
+  {store current state}
+i:=in_open; w:=false;
+while if_stack[i]=cond_ptr do
+  begin @<Set variable |w| to...@>;
+  if_stack[i]:=vlink(cond_ptr); decr(i);
+  end;
+if w then
+  begin print_nl("Warning: end of "); print_cmd_chr(if_test,cur_if);
+@.Warning: end of...@>
+  print_if_line(if_line); print(" of a different file"); print_ln;
+  if tracing_nesting>1 then show_context;
+  if history=spotless then history:=warning_issued;
+  end;
+end;
+
+@ Conversely, the |file_warning| procedure is invoked when a file ends
+and some groups entered or conditionals started while reading from that
+file are still incomplete.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure file_warning;
+var p:pointer; {saved value of |save_ptr| or |cond_ptr|}
+@!l:quarterword; {saved value of |cur_level| or |if_limit|}
+@!c:quarterword; {saved value of |cur_group| or |cur_if|}
+@!i:integer; {saved value of |if_line|}
+begin 
+p:=save_ptr; l:=cur_level; c:=cur_group; save_ptr:=cur_boundary;
+while grp_stack[in_open]<>save_ptr do
+  begin decr(cur_level);
+  print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+  print_group(true); print(" is incomplete");@/
+  cur_group:=save_level(save_ptr); save_ptr:=save_index(save_ptr)
+  end;
+save_ptr:=p; cur_level:=l; cur_group:=c; {restore old values}
+p:=cond_ptr; l:=if_limit; c:=cur_if; i:=if_line;
+while if_stack[in_open]<>cond_ptr do
+  begin print_nl("Warning: end of file when ");
+@.Warning: end of file when...@>
+  print_cmd_chr(if_test,cur_if);
+  if if_limit=fi_code then print_esc("else");
+  print_if_line(if_line); print(" is incomplete");@/
+  if_line:=if_line_field(cond_ptr); cur_if:=if_limit_subtype(cond_ptr);
+  if_limit:=if_limit_type(cond_ptr); cond_ptr:=vlink(cond_ptr);
+  end;
+cond_ptr:=p; if_limit:=l; cur_if:=c; if_line:=i; {restore old values}
+print_ln;
+if tracing_nesting>1 then show_context;
+if history=spotless then history:=warning_issued;
+end;
+
+@ Here are the additional \eTeX\ primitives for expressions.
+
+@<Generate all \eTeX...@>=
+primitive("numexpr",last_item,eTeX_expr-int_val+int_val);
+@!@:num_expr_}{\.{\\numexpr} primitive@>
+primitive("dimexpr",last_item,eTeX_expr-int_val+dimen_val);
+@!@:dim_expr_}{\.{\\dimexpr} primitive@>
+primitive("glueexpr",last_item,eTeX_expr-int_val+glue_val);
+@!@:glue_expr_}{\.{\\glueexpr} primitive@>
+primitive("muexpr",last_item,eTeX_expr-int_val+mu_val);
+@!@:mu_expr_}{\.{\\muexpr} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+eTeX_expr-int_val+int_val: print_esc("numexpr");
+eTeX_expr-int_val+dimen_val: print_esc("dimexpr");
+eTeX_expr-int_val+glue_val: print_esc("glueexpr");
+eTeX_expr-int_val+mu_val: print_esc("muexpr");
+
+@ This code for reducing |cur_val_level| and\slash or negating the
+result is similar to the one for all the other cases of
+|scan_something_internal|, with the difference that |scan_expr| has
+already increased the reference count of a glue specification.
+
+@<Process an expression and |return|@>=
+begin if m<eTeX_mu then
+  begin case m of
+  @/@<Cases for fetching a glue value@>@/
+  end; {there are no other cases}
+  cur_val_level:=glue_val;
+  end
+else if m<eTeX_expr then
+  begin case m of
+  @/@<Cases for fetching a mu value@>@/
+  end; {there are no other cases}
+  cur_val_level:=mu_val;
+  end
+else  begin cur_val_level:=m-eTeX_expr+int_val; scan_expr;
+  end;
+while cur_val_level>level do
+  begin if cur_val_level=glue_val then
+    begin m:=cur_val; cur_val:=width(m); delete_glue_ref(m);
+    end
+  else if cur_val_level=mu_val then mu_error;
+  decr(cur_val_level);
+  end;
+if negative then
+  if cur_val_level>=glue_val then
+    begin m:=cur_val; cur_val:=new_spec(m); delete_glue_ref(m);
+    @<Negate all three glue components of |cur_val|@>;
+    end
+  else negate(cur_val);
+return;
+end
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_expr; forward;@t\2@>
+
+@ The |scan_expr| procedure scans and evaluates an expression.
+
+@<Declare procedures needed for expressions@>=
+@t\4@>@<Declare subprocedures for |scan_expr|@>
+procedure scan_expr; {scans and evaluates an expression}
+label restart, continue, found;
+var a,@!b:boolean; {saved values of |arith_error|}
+@!l:small_number; {type of expression}
+@!r:small_number; {state of expression so far}
+@!s:small_number; {state of term so far}
+@!o:small_number; {next operation or type of next factor}
+@!e:integer; {expression so far}
+@!t:integer; {term so far}
+@!f:integer; {current factor}
+@!n:integer; {numerator of combined multiplication and division}
+@!p:pointer; {top of expression stack}
+@!q:pointer; {for stack manipulations}
+begin l:=cur_val_level; a:=arith_error; b:=false; p:=null;
+@<Scan and evaluate an expression |e| of type |l|@>;
+if b then
+  begin print_err("Arithmetic overflow");
+@.Arithmetic overflow@>
+  help2("I can't evaluate this expression,")@/
+    ("since the result is out of range.");
+  error;
+  if l>=glue_val then
+    begin delete_glue_ref(e); e:=zero_glue; add_glue_ref(e);
+    end
+  else e:=0;
+  end;
+arith_error:=a; cur_val:=e; cur_val_level:=l;
+end;
+
+@ Evaluating an expression is a recursive process:  When the left
+parenthesis of a subexpression is scanned we descend to the next level
+of recursion; the previous level is resumed with the matching right
+parenthesis.
+
+@d expr_none=0 {\.( seen, or \.( $\langle\it expr\rangle$ \.) seen}
+@d expr_add=1 {\.( $\langle\it expr\rangle$ \.+ seen}
+@d expr_sub=2 {\.( $\langle\it expr\rangle$ \.- seen}
+@d expr_mult=3 {$\langle\it term\rangle$ \.* seen}
+@d expr_div=4 {$\langle\it term\rangle$ \./ seen}
+@d expr_scale=5 {$\langle\it term\rangle$ \.*
+  $\langle\it factor\rangle$ \./ seen}
+
+@<Scan and eval...@>=
+restart: r:=expr_none; e:=0; s:=expr_none; t:=0; n:=0;
+continue: if s=expr_none then o:=l@+else o:=int_val;
+@<Scan a factor |f| of type |o| or start a subexpression@>;
+found: @<Scan the next operator and set |o|@>;
+arith_error:=b;
+@<Make sure that |f| is in the proper range@>;
+case s of @<Cases for evaluation of the current term@>@;
+end; {there are no other cases}
+if o>expr_sub then s:=o@+else @<Evaluate the current expression@>;
+b:=arith_error;
+if o<>expr_none then goto continue;
+if p<>null then @<Pop the expression stack and |goto found|@>
+
+@ @<Scan the next op...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"+" then o:=expr_add
+else if cur_tok=other_token+"-" then o:=expr_sub
+else if cur_tok=other_token+"*" then o:=expr_mult
+else if cur_tok=other_token+"/" then o:=expr_div
+else  begin o:=expr_none;
+  if p=null then
+    begin if cur_cmd<>relax then back_input;
+    end
+  else if cur_tok<>other_token+")" then
+    begin print_err("Missing ) inserted for expression");
+@.Missing ) inserted@>
+    help1("I was expecting to see `+', `-', `*', `/', or `)'. Didn't.");
+    back_error;
+    end;
+  end
+
+@ @<Scan a factor...@>=
+@<Get the next non-blank non-call token@>;
+if cur_tok=other_token+"(" then
+  @<Push the expression stack and |goto restart|@>;
+back_input;
+if (o=int_val)or(o=attr_val) then scan_int
+else if o=dimen_val then scan_normal_dimen
+else if o=glue_val then scan_normal_glue
+else scan_mu_glue;
+f:=cur_val
+
+@ @<Declare \eTeX\ procedures for sc...@>=
+procedure@?scan_normal_glue; forward;@t\2@>@/
+procedure@?scan_mu_glue; forward;@t\2@>
+
+@ Here we declare to trivial procedures in order to avoid mutually
+recursive procedures with parameters.
+
+@<Declare procedures needed for expressions@>=
+procedure scan_normal_glue;
+begin scan_glue(glue_val);
+end;
+@#
+procedure scan_mu_glue;
+begin scan_glue(mu_val);
+end;
+
+@ Parenthesized subexpressions can be inside expressions, and this
+nesting has a stack.  Seven local variables represent the top of the
+expression stack:  |p| points to pushed-down entries, if any; |l|
+specifies the type of expression currently beeing evaluated; |e| is the
+expression so far and |r| is the state of its evaluation; |t| is the
+term so far and |s| is the state of its evaluation; finally |n| is the
+numerator for a combined multiplication and division, if any.
+
+@d expr_node=39 { stack entry for subexpressions}
+@d expr_type(#)==type(#+1)
+@d expr_state(#)==subtype(#+1)
+@d expr_e_field(#)==vlink(#+1) {saved expression so far}
+@d expr_t_field(#)==vlink(#+2) {saved term so far}
+@d expr_n_field(#)==vinfo(#+2) {saved numerator}
+
+@<Push the expression...@>=
+begin q:=new_node(expr_node,0); vlink(q):=p; 
+expr_type(q):=l; expr_state(q):=4*s+r;
+expr_e_field(q):=e; expr_t_field(q):=t; expr_n_field(q):=n;
+p:=q; l:=o; goto restart;
+end
+
+@ @<Pop the expression...@>=
+begin f:=e; q:=p;
+e:=expr_e_field(q); t:=expr_t_field(q); n:=expr_n_field(q);
+s:=expr_state(q) div 4; r:=expr_state(q) mod 4;
+l:=expr_type(q); p:=vlink(q); flush_node(q);
+goto found;
+end
+
+@ We want to make sure that each term and (intermediate) result is in
+the proper range.  Integer values must not exceed |infinity|
+($2^{31}-1$) in absolute value, dimensions must not exceed |max_dimen|
+($2^{30}-1$).  We avoid the absolute value of an integer, because this
+might fail for the value $-2^{31}$ using 32-bit arithmetic.
+
+@d num_error(#)== {clear a number or dimension and set |arith_error|}
+  begin arith_error:=true; #:=0;
+  end
+@d glue_error(#)== {clear a glue spec and set |arith_error|}
+  begin arith_error:=true; delete_glue_ref(#); #:=new_spec(zero_glue);
+  end
+
+@<Make sure that |f|...@>=
+if ((l=int_val)or(l=attr_val))or(s>expr_sub) then
+  begin if (f>infinity)or(f<-infinity) then num_error(f);
+  end
+else if l=dimen_val then
+  begin if abs(f)>max_dimen then num_error(f);
+  end
+else  begin if (abs(width(f))>max_dimen)or@|
+   (abs(stretch(f))>max_dimen)or@|
+   (abs(shrink(f))>max_dimen) then glue_error(f);
+  end
+
+@ Applying the factor |f| to the partial term |t| (with the operator
+|s|) is delayed until the next operator |o| has been scanned.  Here we
+handle the first factor of a partial term.  A glue spec has to be copied
+unless the next operator is a right parenthesis; this allows us later on
+to simply modify the glue components.
+
+@d normalize_glue(#)==
+  if stretch(#)=0 then stretch_order(#):=normal;
+  if shrink(#)=0 then shrink_order(#):=normal
+
+@<Cases for evaluation of the current term@>=
+expr_none: if (l>=glue_val)and(o<>expr_none) then
+    begin t:=new_spec(f); delete_glue_ref(f); normalize_glue(t);
+    end
+  else t:=f;
+
+@ When a term |t| has been completed it is copied to, added to, or
+subtracted from the expression |e|.
+
+@d expr_add_sub(#)==add_or_sub(#,r=expr_sub)
+@d expr_a(#)==expr_add_sub(#,max_dimen)
+
+@<Evaluate the current expression@>=
+begin s:=expr_none;
+if r=expr_none then e:=t
+else if (l=int_val)or(l=attr_val) then e:=expr_add_sub(e,t,infinity)
+else if l=dimen_val then e:=expr_a(e,t)
+else @<Compute the sum or difference of two glue specs@>;
+r:=o;
+end
+
+@ The function |add_or_sub(x,y,max_answer,negative)| computes the sum
+(for |negative=false|) or difference (for |negative=true|) of |x| and
+|y|, provided the absolute value of the result does not exceed
+|max_answer|.
+
+@<Declare subprocedures for |scan_expr|@>=
+function add_or_sub(@!x,@!y,@!max_answer:integer;@!negative:boolean):integer;
+var a:integer; {the answer}
+begin if negative then negate(y);
+if x>=0 then
+  if y<=max_answer-x then a:=x+y@+else num_error(a)
+else if y>=-max_answer-x then a:=x+y@+else num_error(a);
+add_or_sub:=a;
+end;
+
+@ We know that |stretch_order(e)>normal| implies |stretch(e)<>0| and
+|shrink_order(e)>normal| implies |shrink(e)<>0|.
+
+@<Compute the sum or diff...@>=
+begin width(e):=expr_a(width(e),width(t));
+if stretch_order(e)=stretch_order(t) then
+  stretch(e):=expr_a(stretch(e),stretch(t))
+else if (stretch_order(e)<stretch_order(t))and(stretch(t)<>0) then
+  begin stretch(e):=stretch(t); stretch_order(e):=stretch_order(t);
+  end;
+if shrink_order(e)=shrink_order(t) then
+  shrink(e):=expr_a(shrink(e),shrink(t))
+else if (shrink_order(e)<shrink_order(t))and(shrink(t)<>0) then
+  begin shrink(e):=shrink(t); shrink_order(e):=shrink_order(t);
+  end;
+delete_glue_ref(t); normalize_glue(e);
+end
+
+@ If a multiplication is followed by a division, the two operations are
+combined into a `scaling' operation.  Otherwise the term |t| is
+multiplied by the factor |f|.
+
+@d expr_m(#)==#:=nx_plus_y(#,f,0)
+
+@<Cases for evaluation of the current term@>=
+expr_mult: if o=expr_div then
+    begin n:=f; o:=expr_scale;
+    end
+  else if (l=int_val)or(l=attr_val) then t:=mult_integers(t,f)
+  else if l=dimen_val then expr_m(t)
+  else  begin expr_m(width(t)); expr_m(stretch(t)); expr_m(shrink(t));
+    end;
+
+@ Here we divide the term |t| by the factor |f|.
+
+@d expr_d(#)==#:=quotient(#,f)
+
+@<Cases for evaluation of the current term@>=
+expr_div: if l<glue_val then expr_d(t)
+  else  begin expr_d(width(t)); expr_d(stretch(t)); expr_d(shrink(t));
+    end;
+
+@ The function |quotient(n,d)| computes the rounded quotient
+$q=\lfloor n/d+{1\over2}\rfloor$, when $n$ and $d$ are positive.
+
+@<Declare subprocedures for |scan_expr|@>=
+function quotient(@!n,@!d:integer):integer;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+begin if d=0 then num_error(a)
+else  begin if d>0 then negative:=false
+  else  begin negate(d); negative:=true;
+    end;
+  if n<0 then
+    begin negate(n); negative:=not negative;
+    end;
+  a:=n div d; n:=n-a*d; d:=n-d; {avoid certain compiler optimizations!}
+  if d+n>=0 then incr(a);
+  if negative then negate(a);
+  end;
+quotient:=a;
+end;
+
+@ Here the term |t| is multiplied by the quotient $n/f$.
+
+@d expr_s(#)==#:=fract(#,n,f,max_dimen)
+
+@<Cases for evaluation of the current term@>=
+expr_scale: if (l=int_val)or(l=attr_val) then t:=fract(t,n,f,infinity)
+  else if l=dimen_val then expr_s(t)
+  else  begin expr_s(width(t)); expr_s(stretch(t)); expr_s(shrink(t));
+    end;
+
+@ Finally, the function |fract(x,n,d,max_answer)| computes the integer
+$q=\lfloor xn/d+{1\over2}\rfloor$, when $x$, $n$, and $d$ are positive
+and the result does not exceed |max_answer|.  We can't use floating
+point arithmetic since the routine must produce identical results in all
+cases; and it would be too dangerous to multiply by~|n| and then divide
+by~|d|, in separate operations, since overflow might well occur.  Hence
+this subroutine simulates double precision arithmetic, somewhat
+analogous to \MF's |make_fraction| and |take_fraction| routines.
+
+@d too_big=88 {go here when the result is too big}
+
+@<Declare subprocedures for |scan_expr|@>=
+function fract(@!x,@!n,@!d,@!max_answer:integer):integer;
+label found, found1, too_big, done;
+var negative:boolean; {should the answer be negated?}
+@!a:integer; {the answer}
+@!f:integer; {a proper fraction}
+@!h:integer; {smallest integer such that |2*h>=d|}
+@!r:integer; {intermediate remainder}
+@!t:integer; {temp variable}
+begin if d=0 then goto too_big;
+a:=0;
+if d>0 then negative:=false
+else  begin negate(d); negative:=true;
+  end;
+if x<0 then
+  begin negate(x); negative:=not negative;
+  end
+else if x=0 then goto done;
+if n<0 then
+  begin negate(n); negative:=not negative;
+  end;
+t:=n div d;
+if t>max_answer div x then goto too_big;
+a:=t*x; n:=n-t*d;
+if n=0 then goto found;
+t:=x div d;
+if t>(max_answer-a) div n then goto too_big;
+a:=a+t*n; x:=x-t*d;
+if x=0 then goto found;
+if x<n then
+  begin t:=x; x:=n; n:=t;
+  end; {now |0<n<=x<d|}
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>@;
+if f>(max_answer-a) then goto too_big;
+a:=a+f;
+found: if negative then negate(a);
+goto done;
+too_big: num_error(a);
+done: fract:=a;
+end;
+
+@ The loop here preserves the following invariant relations
+between |f|, |x|, |n|, and~|r|:
+(i)~$f+\lfloor(xn+(r+d))/d\rfloor=\lfloor x_0n_0/d+{1\over2}\rfloor$;
+(ii)~|-d<=r<0<n<=x<d|, where $x_0$, $n_0$ are the original values of~$x$
+and $n$.
+
+Notice that the computation specifies |(x-d)+x| instead of |(x+x)-d|,
+because the latter could overflow.
+
+@<Compute \(f)$f=\lfloor xn/d+{1\over2}\rfloor$@>=
+f:=0; r:=(d div 2)-d; h:=-r;
+loop@+begin if odd(n) then
+    begin r:=r+x;
+    if r>=0 then
+      begin r:=r-d; incr(f);
+      end;
+    end;
+  n:=n div 2;
+  if n=0 then goto found1;
+  if x<h then x:=x+x
+  else  begin t:=x-d; x:=t+x; f:=f+n;
+      if x<n then
+        begin if x=0 then goto found1;
+        t:=x; x:=n; n:=t;
+        end;
+    end;
+  end;
+found1:
+
+@ The \.{\\gluestretch}, \.{\\glueshrink}, \.{\\gluestretchorder}, and
+\.{\\glueshrinkorder} commands return the stretch and shrink components
+and their orders of ``infinity'' of a glue specification.
+
+@d glue_stretch_order_code=eTeX_int+6 {code for \.{\\gluestretchorder}}
+@d glue_shrink_order_code=eTeX_int+7 {code for \.{\\glueshrinkorder}}
+@d glue_stretch_code=eTeX_dim+7 {code for \.{\\gluestretch}}
+@d glue_shrink_code=eTeX_dim+8 {code for \.{\\glueshrink}}
+
+@<Generate all \eTeX...@>=
+primitive("gluestretchorder",last_item,glue_stretch_order_code);
+@!@:glue_stretch_order_}{\.{\\gluestretchorder} primitive@>
+primitive("glueshrinkorder",last_item,glue_shrink_order_code);
+@!@:glue_shrink_order_}{\.{\\glueshrinkorder} primitive@>
+primitive("gluestretch",last_item,glue_stretch_code);
+@!@:glue_stretch_}{\.{\\gluestretch} primitive@>
+primitive("glueshrink",last_item,glue_shrink_code);
+@!@:glue_shrink_}{\.{\\glueshrink} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+glue_stretch_order_code: print_esc("gluestretchorder");
+glue_shrink_order_code: print_esc("glueshrinkorder");
+glue_stretch_code: print_esc("gluestretch");
+glue_shrink_code: print_esc("glueshrink");
+
+@ @<Cases for fetching an integer value@>=
+glue_stretch_order_code, glue_shrink_order_code:
+  begin scan_normal_glue; q:=cur_val;
+  if m=glue_stretch_order_code then cur_val:=stretch_order(q)
+  else cur_val:=shrink_order(q);
+  delete_glue_ref(q);
+  end;
+
+@ @<Cases for fetching a dimension value@>=
+glue_stretch_code, glue_shrink_code:
+  begin scan_normal_glue; q:=cur_val;
+  if m=glue_stretch_code then cur_val:=stretch(q)
+  else cur_val:=shrink(q);
+  delete_glue_ref(q);
+  end;
+
+@ The \.{\\mutoglue} and \.{\\gluetomu} commands convert ``math'' glue
+into normal glue and vice versa; they allow to manipulate math glue with
+\.{\\gluestretch} etc.
+
+@d mu_to_glue_code=eTeX_glue {code for \.{\\mutoglue}}
+@d glue_to_mu_code=eTeX_mu {code for \.{\\gluetomu}}
+
+@<Generate all \eTeX...@>=
+primitive("mutoglue",last_item,mu_to_glue_code);
+@!@:mu_to_glue_}{\.{\\mutoglue} primitive@>
+primitive("gluetomu",last_item,glue_to_mu_code);
+@!@:glue_to_mu_}{\.{\\gluetomu} primitive@>
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+mu_to_glue_code: print_esc("mutoglue");
+glue_to_mu_code: print_esc("gluetomu");
+
+@ @<Cases for fetching a glue value@>=
+mu_to_glue_code: scan_mu_glue;
+
+@ @<Cases for fetching a mu value@>=
+glue_to_mu_code: scan_normal_glue;
+
+@ @<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+
+@ When |saving_vdiscards| is positive then the glue, kern, and penalty
+nodes removed by the page builder or by \.{\\vsplit} from the top of a
+vertical list are saved in special lists instead of being discarded.
+
+@d tail_page_disc==disc_ptr[copy_code] {last item removed by page builder}
+@d page_disc==disc_ptr[last_box_code] {first item removed by page builder}
+@d split_disc==disc_ptr[vsplit_code] {first item removed by \.{\\vsplit}}
+
+@<Glob...@>=
+@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers}
+
+@ @<Set init...@>=
+page_disc:=null; split_disc:=null;
+
+@ The \.{\\pagediscards} and \.{\\splitdiscards} commands share the
+command code |un_vbox| with \.{\\unvbox} and \.{\\unvcopy}, they are
+distinguished by their |chr_code| values |last_box_code| and
+|vsplit_code|.  These |chr_code| values are larger than |box_code| and
+|copy_code|.
+
+@<Generate all \eTeX...@>=
+primitive("pagediscards",un_vbox,last_box_code);@/
+@!@:page_discards_}{\.{\\pagediscards} primitive@>
+primitive("splitdiscards",un_vbox,vsplit_code);@/
+@!@:split_discards_}{\.{\\splitdiscards} primitive@>
+
+@ @<Cases of |un_vbox| for |print_cmd_chr|@>=
+else if chr_code=last_box_code then print_esc("pagediscards")
+else if chr_code=vsplit_code then print_esc("splitdiscards")
+
+@ @<Handle saved items and |goto done|@>=
+begin vlink(tail):=disc_ptr[cur_chr]; disc_ptr[cur_chr]:=null;
+goto done;
+end
+
+@ The \.{\\interlinepenalties}, \.{\\clubpenalties}, \.{\\widowpenalties},
+and \.{\\displaywidowpenalties} commands allow to define arrays of
+penalty values to be used instead of the corresponding single values.
+
+@d inter_line_penalties_ptr==equiv(inter_line_penalties_loc)
+@d club_penalties_ptr==equiv(club_penalties_loc)
+@d widow_penalties_ptr==equiv(widow_penalties_loc)
+@d display_widow_penalties_ptr==equiv(display_widow_penalties_loc)
+
+@<Generate all \eTeX...@>=
+primitive("interlinepenalties",set_shape,inter_line_penalties_loc);@/
+@!@:inter_line_penalties_}{\.{\\interlinepenalties} primitive@>
+primitive("clubpenalties",set_shape,club_penalties_loc);@/
+@!@:club_penalties_}{\.{\\clubpenalties} primitive@>
+primitive("widowpenalties",set_shape,widow_penalties_loc);@/
+@!@:widow_penalties_}{\.{\\widowpenalties} primitive@>
+primitive("displaywidowpenalties",set_shape,display_widow_penalties_loc);@/
+@!@:display_widow_penalties_}{\.{\\displaywidowpenalties} primitive@>
+
+@ @<Cases of |set_shape| for |print_cmd_chr|@>=
+inter_line_penalties_loc: print_esc("interlinepenalties");
+club_penalties_loc: print_esc("clubpenalties");
+widow_penalties_loc: print_esc("widowpenalties");
+display_widow_penalties_loc: print_esc("displaywidowpenalties");
+
+@ @<Fetch a penalties array element@>=
+begin scan_int;
+if (equiv(m)=null)or(cur_val<0) then cur_val:=0
+else  begin if cur_val>penalty(equiv(m)) then cur_val:=penalty(equiv(m));
+  cur_val:=penalty(equiv(m)+cur_val);
+  end;
+end
+
+@ This is needed to get the relative order of the marks code correct
+
+@<Show the meaning of a mark node@>=
+if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+  begin print_char(":"); print_ln;
+  case cur_chr of
+    first_mark_code:       token_show(first_mark(0));
+    bot_mark_code:         token_show(bot_mark(0));
+    split_first_mark_code: token_show(split_first_mark(0));
+    split_bot_mark_code:   token_show(split_bot_mark(0));
+    othercases             token_show(top_mark(0));
+  endcases;
+end
+
+
+@ The lua interface needs some extra pascal functions. The functions
+themselves are quite boring, but they are handy because otherwise this
+internal stuff has to be accessed from C directly, where lots of the
+pascal defines are not available.
+
+@p function get_tex_dimen_register (j:integer):scaled;
+begin
+  get_tex_dimen_register := dimen(j);
+end;
+
+function set_tex_dimen_register (j:integer;v:scaled):integer;
+var a:small_number;
+begin  {return non-nil for error}
+a:=0;
+word_define(j+scaled_base,v);
+set_tex_dimen_register := 0;
+end;
+
+function get_tex_count_register (j:integer):scaled;
+begin
+  get_tex_count_register := count(j);
+end;
+
+function set_tex_count_register (j:integer;v:scaled):integer;
+var a:small_number;
+begin  {return non-nil for error}
+a:=0;
+word_define(j+count_base,v);
+set_tex_count_register := 0;
+end;
+
+function get_tex_attribute_register (j:integer):scaled;
+begin
+  get_tex_attribute_register := attribute(j);
+end;
+
+function set_tex_attribute_register (j:integer;v:scaled):integer;
+var a:small_number;
+begin  {return non-nil for error}
+a:=0;
+word_define(j+attribute_base,v);
+set_tex_attribute_register := 0;
+end;
+
+function get_tex_toks_register (j:integer):str_number;
+var s:str_number;
+begin
+  s:="";
+  if toks(j) <> min_halfword then begin
+	s := tokens_to_string(toks(j));
+  end;
+  get_tex_toks_register := s;
+end;
+
+function set_tex_toks_register (j:integer;s:str_number):integer;
+var s_pool_ptr:pool_pointer;
+  ref:pointer;
+  a:small_number;
+  junk:pointer;
+begin
+  set_tex_toks_register := 0;
+  s_pool_ptr := pool_ptr;
+  pool_ptr := str_start_macro(s+1);
+  ref := get_avail;
+  junk := str_toks(str_start_macro(s));
+  pool_ptr := s_pool_ptr;
+  token_ref_count(ref) := 0;
+  link(ref) := link(temp_token_head);
+  a:=0;
+  define(j+toks_base,call,ref);
+  flush_str(s);
+end;
+
+function get_tex_box_register (j:integer):integer;
+begin
+  get_tex_box_register := box(j);
+end;
+
+function set_tex_box_register (j:integer;v:scaled):integer;
+var a:small_number;
+begin  {return non-nil for error}
+a:=0;
+eq_define(j+box_base,box_ref,v);
+set_tex_box_register := 0;
+end;
+
+
+function get_tex_box_width (j:integer):scaled;
+var q:pointer;
+begin
+ q := box(j);
+ get_tex_box_width := 0;
+ if q <> min_halfword then
+    get_tex_box_width := width(q);
+end;
+
+function set_tex_box_width (j:integer;v:scaled):integer;
+var q:pointer;
+begin
+  q := box(j);
+  set_tex_box_width := 0;
+  if q <> min_halfword then
+    width(q) := v
+  else
+    set_tex_box_width := 1;
+end;
+
+function get_tex_box_height (j:integer):scaled;
+var q:pointer;
+begin
+ q := box(j);
+ get_tex_box_height := 0;
+ if q <> min_halfword then
+    get_tex_box_height := height(q);
+end;
+
+function set_tex_box_height (j:integer;v:scaled):integer;
+var q:pointer;
+begin
+  q := box(j);
+  set_tex_box_height := 0;
+  if q <> min_halfword then
+    height(q) := v
+  else
+    set_tex_box_height := 1;
+end;
+
+function get_tex_box_depth (j:integer):scaled;
+var q:pointer;
+begin
+ q := box(j);
+ get_tex_box_depth := 0;
+ if q <> min_halfword then
+    get_tex_box_depth := depth(q);
+end;
+
+function set_tex_box_depth (j:integer;v:scaled):integer;
+var q:pointer;
+begin
+  q := box(j);
+  set_tex_box_depth := 0;
+  if q <> min_halfword then
+    depth(q) := v
+  else
+    set_tex_box_depth := 1;
+end;
+
+function get_cur_v: integer;
+begin
+    get_cur_v := cur_page_height - cur_v;
+end;
+
+function get_cur_h: integer;
+begin
+    get_cur_h := cur_h;
+end;
+
+@* \[54] $\Omega$ changes.
+
+@ Here we do the main work required for reading and interpreting
+  $\Omega$ Compiled Translation Processes.
+
+@ Here are all the instructions in our mini-assembler.
+@d otp_right_output=1
+@d otp_right_num=2
+@d otp_right_char=3
+@d otp_right_lchar=4
+@d otp_right_some=5
+
+@d otp_pback_output=6
+@d otp_pback_num=7
+@d otp_pback_char=8
+@d otp_pback_lchar=9
+@d otp_pback_some=10
+
+@d otp_add=11
+@d otp_sub=12
+@d otp_mult=13
+@d otp_div=14
+@d otp_mod=15
+@d otp_lookup=16
+@d otp_push_num=17
+@d otp_push_char=18
+@d otp_push_lchar=19
+
+@d otp_state_change=20
+@d otp_state_push=21
+@d otp_state_pop=22
+
+@d otp_left_start=23
+@d otp_left_return=24
+@d otp_left_backup=25
+
+@d otp_goto=26
+@d otp_goto_ne=27
+@d otp_goto_eq=28
+@d otp_goto_lt=29
+@d otp_goto_le=30
+@d otp_goto_gt=31
+@d otp_goto_ge=32
+@d otp_goto_no_advance=33
+@d otp_goto_beg=34
+@d otp_goto_end=35
+
+@d otp_stop=36
+
+@
+@<Glob...@>=
+@!otp_init_input_start:halfword;
+@!otp_init_input_last:halfword;
+@!otp_init_input_end:halfword;
+@!otp_i:halfword;
+@!otp_init_input_buf:array[0..20000] of quarterword;
+
+@!otp_input_start:halfword;
+@!otp_input_last:halfword;
+@!otp_input_end:halfword;
+@!otp_input_buf:array[0..20000] of quarterword;
+
+@!otp_output_end:halfword;
+@!otp_output_buf:array[0..20000] of quarterword;
+
+@!otp_stack_used:halfword;
+@!otp_stack_last:halfword;
+@!otp_stack_new:halfword;
+@!otp_stack_buf:array[0..1000] of quarterword;
+
+@!otp_pc:halfword;
+
+@!otp_calc_ptr:halfword;
+@!otp_calcs:array[0..1000] of halfword;
+@!otp_state_ptr:halfword;
+@!otp_states:array[0..1000] of halfword;
+
+@!otp_input_char:halfword;
+@!otp_calculated_char:halfword;
+@!otp_no_input_chars:halfword;
+
+@!otp_instruction:halfword;
+@!otp_instr:halfword;
+@!otp_arg:halfword;
+@!otp_first_arg:halfword;
+@!otp_second_arg:halfword;
+
+@!otp_input_ocp:halfword;
+@!otp_counter:halfword;
+
+@!otp_finished:boolean;
+@!otp_ext_str:integer;
+@!otp_ext_str_arg:integer;
+@!otp_ext_i:integer;
+
+@
+@<Initialize table...@>=
+
+@
+@<Create a buffer with character |cur_chr| and the following
+  characters (if~any) and then apply the current active OCP filter
+  to this buffer@>=
+begin
+@<Read in the buffer for treatment@>;
+@<Apply the OCP to the input buffer@>;
+@<Place the output buffer back on the stream@>;
+goto big_switch;
+end;
+
+@ The OTP input buffer is an array of 16-bit values. 
+In the future, the range |@"D800| \dots |@"DFFF| will be used for 
+surrogate pairs, so it cannot be used for simple 16-bit values
+like it is in Omega, so a future incompatibility with Aleph is 
+unavoidable.
+
+@<Read in the buffer for treatment@>=
+begin
+otp_init_input_end:=0;
+while (cur_cmd=letter) or (cur_cmd=other_char) or
+      (cur_cmd=char_given) or (cur_cmd=spacer) do begin
+  incr(otp_init_input_end);
+  if otp_init_input_end >ocp_buf_size then
+    overflow_ocp_buf_size;
+  { |cur_chr| can cover the full range |0..0x10FFFF| }
+  if cur_chr<@"10000 then
+    otp_init_input_buf[otp_init_input_end]:=cur_chr
+  else begin
+    otp_init_input_buf[otp_init_input_end]:=((cur_chr - @"10000) div @"400) + @"D800;
+    incr(otp_init_input_end);
+    if otp_init_input_end >ocp_buf_size then
+      overflow_ocp_buf_size;
+    otp_init_input_buf[otp_init_input_end]:=((cur_chr - @"10000) mod @"400) + @"DC00;
+    end;
+  get_token;
+  if (cur_cmd<>letter) and (cur_cmd<>other_char) and
+     (cur_cmd<>char_given) then begin
+    x_token;
+    if (cur_cmd=char_num) then begin
+      scan_char_num; cur_cmd:=other_char; cur_chr:=cur_val;
+      end;
+    end;
+  end;
+back_input;
+otp_input_end:=otp_init_input_end;
+for otp_i:=0 to otp_init_input_end do begin
+  otp_input_buf[otp_i]:=otp_init_input_buf[otp_i];
+  end;
+end
+
+@
+@<Apply the OCP to the input buffer@>=
+begin
+otp_input_ocp:=active_ocp(active_real);
+if otp_input_ocp=0 then begin
+  print_err("Null ocp being used: all input lost");
+  error;
+  otp_output_end:=0;
+  end
+else if ocp_external(otp_input_ocp)=0 then begin
+  otp_input_start:=0;
+  otp_input_last:=0;
+  otp_stack_used:=0;
+  otp_stack_last:=0;
+  otp_stack_new:=0;
+  otp_output_end:=0;
+  otp_pc:=0;
+  otp_finished:=false;
+  otp_calc_ptr:=0;
+  otp_calcs[otp_calc_ptr]:=0;
+  otp_state_ptr:=0;
+  otp_states[otp_state_ptr]:=0;
+  while not otp_finished do
+    @<Run the OTP program@>;
+  end
+else begin
+  k:=0;
+  if nameoffile then libcfree (nameoffile);
+  otp_ext_str:=ocp_external(otp_input_ocp);
+  otp_ext_str_arg:=ocp_external_arg(otp_input_ocp);
+  nameoffile := xmalloc (4 + length(otp_ext_str) + length(otp_ext_str_arg));
+  for otp_ext_i:=str_start_macro(otp_ext_str) to
+         str_start_macro(otp_ext_str)+length(otp_ext_str)-1 do
+    append_to_name(str_pool[otp_ext_i]);
+  append_to_name(" ");
+  for otp_ext_i:=str_start_macro(otp_ext_str_arg) to
+         str_start_macro(otp_ext_str_arg)+length(otp_ext_str_arg)-1 do
+    append_to_name(str_pool[otp_ext_i]);
+  nameoffile[length(otp_ext_str)+length(otp_ext_str_arg)+2]:=0;
+  run_external_ocp(nameoffile);
+  end
+end
+
+@ The OTP output buffer is an array of 16-bit values. To convert back
+to the |buffer| it has to be re-encoded into UTF-8. An incompatibility
+with Aleph is unavoidable here: The range |@"D800| \dots |@"DFFF| is
+used for surrogate pairs, not for simple 16-bit values.
+
+@<Place the output buffer back on the stream@>=
+begin
+if (first+otp_output_end)>=ocp_buf_size then
+  overflow_ocp_buf_size;
+push_input; 
+current_ocp_lstack:=active_lstack_no(active_real);
+current_ocp_no:=active_counter(active_real);
+state:=mid_line;
+start:=first;
+last:=start;
+loc:=start;
+for otp_counter:=1 to otp_output_end do begin
+    { convert back to utf-8 }
+	t := otp_output_buf[otp_counter];
+	if otp_counter < otp_output_end then
+       if ((t>=@"D800) and (t<@"DC00)) then 
+	     if (otp_output_buf[otp_counter+1]>=@"DC00)
+          and (otp_output_buf[otp_counter+1]<@"E000) then begin
+             incr(otp_counter);
+	         t := (t-@"D800) * @"400 + (otp_output_buf[otp_counter]-@"DC00) + @"10000;
+           end
+       else if ((t>=@"DC00) and (t<@"E000)) then 
+	     if (otp_output_buf[otp_counter+1]>=@"D800)
+           and (otp_output_buf[otp_counter+1]<@"DC00) then begin
+             incr(otp_counter);
+	         t := (otp_output_buf[otp_counter]-@"D800) * @"400 + (t-@"DC00) + @"10000;
+           end;
+    if t <= @"7F then
+      buffer[last]:= t
+    else if t<=@"7FF then begin
+      buffer[last]:=@"C0 + t div @"40;
+      incr(last); 
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + t mod @"40;
+      end
+    else if t<=@"FFFF then	begin
+      buffer[last]:=@"E0 + t div @"1000;
+      incr(last);
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + (t mod @"1000) div @"40;
+      incr(last);
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + (t mod @"1000) mod @"40;
+      end
+    else begin
+      buffer[last]:=@"F0 + t div @"40000;
+      incr(last);
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + (t mod @"40000) div @"1000;
+      incr(last);
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + ((t mod @"40000) mod @"1000) div @"40;
+      incr(last);
+      if last=buf_size-2 then
+        @<Report overflow of the input buffer, and abort@>;
+      buffer[last]:=@"80 + ((t mod @"40000) mod @"1000) mod @"40;
+      end;
+    incr(last);
+    if last=buf_size-2 then
+      @<Report overflow of the input buffer, and abort@>;
+  end;
+limit:=last-1;
+if (t>@"FFFF) then decr(limit);
+if (t>@"7FF)  then decr(limit);
+if (t>@"7F)   then decr(limit);
+first:=last;
+end
+
+@
+@d otp_cur_state==otp_states[otp_state_ptr]
+@d otp_set_instruction==begin
+if otp_pc>=ocp_state_no(otp_input_ocp)(otp_cur_state) then begin
+  print_err("bad OCP program -- PC not valid");
+  succumb;
+  end;
+otp_instruction:=ocp_state_entry(otp_input_ocp)(otp_cur_state)(otp_pc);
+otp_instr:=otp_instruction div @"1000000;
+otp_arg:=otp_instruction mod @"1000000;
+end
+
+@<Run the OTP program@>=
+begin
+otp_set_instruction;
+case otp_instr of
+  @<Run the |otp_right| instructions@>;
+  @<Run the |otp_pback| instructions@>;
+  @<Run the arithmetic instructions@>;
+  @<Run the |otp_state| instructions@>;
+  @<Run the |otp_left| instructions@>;
+  @<Run the |otp_goto| instructions@>;
+  @<Run the |otp_stop| instruction@>;
+  othercases begin
+    print_err("bad OCP program -- unknown instruction");
+    succumb;
+    end
+  endcases;
+end
+
+@
+
+@d otp_check_char(#)==
+if (1>#) or (#>otp_no_input_chars) then begin
+  print_err("right hand side of OCP expression is bad");
+  succumb;
+  end
+
+@d otp_get_char(#)==begin
+otp_check_char(#);
+if #>otp_stack_last then begin
+  otp_calculated_char:=otp_input_buf[otp_input_start+#-otp_stack_last];
+  end
+else begin
+  otp_calculated_char:=otp_stack_buf[#];
+  end;
+end
+
+@<Run the |otp_right| instructions@>=
+  otp_right_output: begin
+    incr(otp_output_end);
+    if otp_output_end >ocp_buf_size then
+      overflow_ocp_buf_size;
+    otp_output_buf[otp_output_end]:=otp_calcs[otp_calc_ptr];
+    decr(otp_calc_ptr);
+    incr(otp_pc);
+    end;
+  otp_right_num: begin
+    incr(otp_output_end);
+    if otp_output_end >ocp_buf_size then
+      overflow_ocp_buf_size;
+    otp_output_buf[otp_output_end]:=otp_arg;
+    incr(otp_pc);
+    end;
+  otp_right_char: begin
+    otp_get_char(otp_arg);
+    incr(otp_output_end);
+    if otp_output_end >ocp_buf_size then
+      overflow_ocp_buf_size;
+    otp_output_buf[otp_output_end]:=otp_calculated_char;
+    incr(otp_pc);
+    end;
+  otp_right_lchar: begin
+    otp_get_char(otp_no_input_chars-otp_arg);
+    incr(otp_output_end);
+    if otp_output_end >ocp_buf_size then
+      overflow_ocp_buf_size;
+    otp_output_buf[otp_output_end]:=otp_calculated_char;
+    incr(otp_pc);
+    end;
+  otp_right_some: begin
+    otp_first_arg:=otp_arg+1;
+    incr(otp_pc);
+    otp_set_instruction;
+    otp_second_arg:=otp_no_input_chars-otp_arg;
+    for otp_counter:=otp_first_arg to otp_second_arg do begin
+      otp_get_char(otp_counter);
+      incr(otp_output_end);
+      if otp_output_end >ocp_buf_size then
+        overflow_ocp_buf_size;
+      otp_output_buf[otp_output_end]:=otp_calculated_char;
+      end;
+    incr(otp_pc);
+    end
+
+@
+@<Run the |otp_pback| instructions@>=
+  otp_pback_output: begin
+    incr(otp_stack_new);
+    if otp_stack_new >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_stack_buf[otp_stack_new]:=otp_calcs[otp_calc_ptr];
+    decr(otp_calc_ptr);
+    incr(otp_pc);
+    end;
+  otp_pback_num: begin
+    incr(otp_stack_new);
+    if otp_stack_new >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_stack_buf[otp_stack_new]:=otp_arg;
+    incr(otp_pc);
+    end;
+  otp_pback_char: begin
+    otp_get_char(otp_arg);
+    incr(otp_stack_new);
+    if otp_stack_new >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+    incr(otp_pc);
+    end;
+  otp_pback_lchar: begin
+    otp_get_char(otp_no_input_chars-otp_arg);
+    incr(otp_stack_new);
+    if otp_stack_new >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+    incr(otp_pc);
+    end;
+  otp_pback_some: begin
+    otp_first_arg:=otp_arg+1;
+    incr(otp_pc);
+    otp_set_instruction;
+    otp_second_arg:=otp_no_input_chars-otp_arg;
+    for otp_counter:=otp_first_arg to otp_second_arg do begin
+      otp_get_char(otp_counter);
+      incr(otp_stack_new);
+      if otp_stack_new >= ocp_stack_size then
+        overflow_ocp_stack_size;
+      otp_stack_buf[otp_stack_new]:=otp_calculated_char;
+      end;
+    incr(otp_pc);
+    end
+   
+@
+@<Run the arithmetic instructions@>=
+  otp_add: begin
+    otp_calcs[otp_calc_ptr-1] :=
+      otp_calcs[otp_calc_ptr-1] + otp_calcs[otp_calc_ptr];
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_sub: begin
+    otp_calcs[otp_calc_ptr-1] :=
+      otp_calcs[otp_calc_ptr-1] - otp_calcs[otp_calc_ptr];
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_mult: begin
+    otp_calcs[otp_calc_ptr-1] :=
+      otp_calcs[otp_calc_ptr-1] * otp_calcs[otp_calc_ptr];
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_div: begin
+    otp_calcs[otp_calc_ptr-1] :=
+      otp_calcs[otp_calc_ptr-1] div otp_calcs[otp_calc_ptr];
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_mod: begin
+    otp_calcs[otp_calc_ptr-1] :=
+      otp_calcs[otp_calc_ptr-1] mod otp_calcs[otp_calc_ptr];
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_lookup: begin
+    if otp_calcs[otp_calc_ptr]>=
+       ocp_table_no(otp_input_ocp)(otp_calcs[otp_calc_ptr-1]) then begin
+      print_err("bad OCP program -- table index not valid");
+      succumb;
+      end;
+    otp_calcs[otp_calc_ptr-1]:=
+    ocp_table_entry(otp_input_ocp)(otp_calcs[otp_calc_ptr-1])
+                   (otp_calcs[otp_calc_ptr]);
+    incr(otp_pc);
+    decr(otp_calc_ptr);
+    end;
+  otp_push_num: begin
+    incr(otp_calc_ptr);
+    if otp_calc_ptr >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_calcs[otp_calc_ptr]:=otp_arg;
+    incr(otp_pc);
+    end;
+  otp_push_char: begin
+    otp_get_char(otp_arg);
+    incr(otp_calc_ptr);
+    if otp_calc_ptr >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+    incr(otp_pc);
+    end;
+  otp_push_lchar: begin
+    otp_get_char(otp_no_input_chars-otp_arg);
+    incr(otp_calc_ptr);
+    if otp_calc_ptr >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_calcs[otp_calc_ptr]:=otp_calculated_char;
+    incr(otp_pc);
+    end
+   
+@
+@<Run the |otp_state| instructions@>=
+  otp_state_change: begin
+    otp_input_start:=otp_input_last;
+    for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+      otp_stack_buf[otp_counter] := 
+        otp_stack_buf[otp_counter+otp_stack_used];
+      end;
+    otp_stack_new:=otp_stack_new-otp_stack_used;
+    otp_stack_last:=otp_stack_new;
+    otp_stack_used:=0;
+    otp_states[otp_state_ptr]:=otp_arg;
+    otp_pc:=0;
+    end;
+  otp_state_push: begin
+    otp_input_start:=otp_input_last;
+    for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+      otp_stack_buf[otp_counter] := 
+        otp_stack_buf[otp_counter+otp_stack_used];
+      end;
+    otp_stack_new:=otp_stack_new-otp_stack_used;
+    otp_stack_last:=otp_stack_new;
+    otp_stack_used:=0;
+    incr(otp_state_ptr);
+    if otp_state_ptr >= ocp_stack_size then
+      overflow_ocp_stack_size;
+    otp_states[otp_state_ptr]:=otp_arg;
+    otp_pc:=0;
+    end;
+  otp_state_pop: begin
+    otp_input_start:=otp_input_last;
+    for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+      otp_stack_buf[otp_counter] := 
+        otp_stack_buf[otp_counter+otp_stack_used];
+      end;
+    otp_stack_new:=otp_stack_new-otp_stack_used;
+    otp_stack_last:=otp_stack_new;
+    otp_stack_used:=0;
+    if otp_state_ptr>0 then decr(otp_state_ptr);
+    otp_pc:=0;
+    end
+   
+@
+@<Run the |otp_left| instructions@>=
+  otp_left_start: begin
+    otp_input_start:=otp_input_last;
+    otp_input_last:=otp_input_start;
+    otp_stack_used:=0;
+    if (otp_stack_last=0) and (otp_input_last>=otp_input_end) then
+      otp_finished:=true
+    else if (otp_stack_used < otp_stack_last) then begin
+      incr(otp_stack_used); {no overflow problem}
+      otp_input_char:=otp_stack_buf[otp_stack_used];
+      otp_no_input_chars:=1;
+      incr(otp_pc);
+      end
+    else begin
+      incr(otp_input_last); {no overflow problem}
+      otp_input_char:=otp_input_buf[otp_input_last];
+      otp_no_input_chars:=1;
+      incr(otp_pc);
+      end;
+    end;
+  otp_left_return: begin
+    otp_input_last:=otp_input_start;
+    otp_stack_used:=0;
+    if (otp_stack_used < otp_stack_last) then begin
+      incr(otp_stack_used); {no overflow problem}
+      otp_input_char:=otp_stack_buf[otp_stack_used];
+      otp_no_input_chars:=1;
+      incr(otp_pc);
+      end
+    else begin
+      incr(otp_input_last); {no overflow problem}
+      otp_input_char:=otp_input_buf[otp_input_last];
+      otp_no_input_chars:=1;
+      incr(otp_pc);
+      end;
+    end;
+  otp_left_backup: begin
+    if otp_input_start < otp_input_last then begin
+      decr(otp_input_last); otp_input_char:=otp_input_buf[otp_input_last];
+      end
+    else begin
+      decr(otp_stack_used); otp_input_char:=otp_stack_buf[otp_stack_used];
+      end;
+    decr(otp_no_input_chars);
+    incr(otp_pc);
+    end
+   
+@
+@<Run the |otp_goto| instructions@>=
+  otp_goto: begin
+    otp_pc:=otp_arg;
+    end;
+  otp_goto_ne: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char <> otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_eq: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char = otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_lt: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char < otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+   end;
+  otp_goto_le: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char <= otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_gt: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char > otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_ge: begin
+    otp_first_arg:=otp_arg;
+    incr(otp_pc);
+    otp_set_instruction;
+    if otp_input_char >= otp_first_arg then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_no_advance: begin
+    if (otp_stack_used < otp_stack_last) then begin
+      incr(otp_stack_used); {no overflow problem}
+      otp_input_char:=otp_stack_buf[otp_stack_used];
+      incr(otp_no_input_chars); {no overflow problem}
+      incr(otp_pc);
+      end
+    else if otp_input_last>=otp_input_end then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_input_last); {no overflow problem}
+      otp_input_char:=otp_input_buf[otp_input_last];
+      incr(otp_no_input_chars); {no overflow problem}
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_beg: begin
+    if otp_input_last=0 then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end;
+  otp_goto_end: begin
+    if otp_input_last>=otp_input_end then begin
+      otp_pc:=otp_arg;
+      end
+    else begin
+      incr(otp_pc);
+      end;
+    end
+   
+@
+@<Run the |otp_stop| instruction@>=
+  otp_stop: begin
+    otp_input_start:=otp_input_last;
+    for otp_counter:=1 to (otp_stack_new-otp_stack_used) do begin
+      otp_stack_buf[otp_counter] := 
+        otp_stack_buf[otp_counter+otp_stack_used];
+      end;
+    otp_stack_new:=otp_stack_new-otp_stack_used;
+    otp_stack_last:=otp_stack_new;
+    otp_stack_used:=0;
+    otp_pc:=0;
+    end
+   
+@ @<Put each...@>=
+primitive("ocp", def_ocp, 0);
+primitive("externalocp", def_ocp, 1);
+primitive("ocplist", def_ocp_list, 0);
+primitive("pushocplist", push_ocp_list, 0);
+primitive("popocplist", pop_ocp_list, 0);
+primitive("clearocplists", clear_ocp_lists, 0);
+primitive("addbeforeocplist", ocp_list_op, add_before_op);
+primitive("addafterocplist", ocp_list_op, add_after_op);
+primitive("removebeforeocplist", ocp_list_op, remove_before_op);
+primitive("removeafterocplist", ocp_list_op, remove_after_op);
+primitive("ocptracelevel", ocp_trace_level, 0);
+equiv(ocp_trace_level_base):=0;
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_ocp: begin
+  print("select ocp "); 
+  slow_print(ocp_name(chr_code)); 
+  end;
+def_ocp: if cur_chr=0 then print_esc("ocp")
+  else print_esc("externalocp");
+set_ocp_list: print("select ocp list "); 
+def_ocp_list:  print_esc("ocplist");
+push_ocp_list: print_esc("pushocplist");
+pop_ocp_list:  print_esc("popocplist");
+clear_ocp_lists: print_esc("clearocplists");
+ocp_list_op:
+  if chr_code=add_before_op then print_esc("addbeforeocplist")
+  else if chr_code=add_after_op then print_esc("addafterocplist")
+  else if chr_code=remove_before_op then print_esc("removebeforeocplist")
+  else {|chr_code|=|remove_after_op|} print_esc("removeafterocplist");
+ocp_trace_level: print_esc("ocptracelevel");
+
+@ @<Assignments@>=
+set_ocp: begin
+  print_err("To use ocps, use the "); print_esc("pushocplist"); 
+  print(" primitive");print_ln
+  end;
+def_ocp: new_ocp(a);
+set_ocp_list: begin
+  print_err("To use ocp lists, use the "); 
+  print_esc("pushocplist"); print(" primitive");print_ln
+  end;
+def_ocp_list: new_ocp_list(a);
+push_ocp_list: do_push_ocp_list(a);
+pop_ocp_list: do_pop_ocp_list(a);
+clear_ocp_lists: do_clear_ocp_lists(a);
+ocp_list_op: begin
+  print_err("To build ocp lists, use the ");
+  print_esc("ocplist"); print(" primitive"); print_ln
+  end;
+ocp_trace_level: begin scan_optional_equals; scan_int;
+  if cur_val<>0 then cur_val:=1;
+  define(ocp_trace_level_base, data, cur_val);
+  end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp(@!a:small_number);
+label common_ending;
+var u:pointer; {user's ocp identifier}
+@!f:internal_ocp_number; {runs through existing ocps}
+@!t:str_number; {name for the frozen ocp identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+@!flushable_string:str_number; {string not yet referenced}
+@!external_ocp:boolean; {external binary file}
+begin if job_name=0 then open_log_file;
+  {avoid confusing \.{texput} with the ocp name}
+@.texput@>
+if cur_chr=1 then external_ocp:=true
+else external_ocp:=false;
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u=null_cs then t:="OCP"
+else  begin old_setting:=selector; selector:=new_string;
+  print("OCP"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+  str_room(1); t:=make_string;
+  end;
+define(u,set_ocp,null_ocp); scan_optional_equals; scan_file_name;
+@<If this ocp has already been loaded, set |f| to the internal
+  ocp number and |goto common_ending|@>;
+f:=read_ocp_info(u,cur_name,cur_area,cur_ext,external_ocp);
+common_ending: 
+equiv(u):=f; eqtb[ocp_id_base+f] := eqtb[u];
+text(ocp_id_base+f) := t;
+if equiv(ocp_trace_level_base)=1 then begin
+  print_nl(""); print_esc("ocp"); print_esc(t); print("="); print(cur_name);
+  end;
+end;
+
+@ When the user gives a new identifier to a ocp that was previously loaded,
+the new name becomes the ocp identifier of record. OCP names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this ocp has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=ocp_base+1 to ocp_ptr do
+  if str_eq_str(ocp_name(f),cur_name)and str_eq_str(ocp_area(f),cur_area) then
+    begin
+    if cur_name=flushable_string then begin
+      flush_string; cur_name:=ocp_name(f);
+      end;
+    goto common_ending
+    end
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_ocp_list(@!a:small_number);
+var u:pointer; {user's ocp list identifier}
+@!f:internal_ocp_list_number; {runs through existing ocp lists}
+@!t:str_number; {name for the frozen ocp list identifier}
+@!old_setting:0..max_selector; {holds |selector| setting}
+begin if job_name=0 then open_log_file;
+  {avoid confusing \.{texput} with the ocp list name}
+@.texput@>
+get_r_token; u:=cur_cs;
+if u>=hash_base then t:=text(u)
+else if u=null_cs then t:="OCPLIST"
+else  begin old_setting:=selector; selector:=new_string;
+  print("OCPLIST"); print(u-active_base); selector:=old_setting;
+@.OCPx@>
+  str_room(1); t:=make_string;
+  end;
+define(u,set_ocp_list,null_ocp_list); scan_optional_equals; 
+f:=read_ocp_list;
+    equiv(u) := f; eqtb[ocp_list_id_base+f] := eqtb[u];
+    text(ocp_list_id_base+f) := t;
+if equiv(ocp_trace_level_base)=1 then begin
+  print_nl(""); print_esc("ocplist"); print_esc(t); print("=");
+  print_ocp_list(ocp_list_list[f]);
+  end;
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_push_ocp_list(@!a:small_number);
+var ocp_list_no:halfword;
+    old_number:halfword;
+    i:integer;
+begin
+scan_ocp_list_ident; ocp_list_no:=cur_val;
+old_number:=equiv(ocp_active_number_base);
+define(ocp_active_base+old_number, data, ocp_list_no);
+define(ocp_active_number_base, data, (old_number+1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+  print_nl("New active ocp list: {");
+  for i:=old_number downto 0 do begin
+    print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+    print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+    if i<>0 then print(",");
+    end;
+  print("}");
+  end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_pop_ocp_list(@!a:small_number);
+var old_number:halfword;
+    i:integer;
+begin
+old_number:=equiv(ocp_active_number_base);
+if old_number=0 then begin
+  print_err("No active ocp lists to be popped");
+  end
+else
+  define(ocp_active_number_base, data, (old_number-1));
+
+if equiv(ocp_trace_level_base)=1 then begin
+  print_nl("New active ocp list: {");
+  for i:=(old_number-2) downto 0 do begin
+    print_esc(ocp_list_id_text(equiv(ocp_active_base+i)));
+    print("="); print_ocp_list(ocp_list_list[equiv(ocp_active_base+i)]);
+    if i<>0 then print(",");
+    end;
+  print("}");
+  end;
+
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure do_clear_ocp_lists(@!a:small_number);
+begin
+define(ocp_active_number_base, data, 0);
+active_compile;
+define(ocp_active_min_ptr_base, data, active_min_ptr);
+define(ocp_active_max_ptr_base, data, active_max_ptr);
+end;
+
+
+@* \[54] System-dependent changes.
+This section should be replaced, if necessary, by any special
+modifications of the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* \[55] Index.
+Here is where you can find all uses of each identifier in the program,
+with underlined entries pointing to where the identifier was defined.
+If the identifier is only one letter long, however, you get to see only
+the underlined entries. {\sl All references are to section numbers instead of
+page numbers.}
+
+This index also lists error messages and other aspects of the program
+that you might want to look up some day. For example, the entry
+for ``system dependencies'' lists all sections that should receive
+special attention from people who are installing \TeX\ in a new
+operating environment. A list of various things that can't happen appears
+under ``this can't happen''. Approximately 40 sections are listed under
+``inner loop''; these account for about 60\pct! of \TeX's running time,
+exclusive of input and output.
diff --git a/Build/source/texk/web2c/luatexdir/luatexextra.in b/Build/source/texk/web2c/luatexdir/luatexextra.in
new file mode 100644
index 00000000000..ffbd65f3c1c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatexextra.in
@@ -0,0 +1,42 @@
+/*
+Copyright (c) 1996-2004 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+/* luatexextra.in: banner etc. for luaTeX.
+
+   This is included by luaTeX, from ../luatexextra.c
+   (generated from ../lib/texmfmp.c).
+*/
+
+#define BANNER "This is luaTeX, Version 3.141592-LUATEX-VERSION-ETEX-VERSION"
+#define COPYRIGHT_HOLDER "Taco Hoekwater"
+#define AUTHOR NULL
+#define PROGRAM_HELP LUATEXHELP
+#define BUG_ADDRESS "dev-luatex@ntg.nl"
+#define DUMP_VAR TEX_format_default
+#define DUMP_LENGTH_VAR format_default_length
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "luainitex"
+#define VIR_PROGRAM "luavirtex"
+#define TEXMFENGINENAME "luatex"
+
diff --git a/Build/source/texk/web2c/luatexdir/luatexlib.mk b/Build/source/texk/web2c/luatexdir/luatexlib.mk
new file mode 100644
index 00000000000..b1239b203ba
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/luatexlib.mk
@@ -0,0 +1,214 @@
+## luatexlib.mk - Makefile fragment for libraries used by pdf[ex]tex.
+# $Id$
+# Public domain.
+
+# The pdf*tex programs depend on a number of libraries.
+# Include dependencies to get the built if we don't do make
+# from the top-level directory.
+
+Makefile: luatexdir/luatexlib.mk
+
+# libz
+
+ZLIBDIR=../../libs/zlib
+ZLIBSRCDIR=$(srcdir)/$(ZLIBDIR)
+ZLIBDEP = @ZLIBDEP@
+LDZLIB = @LDZLIB@
+
+$(ZLIBDIR)/libz.a: $(ZLIBSRCDIR)
+	cd $(ZLIBDIR) && $(MAKE) $(common_makeargs) libz.a
+
+# libpng
+
+LIBPNGDIR=../../libs/libpng
+LIBPNGSRCDIR=$(srcdir)/$(LIBPNGDIR)
+LIBPNGDEP = @LIBPNGDEP@
+LDLIBPNG = @LDLIBPNG@
+
+$(LIBPNGDIR)/libpng.a: $(LIBPNGSRCDIR)/*.c
+	cd $(LIBPNGDIR) && $(MAKE) $(common_makeargs) libpng.a
+
+
+# libxpdf
+
+LIBXPDFDIR=../../libs/xpdf
+LIBXPDFSRCDIR=$(srcdir)/$(LIBXPDFDIR)
+LIBXPDFDEP = @LIBXPDFDEP@
+LDLIBXPDF = @LDLIBXPDF@
+
+$(LIBXPDFDIR)/fofi/libfofi.a: $(LIBXPDFSRCDIR)/fofi/*.cc \
+	$(LIBXPDFSRCDIR)/fofi/*.h
+	cd $(LIBXPDFDIR)/fofi; $(MAKE) $(common_makeargs) libfofi.a
+$(LIBXPDFDIR)/goo/libGoo.a: $(LIBXPDFSRCDIR)/goo/*.cc \
+	$(LIBXPDFSRCDIR)/goo/*.c $(LIBXPDFSRCDIR)/goo/*.h
+	cd $(LIBXPDFDIR)/goo; $(MAKE) $(common_makeargs) libGoo.a
+$(LIBXPDFDIR)/xpdf/libxpdf.a: $(LIBXPDFSRCDIR)/xpdf/*.cc \
+	$(LIBXPDFSRCDIR)/xpdf/*.h
+	cd $(LIBXPDFDIR)/xpdf; $(MAKE) $(common_makeargs) libxpdf.a
+
+
+# md5
+
+LIBMD5DIR=../../libs/md5
+LIBMD5SRCDIR=$(srcdir)/$(LIBMD5DIR)
+LIBMD5DEP=$(LIBMD5DIR)/md5.o
+
+$(LIBMD5DEP): $(LIBMD5SRCDIR)/md5.c $(LIBMD5SRCDIR)/md5.h
+clean:: md5lib-clean
+md5lib-clean:
+	rm -f $(LIBMD5DEP)
+
+# obsdcompat
+LIBOBSDDIR=../../libs/obsdcompat
+LIBOBSDSRCDIR=$(srcdir)/$(LIBOBSDCOMPATDIR)
+LIBOBSDDEP=@LIBOBSDDEP@
+LDLIBOBSD=@LDLIBOBSD@
+
+$(LIBOBSDDIR)/libopenbsd-compat.a: $(LIBOBSDSRCDIR)/*.c $(LIBOBSDSRCDIR)/*.h
+# common_makeargs = $(MFLAGS) CC='$(CC)' CFLAGS='$(CFLAGS)' LDFLAGS='$(LDFLAGS)' $(XMAKEARGS)
+# CFLAGS setzt libopenbsd-compat selbst, nicht durchreichen!
+	cd $(LIBOBSDDIR); $(MAKE) $(MFLAGS) $(XMAKEARGS) libopenbsd-compat.a
+
+# libpdf itself
+pdflib = luatexdir/libpdf.a
+pdflib_sources = $(srcdir)/luatexdir/*.c $(srcdir)/luatexdir/*.cc \
+	$(srcdir)/luatexdir/*.h
+
+luatexdir/libpdf.a: $(pdflib_sources) luatexdir/luatexextra.h ctangle
+	cd luatexdir && mkdir -p font image lua lang tex && $(MAKE) $(common_makeargs) libpdf.a
+
+# makecpool:
+
+luatexdir/makecpool: luatexdir/makecpool.c
+	cd luatexdir && $(MAKE) $(common_makeargs) makecpool
+
+# lua
+
+LIBLUADIR=../../libs/lua51
+LIBLUASRCDIR=$(srcdir)/$(LIBLUADIR)
+LIBLUADEP=$(LIBLUADIR)/liblua.a
+
+luatarget=posix
+ifeq ($(target),i386-mingw32)
+  ifeq ($(host),i386-linux)
+    luatarget = mingwcross
+  else
+    luatarget = mingw
+  endif
+else
+ifeq ($(target),i386-linux)
+  luatarget = posix
+endif
+endif
+
+
+$(LIBLUADEP):
+	mkdir -p $(LIBLUADIR) && cd $(LIBLUADIR) && cp -f $(LIBLUASRCDIR)/* . && $(MAKE) $(luatarget)
+
+# slnunicode
+SLNUNICODEDIR=../../libs/slnunicode
+SLNUNICODESRCDIR=$(srcdir)/$(SLNUNICODEDIR)
+SLNUNICODEDEP=$(SLNUNICODEDIR)/slnunico.o
+$(SLNUNICODEDEP): $(SLNUNICODEDIR)/slnunico.c $(SLNUNICODEDIR)/slnudata.c
+	mkdir -p $(SLNUNICODEDIR) && cd $(SLNUNICODEDIR) && cp -f $(SLNUNICODESRCDIR)/* . && $(CC) $(CFLAGS) -I$(LIBLUADIR) -o slnunico.o -c slnunico.c
+
+# zziplib
+
+# zziplib is a configuration nightmare, because it is so stubborn
+# about using a pre-installed zlib. configure and make have to
+# be fooled in two different ways. 
+# - configure needs to find
+# the subdirs 'include' and 'lib' in the --with-zlib prefix,
+# and these need to contain the proper headers and libraries.
+# - make needs to find the right headers using an -I via CPPFLAGS, 
+# because the zlib path is relative and can't be found otherwise.
+#
+# final trickyness: configure writes a Makefile in the source
+# directory. it is needed by anything, so I delete it right away
+
+zzipretarget=
+
+ifeq ($(target),i386-mingw32)
+  zzipretarget=--target=$(target) --build=$(target) --host=$(host)
+endif
+
+
+ZZIPLIBDIR=../../libs/zziplib
+ZZIPLIBSRCDIR=$(srcdir)/$(ZZIPLIBDIR)
+ZZIPLIBDEP = $(ZZIPLIBDIR)/zzip/libzzip.a
+
+$(ZZIPLIBDEP): $(ZZIPLIBSRCDIR)
+	mkdir -p $(ZZIPLIBDIR)/zzip && cd $(ZZIPLIBDIR)/zzip && \
+	cp ../$(ZZIPLIBSRCDIR)/zzip/Makefile . && $(MAKE) $(common_makeargs)
+
+# luazip
+
+LUAZIPDIR=../../libs/luazip
+LUAZIPSRCDIR=$(srcdir)/$(LUAZIPDIR)
+LUAZIPDEP=$(LUAZIPDIR)/src/luazip.o
+LUAZIPINC=-I../../lua51 -I../$(ZZIPLIBSRCDIR) -I../$(ZZIPLIBDIR)
+
+$(LUAZIPDEP): $(LUAZIPDIR)/src/luazip.c
+	mkdir -p $(LUAZIPDIR) && cd $(LUAZIPDIR) && cp -R $(LUAZIPSRCDIR)/* . && \
+    cd src && $(CC) $(CFLAGS) $(LUAZIPINC) -g -o luazip.o -c luazip.c
+
+# luafilesystem
+
+LUAFSDIR=../../libs/luafilesystem
+LUAFSSRCDIR=$(srcdir)/$(LUAFSDIR)
+LUAFSDEP=$(LUAFSDIR)/src/lfs.o
+LUAFSINC=-I../../lua51
+
+$(LUAFSDEP): $(LUAFSDIR)/src/lfs.c $(LUAFSDIR)/src/lfs.h
+	mkdir -p $(LUAFSDIR) && cd $(LUAFSDIR) && cp -R $(LUAFSSRCDIR)/* . && \
+    cd src && $(CC) $(CFLAGS) $(LUAFSINC) -g -o lfs.o -c lfs.c
+
+# luapeg
+LUAPEGDIR=../../libs/luapeg
+LUAPEGSRCDIR=$(srcdir)/$(LUAPEGDIR)
+LUAPEGDEP=$(LUAPEGDIR)/lpeg.o
+$(LUAPEGDEP): $(LUAPEGDIR)/lpeg.c
+	mkdir -p $(LUAPEGDIR) && cd $(LUAPEGDIR) && cp -f $(LUAPEGSRCDIR)/* . && $(CC) $(CFLAGS) -I$(LIBLUADIR) -g -o lpeg.o -c lpeg.c
+
+
+# luamd5
+LUAMDVDIR=../../libs/luamd5
+LUAMDVSRCDIR=$(srcdir)/$(LUAMDVDIR)
+LUAMDVDEP=$(LUAMDVDIR)/md5lib.o $(LUAMDVDIR)/md5.o
+$(LUAMDVDEP): $(LUAMDVDIR)/md5lib.c $(LUAMDVDIR)/md5.h $(LUAMDVDIR)/md5.c
+	mkdir -p $(LUAMDVDIR) && cd $(LUAMDVDIR) && cp -f $(LUAMDVSRCDIR)/* . && $(CC) $(CFLAGS) -I$(LIBLUADIR) -g -o md5.o -c md5.c && $(CC) $(CFLAGS) -I$(LIBLUADIR) -g -o md5lib.o -c md5lib.c
+
+.PHONY: always
+
+# luaff
+LUAFFDIR=../../libs/luafontforge
+LUAFFSRCDIR=$(srcdir)/$(LUAFFDIR)
+LUAFFDEP=$(LUAFFDIR)/libff.a
+$(LUAFFDEP): always
+	mkdir -p $(LUAFFDIR) && cp -f $(LUAFFSRCDIR)/Makefile $(LUAFFDIR)
+	mkdir -p $(LUAFFDIR)/fontforge && cp -f $(LUAFFSRCDIR)/fontforge/fontforge/Makefile $(LUAFFDIR)/fontforge
+	mkdir -p $(LUAFFDIR)/Unicode && cp -f $(LUAFFSRCDIR)/fontforge/Unicode/Makefile $(LUAFFDIR)/Unicode
+	cd $(LUAFFDIR) && $(MAKE)
+
+
+# luazlib
+LUAZLIBDIR=../../libs/luazlib
+LUAZLIBSRCDIR=$(srcdir)/$(LUAZLIBDIR)
+LUAZLIBDEP=$(LUAZLIBDIR)/lgzip.o $(LUAZLIBDIR)/lzlib.o
+LUAZLIBINC=-I$(ZLIBSRCDIR) -I$(LIBLUASRCDIR)
+$(LUAZLIBDEP): $(LUAZLIBDIR)/lgzip.c $(LUAZLIBDIR)/lzlib.c
+	mkdir -p $(LUAZLIBDIR) && cd $(LUAZLIBDIR) && cp -f $(LUAZLIBSRCDIR)/* . && $(CC) $(CFLAGS) $(LUAZLIBINC) -g -o lgzip.o -c lgzip.c && $(CC) $(CFLAGS) $(LUAZLIBINC) -g -o lzlib.o -c lzlib.c
+
+
+# Convenience variables.
+
+luatexlibs = $(pdflib) $(LDLIBPNG) $(LDZLIB) $(LDLIBXPDF) $(LIBMD5DEP) $(LDLIBOBSD) \
+             $(LIBLUADEP) $(SLNUNICODEDEP)  $(LUAZIPDEP) $(ZZIPLIBDEP) $(LUAFSDEP) \
+             $(LUAPEGDEP) $(LUAMDVDEP)  $(LUAZLIBDEP) $(LUAFFDEP)
+
+luatexlibsdep = $(pdflib) $(LIBPNGDEP) $(ZLIBDEP) $(LIBXPDFDEP) $(LIBMD5DEP) $(LIBOBSDDEP) \
+                $(LIBLUADEP) $(SLNUNICODEDEP) $(ZZIPLIBDEP) $(LUAZIPDEP)  $(LUAFSDEP) \
+                $(LUAPEGDEP) $(LUAMDVDEP)  $(LUAZLIBDEP) $(LUAFFDEP) $(makecpool)
+
+## end of luatexlib.mk - Makefile fragment for libraries used by pdf[ex]tex.
+
diff --git a/Build/source/texk/web2c/luatexdir/macnames.c b/Build/source/texk/web2c/luatexdir/macnames.c
new file mode 100644
index 00000000000..832e05e052d
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/macnames.c
@@ -0,0 +1,312 @@
+/*
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+const char notdef[] = ".notdef";
+
+const char *mac_glyph_names[] = {
+/* 0x00 */
+    notdef,
+    ".null",
+    "CR",
+    "space",
+    "exclam",
+    "quotedbl",
+    "numbersign",
+    "dollar",
+    "percent",
+    "ampersand",
+    "quotesingle",
+    "parenleft",
+    "parenright",
+    "asterisk",
+    "plus",
+    "comma",
+/* 0x10 */
+    "hyphen",
+    "period",
+    "slash",
+    "zero",
+    "one",
+    "two",
+    "three",
+    "four",
+    "five",
+    "six",
+    "seven",
+    "eight",
+    "nine",
+    "colon",
+    "semicolon",
+    "less",
+/* 0x20 */
+    "equal",
+    "greater",
+    "question",
+    "at",
+    "A",
+    "B",
+    "C",
+    "D",
+    "E",
+    "F",
+    "G",
+    "H",
+    "I",
+    "J",
+    "K",
+    "L",
+/* 0x30 */
+    "M",
+    "N",
+    "O",
+    "P",
+    "Q",
+    "R",
+    "S",
+    "T",
+    "U",
+    "V",
+    "W",
+    "X",
+    "Y",
+    "Z",
+    "bracketleft",
+    "backslash",
+/* 0x40 */
+    "bracketright",
+    "asciicircum",
+    "underscore",
+    "grave",
+    "a",
+    "b",
+    "c",
+    "d",
+    "e",
+    "f",
+    "g",
+    "h",
+    "i",
+    "j",
+    "k",
+    "l",
+/* 0x50 */
+    "m",
+    "n",
+    "o",
+    "p",
+    "q",
+    "r",
+    "s",
+    "t",
+    "u",
+    "v",
+    "w",
+    "x",
+    "y",
+    "z",
+    "braceleft",
+    "bar",
+/* 0x60 */
+    "braceright",
+    "asciitilde",
+    "Adieresis",
+    "Aring",
+    "Ccedilla",
+    "Eacute",
+    "Ntilde",
+    "Odieresis",
+    "Udieresis",
+    "aacute",
+    "agrave",
+    "acircumflex",
+    "adieresis",
+    "atilde",
+    "aring",
+    "ccedilla",
+/* 0x70 */
+    "eacute",
+    "egrave",
+    "ecircumflex",
+    "edieresis",
+    "iacute",
+    "igrave",
+    "icircumflex",
+    "idieresis",
+    "ntilde",
+    "oacute",
+    "ograve",
+    "ocircumflex",
+    "odieresis",
+    "otilde",
+    "uacute",
+    "ugrave",
+/* 0x80 */
+    "ucircumflex",
+    "udieresis",
+    "dagger",
+    "degree",
+    "cent",
+    "sterling",
+    "section",
+    "bullet",
+    "paragraph",
+    "germandbls",
+    "registered",
+    "copyright",
+    "trademark",
+    "acute",
+    "dieresis",
+    "notequal",
+/* 0x90 */
+    "AE",
+    "Oslash",
+    "infinity",
+    "plusminus",
+    "lessequal",
+    "greaterequal",
+    "yen",
+    "mu",
+    "partialdiff",
+    "Sigma",
+    "Pi",
+    "pi",
+    "integral",
+    "ordfeminine",
+    "ordmasculine",
+    "Omega",
+/* 0xa0 */
+    "ae",
+    "oslash",
+    "questiondown",
+    "exclamdown",
+    "logicalnot",
+    "radical",
+    "florin",
+    "approxequal",
+    "Delta",
+    "guillemotleft",
+    "guillemotright",
+    "ellipsis",
+    "nbspace",
+    "Agrave",
+    "Atilde",
+    "Otilde",
+/* 0xb0 */
+    "OE",
+    "oe",
+    "endash",
+    "emdash",
+    "quotedblleft",
+    "quotedblright",
+    "quoteleft",
+    "quoteright",
+    "divide",
+    "lozenge",
+    "ydieresis",
+    "Ydieresis",
+    "fraction",
+    "currency",
+    "guilsinglleft",
+    "guilsinglright",
+/* 0xc0 */
+    "fi",
+    "fl",
+    "daggerdbl",
+    "periodcentered",
+    "quotesinglbase",
+    "quotedblbase",
+    "perthousand",
+    "Acircumflex",
+    "Ecircumflex",
+    "Aacute",
+    "Edieresis",
+    "Egrave",
+    "Iacute",
+    "Icircumflex",
+    "Idieresis",
+    "Igrave",
+/* 0xd0 */
+    "Oacute",
+    "Ocircumflex",
+    "applelogo",
+    "Ograve",
+    "Uacute",
+    "Ucircumflex",
+    "Ugrave",
+    "dotlessi",
+    "circumflex",
+    "tilde",
+    "macron",
+    "breve",
+    "dotaccent",
+    "ring",
+    "cedilla",
+    "hungarumlaut",
+/* 0xe0 */
+    "ogonek",
+    "caron",
+    "Lslash",
+    "lslash",
+    "Scaron",
+    "scaron",
+    "Zcaron",
+    "zcaron",
+    "brokenbar",
+    "Eth",
+    "eth",
+    "Yacute",
+    "yacute",
+    "Thorn",
+    "thorn",
+    "minus",
+/* 0xf0 */
+    "multiply",
+    "onesuperior",
+    "twosuperior",
+    "threesuperior",
+    "onehalf",
+    "onequarter",
+    "threequarters",
+    "franc",
+    "Gbreve",
+    "gbreve",
+    "Idot",
+    "Scedilla",
+    "scedilla",
+    "Cacute",
+    "cacute",
+    "Ccaron",
+/* 0x100 */
+    "ccaron",
+    "dmacron"
+};
+
+const char *ambiguous_names[] = {
+    "Delta",                    /*   increment   */
+    "Omega",                    /*   Ohm         */
+    "Pi",                       /*   product     */
+    "Sigma",                    /*   summation   */
+    "dmacron",                  /*   dslash      */
+    "macron",                   /*   overscore   */
+    "periodcentered",           /*   middot      */
+    NULL
+};
diff --git a/Build/source/texk/web2c/luatexdir/makecpool.c b/Build/source/texk/web2c/luatexdir/makecpool.c
new file mode 100644
index 00000000000..162a4848482
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/makecpool.c
@@ -0,0 +1,60 @@
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+int main(int argc, char *argv[]) {
+  if (argc!=3) {
+	puts("Need exactly two arguments: pool_name and header_name");
+    exit(1);
+  }
+  char *filename = argv[1];
+  char *headername = argv[2];
+  FILE *fh = fopen(filename,"r");
+  char data[1024];
+  printf(
+    "/* This file is auto-generated by makecpool */\n"
+    "\n"
+    "#include <stdio.h>\n"
+    "#include \"%s\"\n"
+    "\n"
+    "static char *poolfilearr[] = {\n",headername);
+  while (fgets(data,1024,fh)) {
+    int len = strlen(data);
+    int o = 0; /* skip first o characters*/
+    int i;
+    if (data[len-1]=='\n') { /* chomp;*/
+      data[len-1] = 0;
+      len--;
+    }
+    if (data[0]=='*') break; /* last if !^\*!; */
+    if (data[0]>='0' && data[0]<='9' && data[1]>='0' && data[1]<='9') {
+      o=2; /* $data =~ s/^\d\d//; */
+    }
+    printf("  \"");
+    for (i=o; i<len; i++) {
+      if (data[i]=='"' || data[i]=='\\') putchar('\\');
+	  if (data[i]=='?') printf("\" \""); /* suppress trigraphs */
+      putchar(data[i]);
+    } /* $data =~ s/(["\\])/\\$1/g; */
+    printf("\",\n");
+  }
+  fclose(fh);
+  printf("  NULL };\n"
+    "int loadpoolstrings (integer spare_size) {\n"
+    "  strnumber g=0;\n"
+    "  int i=0,j=0;\n"
+    "  char *s;\n"
+    "  while ((s = poolfilearr[j++])) {\n"
+    "    int l = strlen (s);\n"
+    "    i += l;\n"
+    "    if (i>=spare_size) return 0;\n"
+		 /*"    while (l-- > 0) strpool[poolptr++] = *s++;\n"*/
+    "    while (l-- > 0) str_pool[pool_ptr++] = *s++;\n"
+		 /* "    g = makestring();\n"*/
+    "    g = make_string();\n"
+		 /*    "    strref[g]= 127;\n"*/
+    "  }\n"
+    "  return g;\n"
+    "}\n");
+  return 0;
+}
diff --git a/Build/source/texk/web2c/luatexdir/managed-sa.c b/Build/source/texk/web2c/luatexdir/managed-sa.c
new file mode 100644
index 00000000000..cc63d7e75f5
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/managed-sa.c
@@ -0,0 +1,245 @@
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "managed-sa.h"
+
+
+static void
+store_sa_stack (sa_tree a, integer n, integer v, integer gl) {
+  sa_stack_item st;
+  st.code  = n;
+  st.value = v;
+  st.level = gl;
+  if (a->stack == NULL) {
+    a->stack = Mxmalloc_array(sa_stack_item,a->stack_size);
+  } else if (((a->stack_ptr)+1)>=a->stack_size) {
+    a->stack_size += a->stack_step;
+    a->stack = Mxrealloc_array(a->stack,sa_stack_item,a->stack_size);
+  }
+  (a->stack_ptr)++;
+  a->stack[a->stack_ptr] = st;
+}
+
+static void
+skip_in_stack (sa_tree a, integer n) {
+  int p = a->stack_ptr;
+  if (a->stack == NULL)
+	return;
+  while (p>0) {
+    if (a->stack[p].code == n && a->stack[p].level > 0) {
+      a->stack[p].level  = -(a->stack[p].level);
+    }
+    p--;
+  }
+}
+
+sa_tree_item
+get_sa_item (const sa_tree head, const integer n) {
+  register int h;
+  register int m;
+  if (head->tree != NULL) {
+    h = HIGHPART_PART(n);
+    if (head->tree[h] != NULL) {
+      m = MIDPART_PART(n);
+      if (head->tree[h][m] != NULL) {
+      	return head->tree[h][m][LOWPART_PART(n)];
+      }
+    }
+  }
+  return head->dflt;
+}
+
+void
+set_sa_item (sa_tree head, integer n, sa_tree_item v, integer gl) {
+  int h,m,l;
+  int i;
+  h = HIGHPART_PART(n);
+  m = MIDPART_PART(n);
+  l = LOWPART_PART(n);
+  if (head->tree == NULL) {
+    head->tree = (sa_tree_item ***) Mxmalloc_array(sa_tree_item **,HIGHPART);
+    for  (i=0; i<HIGHPART; i++) { head->tree[i] = NULL; }  
+  }
+  if (head->tree[h] == NULL) {
+    head->tree[h] = (sa_tree_item **) Mxmalloc_array(sa_tree_item *,MIDPART); 
+    for  (i=0; i<MIDPART; i++) { head->tree[h][i] = NULL; }  
+  }
+  if (head->tree[h][m] == NULL) {
+    head->tree[h][m] = (sa_tree_item *) Mxmalloc_array(sa_tree_item,LOWPART);
+    for  (i=0; i<LOWPART; i++) { head->tree[h][m][i] = head->dflt; }  
+  }
+  if (gl<=1) {
+    skip_in_stack(head,n);
+  } else {
+    store_sa_stack(head,n,head->tree[h][m][l],gl);
+  }
+  head->tree[h][m][l] = v;
+}
+
+static void
+rawset_sa_item (sa_tree head, integer n, integer v) {
+  head->tree[HIGHPART_PART(n)][MIDPART_PART(n)][LOWPART_PART(n)] = v;
+}
+
+void
+clear_sa_stack (sa_tree a) {
+  if (a->stack != NULL) {
+	Mxfree(a->stack);
+  }
+  a->stack = NULL;
+  a->stack_ptr   = 0;
+  a->stack_size  = a->stack_step;
+}
+
+void
+destroy_sa_tree (sa_tree a) {
+  int h,m;
+  if (a == NULL)
+    return;
+  if (a->tree != NULL) {
+    for (h=0; h<HIGHPART;h++ ) {
+      if (a->tree[h] != NULL) {
+	for (m=0; m<MIDPART; m++ ) {
+	  if (a->tree[h][m] != NULL) {
+	    Mxfree(a->tree[h][m]);
+	  }
+	}
+	Mxfree(a->tree[h]);
+      }
+    }
+    Mxfree(a->tree);
+  }
+  if (a->stack != NULL) {
+    Mxfree(a->stack);
+  }
+  Mxfree(a);
+}
+
+
+sa_tree
+copy_sa_tree(sa_tree b) {
+  int h,m,l;
+  sa_tree a = (sa_tree)Mxmalloc_array(sa_tree_head,1);
+  a->stack_step  = b->stack_step;
+  a->stack_size  = b->stack_size;
+  a->dflt  = b->dflt;
+  a->stack = NULL;
+  a->stack_ptr   = 0;
+  a->tree = NULL;
+  if (b->tree !=NULL) {
+	a->tree = (sa_tree_item ***)Mxmalloc_array(void *,HIGHPART);
+	for (h=0; h<HIGHPART;h++ ) {  
+	  if (b->tree[h] != NULL) {
+		a->tree[h]=(sa_tree_item **)Mxmalloc_array(void *,MIDPART);
+		for (m=0; m<MIDPART; m++ )  { 
+		  if (b->tree[h][m]!=NULL) { 
+			a->tree[h][m]=Mxmalloc_array(sa_tree_item,LOWPART);
+			for (l=0; l<LOWPART; l++)  { 
+			  a->tree[h][m][l] =  b->tree[h][m][l] ;
+			} 
+		  } else {
+			a->tree[h][m] = NULL; 
+		  }   
+		}  
+	  } else { 
+		a->tree[h]= NULL; 
+	  } 
+	}
+  }
+  return a;
+}
+
+
+sa_tree
+new_sa_tree (integer size, sa_tree_item dflt) {
+  sa_tree_head *a;
+  a = (sa_tree_head *)xmalloc(sizeof(sa_tree_head));
+  a->dflt    = dflt;
+  a->stack   = NULL;
+  a->tree    = NULL;
+  a->stack_size    = size;
+  a->stack_step    = size;
+  a->stack_ptr     = 0;
+  return (sa_tree)a;
+}
+
+void
+restore_sa_stack (sa_tree head, integer gl) {
+  sa_stack_item st;
+  if (head->stack == NULL)
+	return;
+  while (head->stack_ptr>0 && abs(head->stack[head->stack_ptr].level)>=gl) {
+	st = head->stack[head->stack_ptr];
+	if (st.level>0) {
+	  rawset_sa_item (head, st.code, st.value);
+	}
+	(head->stack_ptr)--;
+  }
+}
+
+
+void
+dump_sa_tree (sa_tree a) {
+  boolean f;
+  unsigned int x;
+  int h,m,l;
+  if (a == NULL)
+    return;
+  dump_int(a->stack_step);
+  dump_int(a->dflt);
+  if (a->tree != NULL) {
+    for (h=0; h<HIGHPART;h++ ) {
+      if (a->tree[h] != NULL) {
+	f = 1;  dump_qqqq(f);
+	for (m=0; m<MIDPART; m++ ) {
+	  if (a->tree[h][m] != NULL) {
+	    f = 1;  dump_qqqq(f);
+	    for (l=0;l<LOWPART;l++) { 
+	      x = a->tree[h][m][l];  dump_int(x);  
+	    }
+	  } else { 
+	    f = 0;  dump_qqqq(f);
+	  } 
+	}
+      } else { 
+	f = 0;  dump_qqqq(f);  
+      } 
+    }
+  }
+}
+
+
+sa_tree
+undump_sa_tree(void) {
+  unsigned int x;
+  int h,m,l;
+  boolean f;
+  sa_tree a  = (sa_tree)Mxmalloc_array(sa_tree_head,1);
+  undump_int(x) ; a->stack_step  = x; a->stack_size  = x;
+  undump_int(x) ; a->dflt  = x;
+  a->stack = Mxmalloc_array(sa_stack_item,a->stack_size);
+  a->stack_ptr   = 0;
+  a->tree = (sa_tree_item ***)Mxmalloc_array(void *,HIGHPART);
+  for (h=0; h<HIGHPART;h++ ) {  
+    undump_qqqq(f);  
+    if (f>0)  { 
+      a->tree[h]=(sa_tree_item **)Mxmalloc_array(void *,MIDPART);
+      for (m=0; m<MIDPART; m++ )  { 
+	undump_qqqq(f);
+        if (f>0) { 
+	  a->tree[h][m]=Mxmalloc_array(sa_tree_item,LOWPART);
+	  for (l=0; l<LOWPART; l++)  { 
+	    undump_int(x);  a->tree[h][m][l] = x; 
+	  } 
+	} else {
+	  a->tree[h][m] = NULL; 
+	}   
+      }  
+    } else { 
+      a->tree[h]= NULL; 
+    } 
+  }
+  return a;
+}
+
+
diff --git a/Build/source/texk/web2c/luatexdir/managed-sa.h b/Build/source/texk/web2c/luatexdir/managed-sa.h
new file mode 100644
index 00000000000..b73aece81b1
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/managed-sa.h
@@ -0,0 +1,74 @@
+/*
+  Copyright (c) 2007 Taco Hoekwater <taco@luatex.org>
+  
+  This file is part of LuaTeX.
+  
+  LuaTeX 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.
+
+  LuaTeX 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 LuaTeX; if not, write to the Free Software
+  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+  $Id$ */
+
+#ifndef MANAGED_SA_H
+#define MANAGED_SA_H 1
+
+/* the next two sets of three had better match up exactly, but using bare numbers
+  is easier on the C compiler */
+
+#define HIGHPART 128
+#define MIDPART 128
+#define LOWPART 128
+
+#define HIGHPART_PART(a) ((a>>14)&127)
+#define MIDPART_PART(a)  ((a>>7)&127)
+#define LOWPART_PART(a)  (a&127)
+
+#define Mxmalloc_array(a,b)  xmalloc(b*sizeof(a))
+#define Mxrealloc_array(a,b,c)  xrealloc(a,c*sizeof(b))
+#define Mxfree(a) free(a); a=NULL
+
+typedef unsigned int  sa_tree_item;
+
+typedef struct {
+  int          code;
+  int          level;
+  sa_tree_item value;
+} sa_stack_item;
+
+
+typedef struct {
+  int stack_size;           /* initial stack size   */
+  int stack_step;           /* increment stack step */
+  int stack_ptr;            /* current stack point  */
+  int dflt;                 /* default item value   */  
+  sa_tree_item *** tree;    /* item tree head       */
+  sa_stack_item  * stack;   /* stack tree head      */
+} sa_tree_head;
+
+typedef sa_tree_head *sa_tree;
+
+extern sa_tree_item get_sa_item     (const sa_tree head, const integer n) ;
+extern void         set_sa_item     (sa_tree head, integer n, sa_tree_item v, integer gl) ;
+
+extern sa_tree      new_sa_tree     (integer size, sa_tree_item dflt);
+
+extern sa_tree      copy_sa_tree     (sa_tree head);
+extern void         destroy_sa_tree  (sa_tree head);
+
+extern void         dump_sa_tree    (sa_tree a);
+extern sa_tree      undump_sa_tree  (void) ;
+
+extern void         restore_sa_stack  (sa_tree a, integer gl);
+extern void         clear_sa_stack    (sa_tree a);
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/mathcodes.c b/Build/source/texk/web2c/luatexdir/mathcodes.c
new file mode 100644
index 00000000000..77e15e7c66c
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/mathcodes.c
@@ -0,0 +1,191 @@
+
+/* 
+Copyright (c) 2006 Taco Hoekwater, <taco@elvenkind.com>
+
+This file is part of LuaTeX.
+
+LuaTeX 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.
+
+LuaTeX 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 LuaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+*/
+
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "managed-sa.h"
+
+/* the 0xFFFFFFFF is a flag value */
+
+#define MATHCODESTACK 8
+#define MATHCODEDEFAULT 0xFFFFFFFF
+
+static sa_tree mathcode_head      = NULL;
+
+typedef struct delcodeval {
+  integer     valuea;
+  integer     valueb;
+} delcodeval;
+
+/* delcodes are a bit more work */
+
+#define DELCODESTACK 4
+#define DELCODEDEFAULT 0xFFFFFFFF
+
+static sa_tree delcode_head       = NULL;
+
+#define DELCODEHEAP 8
+
+static delcodeval * delcode_heap      = NULL;
+static int          delcode_heapsize  = DELCODEHEAP;
+static int          delcode_heapptr   = 0;
+
+void 
+unsavemathcode (quarterword gl) {
+  restore_sa_stack(mathcode_head,gl);
+}
+
+void 
+set_math_code (integer n, halfword v, quarterword gl) {
+  set_sa_item(mathcode_head,n,v,gl);
+}
+
+halfword
+get_math_code (integer n) {
+  unsigned int ret;
+  ret = get_sa_item(mathcode_head,n);
+  if (ret==MATHCODEDEFAULT) { 
+    return (halfword)n; 
+  } else { 
+    return (halfword)ret;
+  }
+}
+
+void 
+initializemathcode (void) {
+  mathcode_head = new_sa_tree(MATHCODESTACK,MATHCODEDEFAULT);
+}
+
+void 
+dumpmathcode (void) {
+  dump_sa_tree(mathcode_head);
+}
+
+void 
+undumpmathcode (void) {
+  mathcode_head = undump_sa_tree();
+}
+
+/* TODO: clean up the heap */
+
+void 
+unsavedelcode (quarterword gl) {
+  restore_sa_stack(delcode_head,gl);
+}
+
+void 
+set_del_code (integer n, halfword v, halfword w, quarterword gl) {
+  delcodeval d;
+  d.valuea = v;  d.valueb = w;
+  if (delcode_heapptr==delcode_heapsize) {
+	delcode_heapsize += DELCODEHEAP;
+	delcode_heap = Mxrealloc_array(delcode_heap,delcodeval,delcode_heapsize);
+  }
+  delcode_heap[delcode_heapptr] = d;
+  set_sa_item(delcode_head,n,delcode_heapptr,gl);
+  delcode_heapptr++;
+}
+
+halfword
+get_del_code_a (integer n) {
+  int ret;
+  ret = get_sa_item(delcode_head,n);
+  if (ret==DELCODEDEFAULT) { 
+	return (halfword)-1; 
+  } else { 
+	return (halfword)delcode_heap[ret].valuea;
+  }
+}
+
+halfword
+get_del_code_b (integer n) {
+  unsigned int ret;
+  ret = get_sa_item(delcode_head,n);
+  if (ret==DELCODEDEFAULT) { 
+	return (halfword)-1; 
+  } else { 
+	return (halfword)delcode_heap[ret].valueb;
+  }
+}
+
+void 
+initializedelcode (void) {
+  delcode_head = new_sa_tree(DELCODESTACK,DELCODEDEFAULT);
+  delcode_heap = Mxmalloc_array(delcodeval,DELCODEHEAP);
+}
+
+void 
+dumpdelcode (void) {
+  int k;
+  delcodeval d;
+  dump_sa_tree(delcode_head);
+  dump_int(delcode_heapsize);
+  dump_int(delcode_heapptr);
+  for (k=0;k<delcode_heapptr;k++) {
+	d = delcode_heap[k];
+	dump_int(d.valuea);
+	dump_int(d.valueb);
+  }
+}
+
+void 
+undumpdelcode (void) {
+  int k;
+  delcodeval d;
+  delcode_head = undump_sa_tree();
+  undump_int(delcode_heapsize);
+  undump_int(delcode_heapptr);
+  delcode_heap = Mxmalloc_array(delcodeval,delcode_heapsize);
+  for (k=0;k<delcode_heapptr;k++) {
+	undump_int(d.valuea);
+	undump_int(d.valueb);
+	delcode_heap[k] = d;
+  }
+  d.valuea=0; d.valueb=0;
+  for (k=delcode_heapptr;k<delcode_heapsize;k++) {
+	delcode_heap[k] = d;
+  }
+}
+
+void 
+unsave_math_codes (quarterword grouplevel) {
+  unsavemathcode(grouplevel);
+  unsavedelcode(grouplevel);
+}
+
+void initialize_math_codes (void) {
+  initializemathcode();
+  initializedelcode();
+}
+
+void dump_math_codes(void) {
+  dumpmathcode();
+  dumpdelcode();
+}
+
+void undump_math_codes(void) {
+  undumpmathcode();
+  undumpdelcode();
+}
diff --git a/Build/source/texk/web2c/luatexdir/nodes.h b/Build/source/texk/web2c/luatexdir/nodes.h
new file mode 100644
index 00000000000..ba2c09ecc78
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/nodes.h
@@ -0,0 +1,648 @@
+
+#include <stdarg.h>
+
+#ifndef __NODES_H__
+#define __NODES_H__
+
+/* these don't really belong here */
+
+#define token_ref_count(a) info((a)) /* reference count preceding a token list */
+#define add_token_ref(a) token_ref_count(a)++  /* new reference to a token list */
+
+
+/* these are in texlang.c */
+
+#define set_vlink(a,b)  vlink(a)=b
+#define get_vlink(a)  vlink(a)
+#define get_character(a)  character(a)
+
+extern halfword insert_discretionary ( halfword t,  halfword pre,  halfword post,  halfword replace);
+extern halfword insert_syllable_discretionary ( halfword t,  lang_variables *lan);
+extern halfword insert_word_discretionary ( halfword t,  lang_variables *lan);
+extern halfword insert_complex_discretionary ( halfword t,   lang_variables *lan, 
+					       halfword pre,  halfword post,  halfword replace);
+extern halfword insert_character ( halfword t,  int n);
+extern void set_disc_field (halfword f, halfword t);
+
+
+#define max_halfword  0x3FFFFFFF
+#ifndef null
+#define null         0
+#endif
+#define null_flag    -0x40000000
+#define zero_glue 0
+#define normal 0
+
+#define vinfo(a)           varmem[(a)].hh.v.LH 
+#define vlink(a)           varmem[(a)].hh.v.RH 
+#define type(a)            varmem[(a)].hh.u.B0
+#define subtype(a)         varmem[(a)].hh.u.B1
+#define node_attr(a)       vinfo((a)+1)
+#define alink(a)           vlink((a)+1)
+
+#define node_size(a)       varmem[(a)].hh.v.LH
+
+#define rlink(a)           vlink((a)+1) /* aka alink() */
+#define llink(a)           vinfo((a)+1) /* overlaps with node_attr() */
+
+#define add_glue_ref(a) glue_ref_count(a)++ /* new reference to a glue spec */
+
+/* really special head node pointers that only need links */
+
+#define temp_node_size 2
+
+/* attribute lists */
+
+/* it is convenient to have attribute list nodes and attribute node
+ * be the same size
+ */
+
+#define attribute_node_size 2
+
+#define attr_list_ref(a)   vinfo((a)+1) /* the reference count */
+#define attribute_id(a)    vinfo((a)+1)
+#define attribute_value(a) vlink((a)+1)
+
+#define cache_disabled max_halfword
+#define add_node_attr_ref(a) { if (a!=null)  attr_list_ref((a))++; }
+
+#define  replace_attribute_list(a,b)  do {		\
+    delete_attribute_ref(node_attr(a));			\
+    node_attr(a)=b;					\
+  } while (0)
+
+extern void update_attribute_cache (void) ;
+extern halfword copy_attribute_list(halfword n) ;
+extern halfword do_set_attribute(halfword p, int i, int val);
+
+
+/* a glue spec */
+#define glue_spec_size 4
+#define stretch(a)        vlink((a)+1)
+/* width == a+2 */
+#define shrink(a)         vinfo((a)+1)
+#define stretch_order(a)  type((a)+3)
+#define shrink_order(a)   subtype((a)+3)
+#define glue_ref_count(a) vlink((a)+3)
+
+/* pdf action spec */
+
+#define pdf_action_size 4
+
+typedef enum {
+  pdf_action_page = 0,
+  pdf_action_goto,
+  pdf_action_thread,
+  pdf_action_user } pdf_action_types;
+
+#define pdf_action_type(a)        type((a) + 1)
+#define pdf_action_named_id(a)    subtype((a) + 1)
+#define pdf_action_id(a)          vlink((a) + 1)
+#define pdf_action_file(a)        vinfo((a) + 2)
+#define pdf_action_new_window(a)  vlink((a) + 2)
+#define pdf_action_tokens(a)      vinfo((a) + 3)
+#define pdf_action_refcount(a)    vlink((a) + 3)
+
+/*increase count of references to this action*/
+#define add_action_ref(a) pdf_action_refcount((a))++ 
+
+/* decrease count of references to this
+   action; free it if there is no reference to this action*/
+
+#define delete_action_ref(a) {									\
+    if (pdf_action_refcount(a) == null) {						\
+	  if (pdf_action_type(a) == pdf_action_user) {				\
+		delete_token_ref(pdf_action_tokens(a));					\
+	  } else {													\
+		if (pdf_action_file(a) != null)							\
+		  delete_token_ref(pdf_action_file(a));					\
+		if (pdf_action_type(a) == pdf_action_page)				\
+		  delete_token_ref(pdf_action_tokens(a));				\
+		else if (pdf_action_named_id(a) > 0)					\
+		  delete_token_ref(pdf_action_id(a));					\
+	  }															\
+	  free_node(a, pdf_action_size);							\
+	} else {													\
+	  decr(pdf_action_refcount(a));								\
+	}															\
+  }
+
+
+
+/* normal nodes */
+
+#define inf_bad  10000  /* infinitely bad value */
+#define inf_penalty inf_bad /*``infinite'' penalty value*/
+#define eject_penalty -(inf_penalty) /*``negatively infinite'' penalty value */
+
+#define penalty_node_size 3 
+#define penalty(a)       vlink((a)+2)
+
+#define glue_node_size 3
+#define glue_ptr(a)      vinfo((a)+2)
+#define leader_ptr(a)    vlink((a)+2)
+
+/* disc nodes could eventually be smaller, because the indirect 
+   pointers are not really needed (8 instead of 10).
+ */
+
+#define disc_node_size 10
+
+typedef enum {
+  discretionary_disc=0,
+  explicit_disc,
+  automatic_disc,
+  syllable_disc } discretionary_types;
+
+#define pre_break_head(a)   ((a)+4)
+#define post_break_head(a)  ((a)+6)
+#define no_break_head(a)    ((a)+8)
+
+#define pre_break(a)     vinfo((a)+2)
+#define post_break(a)    vlink((a)+2)
+#define no_break(a)      vlink((a)+3)
+#define tlink llink
+
+#define vlink_pre_break(a)  vlink(pre_break_head(a))
+#define vlink_post_break(a) vlink(post_break_head(a))
+#define vlink_no_break(a)   vlink(no_break_head(a))
+
+#define tlink_pre_break(a)  tlink(pre_break_head(a))
+#define tlink_post_break(a) tlink(post_break_head(a))
+#define tlink_no_break(a)   tlink(no_break_head(a))
+
+#define kern_node_size 3
+#define explicit 1  /*|subtype| of kern nodes from \.{\\kern} and \.{\\/}*/
+#define acc_kern 2  /*|subtype| of kern nodes from accents */
+
+#define box_node_size 8
+#define width(a)         varmem[(a+2)].cint
+#define depth(a)         varmem[(a+3)].cint
+#define height(a)        varmem[(a+4)].cint
+#define shift_amount(a)  vlink((a)+5)
+#define box_dir(a)       vinfo((a)+5)
+#define list_ptr(a)      vlink((a)+6)
+#define glue_order(a)    subtype((a)+6)
+#define glue_sign(a)     type((a)+6)
+#define glue_set(a)      varmem[(a+7)].gr
+
+/* unset nodes */
+#define glue_stretch(a)  varmem[(a)+7].cint
+#define glue_shrink      shift_amount
+#define span_count       subtype
+
+#define rule_node_size 6
+#define rule_dir(a)      vlink((a)+5)
+
+#define mark_node_size 3
+#define mark_ptr(a)      vlink((a)+2)
+#define mark_class(a)    vinfo((a)+2)
+
+#define adjust_node_size 3
+#define adjust_ptr(a)    vlink(a+2)
+
+#define glyph_node_size 5
+
+#define character(a)    vinfo((a)+2)
+#define font(a)         vlink((a)+2)
+#define lang_data(a)    vinfo((a)+3)
+#define lig_ptr(a)      vlink((a)+3)
+#define x_displace(a)   vinfo((a)+4)
+#define y_displace(a)   vlink((a)+4)
+#define is_char_node(a) (a!=null && type(a)==glyph_node)
+
+#define char_lang(a)     ((const int)(((unsigned)lang_data(a) & 0x7FFF0000)>>16))
+#define char_lhmin(a)    ((const int)(((unsigned)lang_data(a) & 0x0000FF00)>>8))
+#define char_rhmin(a)    ((const int)(((unsigned)lang_data(a) & 0x000000FF)))
+#define char_uchyph(a)   ((const int)(((unsigned)lang_data(a) & 0x80000000)>>31))
+
+#define make_lang_data(a,b,c,d) (a>0 ? (1<<31): 0)+			\
+  (b<<16)+ (((c>0 && c<256) ? c : 1)<<8)+(((d>0 && d<256) ? d : 1))
+
+#define init_lang_data(a)      lang_data(a)=256+1
+
+#define set_char_lang(a,b)    lang_data(a)=make_lang_data(char_uchyph(a),b,char_lhmin(a),char_rhmin(a))
+#define set_char_lhmin(a,b)   lang_data(a)=make_lang_data(char_uchyph(a),char_lang(a),b,char_rhmin(a))
+#define set_char_rhmin(a,b)   lang_data(a)=make_lang_data(char_uchyph(a),char_lang(a),char_lhmin(a),b)
+#define set_char_uchyph(a,b)  lang_data(a)=make_lang_data(b,char_lang(a),char_lhmin(a),char_rhmin(a))
+
+#define margin_kern_node_size 4
+#define margin_char(a)  vlink((a)+3)
+
+/*@# {|subtype| of marginal kerns}*/
+#define left_side 0
+#define right_side 1
+
+#define math_node_size 3
+#define surround(a)      vlink((a)+2)
+#define before 0 /*|subtype| for math node that introduces a formula*/
+#define after 1 /*|subtype| for math node that winds up a formula*/
+
+
+
+#define ins_node_size 6
+#define float_cost(a)    varmem[(a)+2].cint
+#define ins_ptr(a)       vinfo((a)+5)
+#define split_top_ptr(a) vlink((a)+5)
+
+
+#define page_ins_node_size 5
+
+#define broken_ptr(a) vlink((a)+2) /* an insertion for this class will break here if anywhere */
+#define broken_ins(a) vinfo((a)+2) /* this insertion might break at |broken_ptr| */
+#define last_ins_ptr(a) vlink((a)+3) /*the most recent insertion for this |subtype|*/
+#define best_ins_ptr(a) vinfo((a)+3) /*the optimum most recent insertion*/
+/* height = 4 */
+
+typedef enum {
+  hlist_node = 0, 
+  vlist_node = 1, 
+  rule_node,      
+  ins_node,       
+  mark_node,      
+  adjust_node,    
+  /* 6 used to be ligatures */
+  disc_node=7,     
+  whatsit_node,
+  math_node,      
+  glue_node,      
+  kern_node,      
+  penalty_node,   
+  unset_node,   /* 13 */
+  style_node,
+  choice_node,
+  ord_noad,
+  op_noad,
+  bin_noad,
+  rel_noad,
+  open_noad,
+  close_noad,
+  punct_noad,
+  inner_noad,
+  radical_noad,
+  fraction_noad,
+  under_noad,
+  over_noad,
+  accent_noad,
+  vcenter_noad,
+  left_noad,
+  right_noad,
+  margin_kern_node = 32,
+  glyph_node = 33,
+  align_record_node = 34,
+  pseudo_file_node = 35,
+  pseudo_line_node = 36,
+  inserting_node = 37,
+  split_up_node = 38,
+  expr_node = 39,
+  nesting_node = 40,
+  span_node = 41,
+  attribute_node = 42,
+  glue_spec_node = 43,
+  attribute_list_node = 44,
+  action_node = 45,
+  temp_node = 46,
+  align_stack_node = 47,
+  movement_node = 48,
+  if_node = 49,
+  unhyphenated_node = 50, 
+  hyphenated_node = 51,
+  delta_node = 52,
+  passive_node = 53,
+  shape_node = 54 } node_types ;
+
+#define last_known_node temp_node /* used by \lastnodetype */
+
+#define movement_node_size 3
+#define expr_node_size 3
+#define if_node_size 2
+#define align_stack_node_size 6
+#define nesting_node_size 2
+
+#define span_node_size 3
+#define span_span(a) vlink((a)+1)
+#define span_link(a) vinfo((a)+1)
+
+#define pseudo_file_node_size 2
+#define pseudo_lines(a) vlink((a)+1)
+
+#define nodetype_has_attributes(t) (((t)<=glyph_node) && ((t)!=unset_node))
+
+#define style_node_size 4 /* number of words in a style node*/
+#define radical_noad_size 6 /*number of |mem| words in a radical noad*/
+#define accent_noad_size 6 /*number of |mem| words in an accent noad*/
+
+
+#define display_mlist(a) vinfo((a)+2) /* mlist to be used in display style*/
+#define text_mlist(a) vlink((a)+2) /* mlist to be used in text style */
+#define script_mlist(a) vinfo((a)+3) /* mlist to be used in script style */
+#define script_script_mlist(a) vlink((a)+3) /* mlist to be used in scriptscript style */
+
+#define noad_size 5 /*number of words in a normal noad*/
+#define nucleus(a) (a)+2 /* the |nucleus| field of a noad */
+#define supscr(a) (a)+3 /* the |supscr| field of a noad */
+#define subscr(a) (a)+4 /* the |subscr| field of a noad */
+#define math_type vlink /* a |quarterword| in |mem| */
+#define fam(a) type((a)) /* a |quarterword| in |mem| */
+
+#define fraction_noad_size 7 /*number of |mem| words in a fraction noad*/
+#define numerator supscr /*|numerator| field in a fraction noad*/
+#define denominator subscr /*|denominator| field in a fraction noad*/
+
+typedef enum {
+  math_char=1, /* |math_type| when the attribute is simple */
+  sub_box, /* |math_type| when the attribute is a box */
+  sub_mlist, /* |math_type| when the attribute is a formula */
+  math_text_char /* |math_type| when italic correction is dubious */
+} math_types;
+
+
+typedef enum {
+  open_node = 0,
+  write_node,
+  close_node,
+  special_node,
+  language_node,
+  set_language_code,
+  local_par_node,
+  dir_node,
+  pdf_literal_node,
+  pdf_obj_code,
+  pdf_refobj_node, /* 10 */
+  pdf_xform_code,
+  pdf_refxform_node,
+  pdf_ximage_code,
+  pdf_refximage_node,
+  pdf_annot_node,
+  pdf_start_link_node,
+  pdf_end_link_node,
+  pdf_outline_code,
+  pdf_dest_node,
+  pdf_thread_node, /* 20 */
+  pdf_start_thread_node,
+  pdf_end_thread_node,
+  pdf_save_pos_node,
+  pdf_thread_data_node,
+  pdf_link_data_node,
+  pdf_names_code,
+  pdf_font_attr_code,
+  pdf_include_chars_code,
+  pdf_map_file_code,
+  pdf_map_line_code, /* 30 */
+  pdf_trailer_code,
+  pdf_font_expand_code,
+  set_random_seed_code,
+  pdf_glyph_to_unicode_code,
+  late_lua_node, /* 35 */
+  close_lua_node,
+  save_cat_code_table_code,
+  init_cat_code_table_code,
+  pdf_colorstack_node,
+  pdf_setmatrix_node, /* 40 */
+  pdf_save_node,
+  pdf_restore_node,
+  cancel_boundary_node,
+  user_defined_node /* 44 */ } whatsit_types ;
+
+#define pdf_info_code pdf_thread_data_node
+#define pdf_catalog_code  pdf_link_data_node
+
+
+#define GLYPH_CHARACTER     (1 << 0)
+#define GLYPH_LIGATURE      (1 << 1)
+#define GLYPH_GHOST         (1 << 2)
+#define GLYPH_LEFT          (1 << 3)
+#define GLYPH_RIGHT         (1 << 4)
+
+#define is_character(p)        ((subtype(p)) & GLYPH_CHARACTER)
+#define is_ligature(p)         ((subtype(p)) & GLYPH_LIGATURE )
+#define is_ghost(p)            ((subtype(p)) & GLYPH_GHOST    )
+
+#define is_simple_character(p) (is_character(p) && !is_ligature(p) && !is_ghost(p))
+
+#define is_leftboundary(p) 	   (is_ligature(p) && ((subtype(p)) & GLYPH_LEFT  ))
+#define is_rightboundary(p)    (is_ligature(p) && ((subtype(p)) & GLYPH_RIGHT ))
+#define is_leftghost(p) 	   (is_ghost(p)    && ((subtype(p)) & GLYPH_LEFT  ))
+#define is_rightghost(p)  	   (is_ghost(p)    && ((subtype(p)) & GLYPH_RIGHT ))
+
+#define set_is_glyph(p)         subtype(p) &= ~GLYPH_CHARACTER
+#define set_is_character(p)     subtype(p) |= GLYPH_CHARACTER
+#define set_is_ligature(p)      subtype(p) |= GLYPH_LIGATURE
+#define set_is_ghost(p)         subtype(p) |= GLYPH_GHOST
+
+#define set_to_glyph(p)         subtype(p) = (subtype(p) & 0xFF00)
+#define set_to_character(p)     subtype(p) = (subtype(p) & 0xFF00) | GLYPH_CHARACTER
+#define set_to_ligature(p)      subtype(p) = (subtype(p) & 0xFF00) | GLYPH_LIGATURE
+#define set_to_ghost(p)         subtype(p) = (subtype(p) & 0xFF00) | GLYPH_GHOST
+
+#define set_is_leftboundary(p)  { set_to_ligature(p); subtype(p) |= GLYPH_LEFT;  }
+#define set_is_rightboundary(p) { set_to_ligature(p); subtype(p) |= GLYPH_RIGHT; }
+#define set_is_leftghost(p)     { set_to_ghost(p);    subtype(p) |= GLYPH_LEFT;  }
+#define set_is_rightghost(p)    { set_to_ghost(p);    subtype(p) |= GLYPH_RIGHT; }
+
+
+#define special_node_size 3
+
+#define dir_node_size 4
+#define dir_dir(a)       vinfo((a)+2)
+#define dir_level(a)     vlink((a)+2)
+#define dir_dvi_ptr(a)   vinfo((a)+3)
+#define dir_dvi_h(a)     vlink((a)+3)
+
+#define write_node_size 3
+#define close_node_size 3
+#define write_tokens(a)  vlink(a+2)
+#define write_stream(a)  vinfo(a+2)
+
+#define open_node_size 4
+#define open_name(a)   vlink((a)+2)
+#define open_area(a)   vinfo((a)+3)
+#define open_ext(a)    vlink((a)+3)
+
+#define late_lua_data(a)        vlink((a)+2)
+#define late_lua_reg(a)         vinfo((a)+2)
+
+#define local_par_size 6
+
+#define local_pen_inter(a)       vinfo((a)+2)
+#define local_pen_broken(a)      vlink((a)+2)
+#define local_box_left(a)        vlink((a)+3)
+#define local_box_left_width(a)  vinfo((a)+3)
+#define local_box_right(a)       vlink((a)+4)
+#define local_box_right_width(a) vinfo((a)+4)
+#define local_par_dir(a)         vinfo((a)+5)
+
+
+#define pdf_literal_data(a)  vlink(a+2)
+#define pdf_literal_mode(a)  vinfo(a+2)
+
+#define pdf_refobj_node_size 3
+
+#define pdf_obj_objnum(a)    vinfo((a) + 2)
+
+#define pdf_refxform_node_size  6
+#define pdf_refximage_node_size 6
+#define pdf_annot_node_size 8
+#define pdf_dest_node_size 8
+#define pdf_thread_node_size 8
+
+#define pdf_width(a)         varmem[(a) + 2].cint
+#define pdf_height(a)        varmem[(a) + 3].cint
+#define pdf_depth(a)         varmem[(a) + 4].cint
+
+#define pdf_ximage_objnum(a) vinfo((a) + 5) /* this will be removed soon */
+#define pdf_ximage_ref(a)    vinfo((a) + 5)
+#define pdf_xform_objnum(a)  vinfo((a) + 5)
+
+#define pdf_annot_data(a)       vinfo((a) + 6)
+#define pdf_link_attr(a)        vinfo((a) + 6)
+#define pdf_link_action(a)      vlink((a) + 6)
+#define pdf_annot_objnum(a)     varmem[(a) + 7].cint
+#define pdf_link_objnum(a)      varmem[(a) + 7].cint
+
+#define pdf_dest_type(a)          type((a) + 6)
+#define pdf_dest_named_id(a)      subtype((a) + 6)
+#define pdf_dest_id(a)            vlink((a) + 6)
+#define pdf_dest_xyz_zoom(a)      vinfo((a) + 7)
+#define pdf_dest_objnum(a)        vlink((a) + 7)
+
+#define pdf_thread_named_id(a)    subtype((a) + 6)
+#define pdf_thread_id(a)          vlink((a) + 6)
+#define pdf_thread_attr(a)        vinfo((a) + 7)
+
+#define pdf_end_link_node_size 3
+#define pdf_end_thread_node_size 3
+#define pdf_save_pos_node_size 3
+
+#define pdf_colorstack_node_size 4
+#define pdf_setmatrix_node_size 3
+
+#define pdf_colorstack_stack(a)  vlink((a)+2)
+#define pdf_colorstack_cmd(a)    vinfo((a)+2)
+#define pdf_colorstack_data(a)   vlink((a)+3)
+#define pdf_setmatrix_data(a)    vlink((a)+2)
+
+#define pdf_save_node_size     3
+#define pdf_restore_node_size  3
+
+typedef enum {
+  colorstack_set=0,
+  colorstack_push,
+  colorstack_pop,
+  colorstack_current } colorstack_commands;
+
+#define colorstack_data   colorstack_push /* last value where data field is set */
+
+#define user_defined_node_size 4
+#define user_node_type(a)  vinfo((a)+2)
+#define user_node_id(a)    vlink((a)+2)
+#define user_node_value(a) vinfo((a)+3)
+
+#define cancel_boundary_size   3
+
+typedef enum {
+  exactly=0, /*a box dimension is pre-specified*/
+  additional, /*a box dimension is increased from the natural one*/
+  cal_expand_ratio, /* calculate amount for font expansion after breaking
+		       paragraph into lines*/
+  subst_ex_font  /* substitute fonts */
+} hpack_subtypes;
+
+#define active_node_size 4 /*number of words in extended active nodes*/
+#define fitness subtype /*|very_loose_fit..tight_fit| on final line for this break*/
+#define break_node(a) vlink((a)+1) /*pointer to the corresponding passive node */
+#define line_number(a) vinfo((a)+1) /*line that begins at this breakpoint*/
+#define total_demerits(a) varmem[(a)+2].cint /* the quantity that \TeX\ minimizes*/
+#define active_short(a) vinfo(a+3) /* |shortfall| of this line */
+#define active_glue(a)  vlink(a+3) /*corresponding glue stretch or shrink*/
+
+#define passive_node_size 7
+#define cur_break(a)                   vlink((a)+1) /*in passive node, points to position of this breakpoint*/
+#define prev_break(a)                  vinfo((a)+1) /*points to passive node that should precede this one */
+#define passive_pen_inter(a)           vinfo((a)+2)
+#define passive_pen_broken(a)          vlink((a)+2)
+#define passive_left_box(a)            vlink((a)+3)
+#define passive_left_box_width(a)      vinfo((a)+3)
+#define passive_last_left_box(a)       vlink((a)+4)
+#define passive_last_left_box_width(a) vinfo((a)+4)
+#define passive_right_box(a)           vlink((a)+5)
+#define passive_right_box_width(a)     vinfo((a)+5)
+#define serial(a)                      vlink((a)+6) /* serial number for symbolic identification*/
+
+#define delta_node_size 10 /* 8 fields, stored in a+1..9 */
+
+#define couple_nodes(a,b) {assert(b!=null);vlink(a)=b;alink(b)=a;}
+#define try_couple_nodes(a,b) if (b==null) vlink(a)=b; else {couple_nodes(a,b);}
+#define uncouple_node(a) {assert(a!=null);vlink(a)=null;alink(a)=null;}
+
+#define cache_disabled max_halfword
+
+extern void delete_attribute_ref(halfword b) ;
+extern void build_attribute_list(halfword b) ;
+
+extern int unset_attribute(halfword n, int c, int w);
+extern void set_attribute(halfword n, int c, int w);
+extern int has_attribute(halfword n, int c, int w);
+
+extern halfword new_span_node (halfword n, int c, scaled w);
+extern halfword string_to_pseudo(integer l,integer pool_ptr, integer nl);
+
+/* TH: these two defines still need checking. The node ordering in luatex is not 
+   quite the same as in tex82 */
+
+#define precedes_break(a) (type((a))<math_node && (type(a)!=whatsit_node || subtype(a)!=dir_node))
+#define non_discardable(a) (type((a))<math_node)
+
+/* from luanode.c */
+
+typedef struct _node_info {
+  int id;
+  int size;
+  char **fields;
+  char *name; 
+}  node_info;
+
+extern node_info node_data[];
+extern node_info whatsit_node_data[];
+extern halfword new_node(int i, int j);
+extern void flush_node_list(halfword);
+extern void flush_node(halfword);
+extern halfword copy_node_list(halfword);
+extern halfword copy_node(halfword);
+extern void check_node(halfword);
+extern void check_node_mem (void);
+extern void fix_node_list (halfword);
+extern int fix_node_lists;
+extern char *sprint_node_mem_usage (void) ;
+extern halfword raw_glyph_node(void) ;
+extern halfword new_glyph_node(void);
+extern int valid_node(halfword);
+
+#define unity 0x10000
+typedef enum {
+  normal_g=0,
+  sfi,
+  fil,
+  fill,
+  filll } glue_orders;
+
+#define zero_glue       0
+#define sfi_glue        zero_glue+glue_spec_size
+#define fil_glue        sfi_glue+glue_spec_size
+#define fill_glue       fil_glue+glue_spec_size
+#define ss_glue         fill_glue+glue_spec_size
+#define fil_neg_glue    ss_glue+glue_spec_size
+#define page_ins_head   fil_neg_glue+glue_spec_size
+#define contrib_head    page_ins_head+temp_node_size
+#define page_head       contrib_head+temp_node_size
+#define temp_head       page_head+temp_node_size
+#define hold_head       temp_head+temp_node_size
+#define adjust_head     hold_head+temp_node_size
+#define pre_adjust_head adjust_head+temp_node_size
+#define active          pre_adjust_head+temp_node_size
+#define align_head      active+active_node_size
+#define end_span        align_head+temp_node_size
+#define begin_point     end_span+glyph_node_size
+#define end_point       begin_point+glyph_node_size
+
+#endif
diff --git a/Build/source/texk/web2c/luatexdir/pdftosrc.1 b/Build/source/texk/web2c/luatexdir/pdftosrc.1
new file mode 100644
index 00000000000..3ee4b680d6f
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/pdftosrc.1
@@ -0,0 +1,219 @@
+.\" Process this file with
+.\" groff -man -Tascii pdftosrc.1
+.\"
+.\" $Id$
+.\"
+.TH pdftosrc 1 "3 November 2005" "User Manuals"
+.SH NAME
+pdftosrc \- extract source file or stream from PDF file
+.SH SYNOPSIS
+.B pdftosrc
+.I PDF-file
+.R [
+.I stream-object-number
+.R ]
+.SH DESCRIPTION
+If only
+.I PDF-file
+is given as argument,
+.B pdftosrc
+extracts the embedded source file
+from the first found stream object
+with /Type /SourceFile within the
+.I PDF-file
+and writes it to a file with the name /SourceName
+as defined in that PDF stream object
+(see application example below).
+
+If both
+.I PDF-file
+and
+.I stream-object-number
+are given as arguments,
+.B pdftosrc
+extracts and uncompresses the PDF stream of the object
+given by its
+.I stream-object-number
+from the
+.I PDF-file
+and writes it to a file named
+.IR PDF-file . stream-object-number
+with the ending
+.I .pdf
+or
+.I .PDF
+stripped from the original
+.I PDF-file
+name.
+
+In either case
+an existing file with the output file name will be overwritten.
+.SH OPTIONS
+None.
+.SH FILES
+Just the executable
+.BR pdftosrc .
+.SH ENVIRONMENT
+None.
+.SH DIAGNOSTICS
+At success the exit code of
+.B pdftosrc
+is 0, else 1.
+
+All messages go to stderr.
+At program invocation,
+.B pdftosrc
+issues the current version number of the program
+.BR xpdf ,
+on which
+.B pdftosrc
+is based:
+
+.RS
+pdftosrc version 3.00
+
+.RE
+When
+.B pdftosrc
+was successful with the output file writing,
+one of the following messages will be issued:
+
+.RS
+Source file extracted to
+.I source-file-name
+
+.RE
+or
+
+.RS
+Stream object extracted to
+.IR PDF-file . stream-object-number
+
+.RE
+
+.RE
+When the object given by the
+.I stream-object-number
+does not contain a stream,
+.B pdftosrc
+issues the following error message:
+
+.RS
+Not a Stream object
+
+.RE
+When the
+.I PDF-file
+can't be opened, the error message is:
+
+.RS
+Error: Couldn't open file
+.RI ' PDF-file '.
+
+.RE
+When
+.B pdftosrc
+encounters an invalid PDF file,
+the error message (several lines) is:
+
+.RS
+Error: May not be a PDF file (continuing anyway)
+.RE
+.RS
+(more lines)
+.RE
+.RS
+Invalid PDF file
+
+.RE
+There are also more error messages from
+.B pdftosrc
+for various kinds of broken PDF files.
+.SH NOTES
+An embedded source file will be written out unchanged,
+i. e. it will not be uncompressed in this process.
+
+Only the stream of the object will be written,
+i. e. not the dictionary of that object.
+
+Knowing which
+.I stream-object-number
+to query requires information about the PDF file
+that has to be gained elsewhere,
+e. g. by looking into the PDF file with an editor.
+
+The stream extraction capabilities of
+.B pdftosrc
+(e. g. regarding understood PDF versions and filter types)
+follow the capabilities of the underlying
+.B xpdf
+program version.
+
+Currently the generation number of the stream object
+is not supported.
+The default value 0 (zero) is taken.
+
+The wording
+.I stream-object-number
+has nothing to do with the `object streams' introduced
+by the Adobe PDF Reference,
+5th edition, version 1.6.
+.SH EXAMPLES
+When using pdftex or pdfetex,
+a source file can be embedded into some
+.I PDF-file
+by using pdftex primitives,
+as illustrated by the following example:
+
+\\immediate\\pdfobj
+.RE
+    stream attr {/Type /SourceFile /SourceName (myfile.zip)}
+.RS
+.RE
+    file{myfile.zip}
+.RS
+.RE
+\\pdfcatalog{/SourceObject \\the\\pdflastobj\\space 0 R}
+
+Then this zip file can be extracted from the
+.I PDF-file
+by calling
+.B pdftosrc
+.IR PDF-file .
+.SH BUGS
+Not all embedded source files will be extracted,
+only the first found one.
+
+Email bug reports to
+.B pdftex@tug.org.
+.SH SEE ALSO
+.BR xpdf (1),
+.BR pdfimages (1),
+.BR pdftotext (1),
+.BR pdftex (1),
+.BR pdfetex (1).
+.SH AUTHORS
+.B pdftosrc
+written by Han The Thanh, using
+.B xpdf
+functionality from Derek Noonburg.
+
+Man page written by Hartmut Henkel.
+.SH COPYRIGHT
+Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
diff --git a/Build/source/texk/web2c/luatexdir/pdftosrc.cc b/Build/source/texk/web2c/luatexdir/pdftosrc.cc
new file mode 100644
index 00000000000..64f1a3174bc
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/pdftosrc.cc
@@ -0,0 +1,178 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+#include <ctype.h>
+#include <aconf.h>
+#include <assert.h>
+#include <GString.h>
+#include <gmem.h>
+#include <gfile.h>
+#include "Object.h"
+#include "Stream.h"
+#include "Array.h"
+#include "Dict.h"
+#include "XRef.h"
+#include "Catalog.h"
+#include "Page.h"
+#include "GfxFont.h"
+#include "PDFDoc.h"
+#include "GlobalParams.h"
+#include "Error.h"
+
+static XRef *xref = 0;
+
+int main(int argc, char *argv[])
+{
+    char *p, buf[1024];
+    PDFDoc *doc;
+    GString *fileName;
+    Stream *s;
+    Object srcStream, srcName, catalogDict;
+    FILE *outfile;
+    char *outname;
+    int objnum = 0, objgen = 0;
+    bool extract_xref_table = false;
+    int c;
+    fprintf(stderr, "pdftosrc version %s\n", xpdfVersion);
+    if (argc < 2) {
+        fprintf(stderr,
+                "Usage: pdftosrc <PDF-file> [<stream-object-number>]\n");
+        exit(1);
+    }
+    fileName = new GString(argv[1]);
+    globalParams = new GlobalParams();
+    doc = new PDFDoc(fileName);
+    if (!doc->isOk()) {
+        fprintf(stderr, "Invalid PDF file\n");
+        exit(1);
+    }
+    if (argc >= 3) {
+        objnum = atoi(argv[2]);
+        if (argc >= 4)
+            objgen = atoi(argv[3]);
+    }
+    xref = doc->getXRef();
+    catalogDict.initNull();
+    xref->getCatalog(&catalogDict);
+    if (!catalogDict.isDict("Catalog")) {
+        fprintf(stderr, "No Catalog found\n");
+        exit(1);
+    }
+    srcStream.initNull();
+    if (objnum == 0) {
+        catalogDict.dictLookup("SourceObject", &srcStream);
+        if (!srcStream.isStream("SourceFile")) {
+            fprintf(stderr, "No SourceObject found\n");
+            exit(1);
+        }
+        srcName.initNull();
+        srcStream.getStream()->getDict()->lookup("SourceName", &srcName);
+        if (!srcName.isString()) {
+            fprintf(stderr, "No SourceName found\n");
+            exit(1);
+        }
+        outname = srcName.getString()->getCString();
+        // We cannot free srcName, as objname shares its string.
+        // srcName.free();
+    } else if (objnum > 0) {
+        xref->fetch(objnum, objgen, &srcStream);
+        if (!srcStream.isStream()) {
+            fprintf(stderr, "Not a Stream object\n");
+            exit(1);
+        }
+        sprintf(buf, "%s", fileName->getCString());
+        if ((p = strrchr(buf, '.')) == 0)
+            p = strchr(buf, 0);
+        if (objgen == 0)
+            sprintf(p, ".%i", objnum);
+        else
+            sprintf(p, ".%i+%i", objnum, objgen);
+        outname = buf;
+    } else {                    // objnum < 0 means we are extracting the XRef table
+        extract_xref_table = true;
+        sprintf(buf, "%s", fileName->getCString());
+        if ((p = strrchr(buf, '.')) == 0)
+            p = strchr(buf, 0);
+        sprintf(p, ".xref");
+        outname = buf;
+    }
+    if (!(outfile = fopen(outname, "wb"))) {
+        fprintf(stderr, "Cannot open file \"%s\" for writing\n", outname);
+        exit(1);
+    }
+    if (extract_xref_table) {
+        int size = xref->getSize();
+        int i;
+        for (i = 0; i < size; i++) {
+            if (xref->getEntry(i)->offset == 0xffffffff)
+                break;
+        }
+        size = i;
+        fprintf(outfile, "xref\n");
+        fprintf(outfile, "0 %i\n", size);
+        for (i = 0; i < size; i++) {
+            XRefEntry *e = xref->getEntry(i);
+            if (e->type != xrefEntryCompressed)
+                fprintf(outfile, "%.10lu %.5i %s\n",
+                        (long unsigned) e->offset, e->gen,
+                        (e->type == xrefEntryFree ? "f" : "n"));
+            else {              // e->offset is the object number of the object stream
+                // e->gen is the local index inside that object stream
+                //int objStrOffset = xref->getEntry(e->offset)->offset;
+                Object tmpObj;
+
+                xref->fetch(i, e->gen, &tmpObj);        // to ensure xref->objStr is set
+                ObjectStream *objStr = xref->getObjStr();
+                assert(objStr != NULL);
+                int *localOffsets = objStr->getOffsets();
+                assert(localOffsets != NULL);
+//                 fprintf(outfile, "%0.10lu %i n\n",
+//                         (long unsigned) (objStrOffset), e->gen);
+                fprintf(outfile, "%.10lu 00000 n\n",
+                        (long unsigned) (objStr->getFirstOffset() +
+                                         localOffsets[e->gen]));
+//                         (long unsigned) (objStrOffset + objStr->getStart() + localOffsets[e->gen]));
+                tmpObj.free();
+            }
+        }
+    } else {
+        s = srcStream.getStream();
+        s->reset();
+        while ((c = s->getChar()) != EOF)
+            fputc(c, outfile);
+        srcStream.free();
+    }
+    if (objnum == 0)
+        fprintf(stderr, "Source file extracted to %s\n", outname);
+    else if (objnum > 0)
+        fprintf(stderr, "Stream object extracted to %s\n", outname);
+    else
+        fprintf(stderr, "Cross-reference table extracted to %s\n", outname);
+    fclose(outfile);
+    catalogDict.free();
+    delete doc;
+    delete globalParams;
+}
diff --git a/Build/source/texk/web2c/luatexdir/pdftosrc.rc b/Build/source/texk/web2c/luatexdir/pdftosrc.rc
new file mode 100644
index 00000000000..6929fbade24
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/pdftosrc.rc
@@ -0,0 +1,35 @@
+/* pdftosrc.rc: pdftosrc resources				-*- C++ -*-
+
+   Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+   This file 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, or (at your
+   option) any later version.
+
+   This file 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 file; if not, write to the Free Software
+   Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+   USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " pdftosrc 2.01"
+
+#define VER_INTERNALNAME_STR "pdftosrc"
+#define VER_ORIGINALFILENAME_STR "pdftosrc.exe"
+
+#define VER_FILEDESCRIPTION_STR "PDF Source Extractor"
+
+#define VER_COMPANYNAME_STR ""
+#define VER_LEGALCOPYRIGHT_STR ""
+
+#include <texlive.version>
+
+/* pdftosrc.rc ends here */
diff --git a/Build/source/texk/web2c/luatexdir/ptexlib.h b/Build/source/texk/web2c/luatexdir/ptexlib.h
new file mode 100644
index 00000000000..aad25eb4ab2
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ptexlib.h
@@ -0,0 +1,615 @@
+/*
+  Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of luatex.
+
+luatex 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.
+
+luatex 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 luatex; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+#ifndef LUATEXLIB
+#  define LUATEXLIB
+
+/* WEB2C macros and prototypes */
+#  if !defined(LUATEXCOERCE)
+#    ifdef luatex
+#      undef luatex             /* to avoid warning about redefining luatex in luatexd.h */
+#    endif                      /* luatex */
+#    define EXTERN extern
+#    include "luatexd.h"
+#  endif
+
+/* pdftexlib macros */
+#  include "ptexmac.h"
+
+#  include "avlstuff.h"
+#  include "image/image.h"
+
+#  include "openbsd-compat.h"
+
+/* pdftexlib type declarations */
+typedef struct {
+    const char *pdfname;
+    const char *t1name;
+    boolean valid;
+} key_entry;
+
+struct _subfont_entry;
+typedef struct _subfont_entry subfont_entry;
+
+struct _subfont_entry {
+    char *infix;                /* infix for this subfont, eg "01" */
+    long charcodes[256];        /* the mapping for this subfont as read from sfd */
+    subfont_entry *next;
+};
+
+typedef struct {
+    char *name;                 /* sfd name, eg "Unicode" */
+    subfont_entry *subfont;     /* linked list of subfonts */
+} sfd_entry;
+
+typedef struct {
+    integer fe_objnum;          /* object number */
+    char *name;                 /* encoding file name */
+    char **glyph_names;         /* array of glyph names */
+    struct avl_table *tx_tree;  /* tree of encoding positions marked as used by TeX */
+} fe_entry;
+
+typedef struct {
+    char *name;                 /* glyph name */
+    long code;                  /* -1 = undefined; -2 = multiple codes, stored
+                                   as string in unicode_seq; otherwise unicode value */
+    char *unicode_seq;          /* multiple unicode sequence */
+} glyph_unicode_entry;
+
+typedef struct {
+    /* parameters scanned from the map file: */
+    char *tfm_name;             /* TFM file name (1st field in map line) */
+    char *sfd_name;             /* subfont directory name, like @sfd_name@ */
+    char *ps_name;              /* PostScript name (optional 2nd field in map line) */
+    integer fd_flags;           /* font descriptor /Flags (PDF Ref. section 5.7.1) */
+    integer slant;              /* SlantFont */
+    integer extend;             /* ExtendFont */
+    char *encname;              /* encoding file name */
+    char *ff_name;              /* font file name */
+    unsigned short type;        /* various flags */
+    short pid;                  /* Pid for truetype fonts */
+    short eid;                  /* Eid for truetype fonts */
+    /* parameters NOT scanned from the map file: */
+    subfont_entry *subfont;     /* subfont mapping */
+    unsigned short links;       /* link flags from tfm_tree and ps_tree */
+    boolean in_use;             /* true if this structure has been referenced already */
+} fm_entry;
+
+typedef struct glw_entry_ {     /* subset glyphs for inclusion in CID-based fonts */
+    unsigned short id;          /* glyph CID */
+    unsigned short wd;          /* glyph width in 1/1000 em parts */
+} glw_entry;
+
+
+/**********************************************************************/
+
+typedef struct {
+    int val;                    /* value */
+    boolean set;                /* true if parameter has been set */
+} intparm;
+
+typedef struct fd_entry_ {
+    integer fd_objnum;          /* object number of the font descriptor object */
+    char *fontname;             /* /FontName (without subset tag) */
+    char *subset_tag;           /* 6-character subset tag */
+    boolean ff_found;
+    integer ff_objnum;          /* object number of the font program stream */
+    integer fn_objnum;          /* font name object number (embedded PDF) */
+    boolean all_glyphs;         /* embed all glyphs? */
+    boolean write_ttf_glyph_names;
+    intparm font_dim[FONT_KEYS_NUM];
+    fe_entry *fe;               /* pointer to encoding structure */
+    char **builtin_glyph_names; /* builtin encoding as read from the Type1 font file */
+    fm_entry *fm;               /* pointer to font map structure */
+    struct avl_table *tx_tree;  /* tree of non-reencoded TeX characters marked as used */
+    struct avl_table *gl_tree;  /* tree of all marked glyphs */
+} fd_entry;
+
+typedef struct fo_entry_ {
+    integer fo_objnum;          /* object number of the font dictionary */
+    internalfontnumber tex_font;        /* needed only for \pdffontattr{} */
+    fm_entry *fm;               /* pointer to font map structure for this font dictionary */
+    fd_entry *fd;               /* pointer to /FontDescriptor object structure */
+    fe_entry *fe;               /* pointer to encoding structure */
+    integer cw_objnum;          /* object number of the font program object */
+    integer first_char;         /* first character used in this font */
+    integer last_char;          /* last character used in this font */
+    struct avl_table *tx_tree;  /* tree of non-reencoded TeX characters marked as used */
+    integer tounicode_objnum;   /* object number of ToUnicode */
+} fo_entry;
+
+/**********************************************************************/
+
+typedef struct {
+    char *ff_name;              /* base name of font file */
+    char *ff_path;              /* full path to font file */
+} ff_entry;
+
+typedef short shalfword;
+typedef struct {
+    integer charcode, cwidth, cheight, xoff, yoff, xescape, rastersize;
+    halfword *raster;
+} chardesc;
+
+/* pdftexlib variable declarations */
+extern boolean true_dimen;
+extern char **t1_glyph_names, *t1_builtin_glyph_names[];
+extern char *cur_file_name;
+extern const char notdef[];
+extern integer t1_length1, t1_length2, t1_length3;
+extern integer ttf_length;
+extern strnumber last_tex_string;
+extern size_t last_ptr_index;
+
+/* loadpool.c */
+
+int loadpoolstrings(integer spare_size);
+
+/* pdftexlib function prototypes */
+
+/* epdf.c */
+extern integer get_fontfile_num(int);
+extern integer get_fontname_num(int);
+extern void epdf_free(void);
+
+/* mapfile.c */
+extern fm_entry *lookup_fontmap(char *);
+extern boolean hasfmentry(internalfontnumber);
+extern void fm_free(void);
+extern void fm_read_info(void);
+extern ff_entry *check_ff_exist(char *, boolean);
+extern void pdfmapfile(integer);
+extern void pdfmapline(integer);
+extern void pdf_init_map_file(string map_name);
+extern fm_entry *new_fm_entry(void);
+extern void delete_fm_entry(fm_entry *);
+extern int avl_do_entry(fm_entry *, int);
+
+/* papersiz.c */
+extern integer myatodim(char **);
+extern integer myatol(char **);
+
+/* pkin.c */
+extern int readchar(boolean, chardesc *);
+
+/* subfont.c */
+extern void sfd_free(void);
+extern boolean handle_subfont_fm(fm_entry *, int);
+
+/* tounicode.c */
+extern void glyph_unicode_free(void);
+extern void def_tounicode(strnumber, strnumber);
+extern integer write_tounicode(char **, char *);
+
+/* utils.c */
+extern boolean str_eq_cstr(strnumber, char *);
+extern char *makecstring(integer);
+extern char *makeclstring(integer, int *);
+extern void print_string(char *j);
+extern void append_string(char *s);
+extern void getcreationdate(void);
+extern void tconfusion(char *s);
+extern void tprint(char *s);
+extern void tprint_nl(char *s);
+extern void tprint_esc(char *s);
+
+#  define overflow_string(a,b) { overflow(maketexstring(a),b); flush_str(last_tex_string); }
+
+extern int xfflush(FILE *);
+extern int xgetc(FILE *);
+extern int xputc(int, FILE *);
+extern scaled ext_xn_over_d(scaled, scaled, scaled);
+extern size_t xfwrite(void *, size_t size, size_t nmemb, FILE *);
+extern strnumber get_resname_prefix(void);
+extern strnumber maketexstring(const char *);
+extern strnumber maketexlstring(const char *, size_t);
+extern integer fb_offset(void);
+extern void fb_flush(void);
+extern void fb_putchar(eight_bits b);
+extern void fb_seek(integer);
+extern void libpdffinish(void);
+extern char *makecfilename(strnumber s);
+extern void make_subset_tag(fd_entry *);
+__attribute__ ((format(printf, 1, 2)))
+extern void pdf_printf(const char *, ...);
+extern void pdf_puts(const char *);
+__attribute__ ((noreturn, format(printf, 1, 2)))
+extern void pdftex_fail(const char *, ...);
+__attribute__ ((format(printf, 1, 2)))
+extern void pdftex_warn(const char *, ...);
+extern void set_job_id(int, int, int, int);
+__attribute__ ((format(printf, 1, 2)))
+extern void tex_printf(const char *, ...);
+extern void write_stream_length(integer, integer);
+extern char *convertStringToPDFString(const char *in, int len);
+extern void print_ID(strnumber);
+extern void print_creation_date();
+extern void print_mod_date();
+extern void escapename(poolpointer in);
+extern void escapestring(poolpointer in);
+extern void escapehex(poolpointer in);
+extern void unescapehex(poolpointer in);
+extern void make_pdftex_banner(void);
+extern void init_start_time();
+extern void remove_pdffile(void);
+extern void garbage_warning(void);
+extern void initversionstring(char **versions);
+extern int newcolorstack(integer s, integer literal_mode, boolean pagestart);
+extern int colorstackused();
+extern integer colorstackset(int colstack_no, integer s);
+extern integer colorstackpush(int colstack_no, integer s);
+extern integer colorstackpop(int colstack_no);
+extern integer colorstackcurrent(int colstack_no);
+extern integer colorstackskippagestart(int colstack_no);
+extern void checkpdfsave(int cur_h, int cur_v);
+extern void checkpdfrestore(int cur_h, int cur_v);
+extern void pdfshipoutbegin(boolean shipping_page);
+extern void pdfshipoutend(boolean shipping_page);
+extern void pdfsetmatrix(poolpointer in, scaled cur_h, scaled cur_v);
+extern void matrixtransformpoint(scaled x, scaled y);
+extern void matrixtransformrect(scaled llx, scaled lly, scaled urx, scaled ury);
+extern boolean matrixused();
+extern void matrixrecalculate(scaled urx);
+extern scaled getllx();
+extern scaled getlly();
+extern scaled geturx();
+extern scaled getury();
+
+/* writeenc.c */
+extern fe_entry *get_fe_entry(char *);
+extern void enc_free(void);
+extern void write_fontencodings(void);
+
+/* writefont.c */
+extern void do_pdf_font(integer, internalfontnumber);
+extern fd_entry *lookup_fd_entry(char *, integer, integer);
+extern fd_entry *new_fd_entry(void);
+extern void write_fontstuff();
+
+/* writeimg.c */
+extern boolean check_image_b(integer);
+extern boolean check_image_c(integer);
+extern boolean check_image_i(integer);
+extern boolean is_pdf_image(integer);
+extern integer epdforigx(integer);
+extern integer epdforigy(integer);
+extern integer image_pages(integer);
+extern integer image_index(integer);
+extern integer image_width(integer);
+extern integer image_height(integer);
+extern integer image_depth(integer);
+extern integer image_objnum(integer);
+extern integer image_imgnum(integer);
+extern integer new_image_entry(void);
+extern integer read_image(integer, integer, strnumber, integer, strnumber,
+                          strnumber, integer, integer, integer, integer);
+extern void img_free(void);
+extern void update_image_procset(integer);
+extern void write_image(integer);
+extern integer image_colordepth(integer img);
+extern void scale_image(integer);
+extern void set_image_dimensions(integer, integer, integer, integer);
+extern void set_image_index(integer, integer);
+extern void out_image(integer, scaled, scaled);
+
+/* writejbig2.c */
+extern void flush_jbig2_page0_objects();
+
+/* writet1.c */
+extern boolean t1_subset(char *, char *, unsigned char *);
+extern char **load_enc_file(char *);
+extern void writet1(fd_entry *);
+extern void t1_free(void);
+
+/* writet3.c */
+extern void writet3(int, internalfontnumber);
+extern scaled get_pk_char_width(internalfontnumber, scaled);
+
+/* writettf.c */
+extern void writettf(fd_entry *);
+extern void writeotf(fd_entry *);
+extern void ttf_free(void);
+
+/* writezip.c */
+extern void write_zip(boolean);
+extern void zip_free(void);
+
+/* avlstuff.c */
+extern int comp_int_entry(const void *, const void *, void *);
+extern int comp_string_entry(const void *, const void *, void *);
+extern void avl_put_obj(integer, integer);
+extern integer avl_find_obj(integer, integer, integer);
+
+/**********************************************************************/
+static const key_entry font_key[FONT_KEYS_NUM] = {
+    {"Ascent", "Ascender", 1}
+    , {"CapHeight", "CapHeight", 1}
+    , {"Descent", "Descender", 1}
+    , {"ItalicAngle", "ItalicAngle", 1}
+    , {"StemV", "StdVW", 1}
+    , {"XHeight", "XHeight", 1}
+    , {"FontBBox", "FontBBox", 1}
+    , {"", "", 0}
+    , {"", "", 0}
+    , {"", "", 0}
+    , {"FontName", "FontName", 1}
+};
+
+/**********************************************************************/
+
+typedef enum {
+    no_print = 16,
+    term_only = 17,
+    log_only = 18,
+    term_and_log = 19,
+    pseudo = 20,
+    new_string = 21
+} selector_settings;
+
+
+#  include "font/texfont.h"
+
+/* language stuff */
+
+typedef struct _lang_variables {
+    int pre_hyphen_char;
+    int post_hyphen_char;
+} lang_variables;
+
+
+#  include "hyphen.h"
+
+struct tex_language {
+    HyphenDict *patterns;
+    int exceptions;             /* lua registry pointer, should be replaced */
+    int id;
+    int pre_hyphen_char;
+    int post_hyphen_char;
+};
+
+#  define MAX_WORD_LEN 256      /* in chars */
+
+extern struct tex_language *new_language(void);
+extern struct tex_language *get_language(int n);
+extern void load_patterns(struct tex_language *lang, unsigned char *buf);
+extern void load_hyphenation(struct tex_language *lang, unsigned char *buf);
+extern int hyphenate_string(struct tex_language *lang, char *w, char **ret);
+
+extern void new_hyphenation(halfword h, halfword t);
+extern void clear_patterns(struct tex_language *lang);
+extern void clear_hyphenation(struct tex_language *lang);
+extern char *clean_hyphenation(char *buffer, char **cleaned);
+extern void hnj_hyphenation(halfword head, halfword tail);
+
+extern void set_pre_hyphen_char(integer lan, integer val);
+extern void set_post_hyphen_char(integer lan, integer val);
+extern integer get_pre_hyphen_char(integer lan);
+extern integer get_post_hyphen_char(integer lan);
+
+extern halfword new_ligkern(halfword head, halfword tail);
+extern halfword handle_ligaturing(halfword head, halfword tail);
+extern halfword handle_kerning(halfword head, halfword tail);
+
+#  define push_dir(a)								\
+  { dir_tmp=new_dir((a));						\
+	vlink(dir_tmp)=dir_ptr; dir_ptr=dir_tmp;	\
+	dir_ptr=dir_tmp;							\
+  }
+
+#  define push_dir_node(a)						\
+  { dir_tmp=new_node(whatsit_node,dir_node);	\
+    dir_dir(dir_tmp)=dir_dir((a));				\
+    dir_level(dir_tmp)=dir_level((a));			\
+    dir_dvi_h(dir_tmp)=dir_dvi_h((a));			\
+    dir_dvi_ptr(dir_tmp)=dir_dvi_ptr((a));		\
+    vlink(dir_tmp)=dir_ptr; dir_ptr=dir_tmp;	\
+  }
+
+#  define pop_dir_node()					\
+  { dir_tmp=dir_ptr;					\
+    dir_ptr=vlink(dir_tmp);				\
+    flush_node(dir_tmp);				\
+  }
+
+
+
+#  define dir_parallel(a,b) (((a) % 2)==((b) % 2))
+#  define dir_orthogonal(a,b) (((a) % 2)!=((b) % 2))
+
+#  define is_rotated(a) dir_parallel(dir_secondary[(a)],dir_tertiary[(a)])
+
+void initialize_active(void);
+
+halfword find_protchar_left(halfword l, boolean d);
+halfword find_protchar_right(halfword l, halfword r);
+
+void ext_do_line_break(boolean d,
+                       int pretolerance,
+                       int tracing_paragraphs,
+                       int tolerance,
+                       scaled emergency_stretch,
+                       int looseness,
+                       int hyphen_penalty,
+                       int ex_hyphen_penalty,
+                       int pdf_adjust_spacing,
+                       halfword par_shape_ptr,
+                       int adj_demerits,
+                       int pdf_protrude_chars,
+                       int line_penalty,
+                       int last_line_fit,
+                       int double_hyphen_demerits,
+                       int final_hyphen_demerits,
+                       int hang_indent,
+                       int hsize,
+                       int hang_after,
+                       halfword left_skip,
+                       halfword right_skip,
+                       int pdf_each_line_height,
+                       int pdf_each_line_depth,
+                       int pdf_first_line_height,
+                       int pdf_last_line_depth,
+                       halfword inter_line_penalties_ptr,
+                       int inter_line_penalty,
+                       int club_penalty,
+                       halfword club_penalties_ptr,
+                       halfword display_widow_penalties_ptr,
+                       halfword widow_penalties_ptr,
+                       int display_widow_penalty,
+                       int widow_penalty,
+                       int broken_penalty, halfword final_par_glue);
+
+void ext_post_line_break(boolean d,
+                         int right_skip,
+                         int left_skip,
+                         int pdf_protrude_chars,
+                         halfword par_shape_ptr,
+                         int pdf_adjust_spacing,
+                         int pdf_each_line_height,
+                         int pdf_each_line_depth,
+                         int pdf_first_line_height,
+                         int pdf_last_line_depth,
+                         halfword inter_line_penalties_ptr,
+                         int inter_line_penalty,
+                         int club_penalty,
+                         halfword club_penalties_ptr,
+                         halfword display_widow_penalties_ptr,
+                         halfword widow_penalties_ptr,
+                         int display_widow_penalty,
+                         int widow_penalty,
+                         int broken_penalty,
+                         halfword final_par_glue,
+                         halfword best_bet,
+                         halfword last_special_line,
+                         scaled second_width,
+                         scaled second_indent,
+                         scaled first_width,
+                         scaled first_indent, halfword best_line);
+
+halfword lua_hpack_filter(halfword head_node, scaled size, int pack_type,
+                          int extrainfo);
+void lua_node_filter(int filterid, int extrainfo, halfword head_node,
+                     halfword * tail_node);
+halfword lua_vpack_filter(halfword head_node, scaled size, int pack_type,
+                          scaled maxd, int extrainfo);
+void lua_node_filter_s(int filterid, char *extrainfo, halfword head_node,
+                       halfword * tail_node);
+
+void load_tex_patterns(int curlang, halfword head);
+void load_tex_hyphenation(int curlang, halfword head);
+
+/* textcodes.c */
+void set_lc_code(integer n, halfword v, quarterword gl);
+halfword get_lc_code(integer n);
+void set_uc_code(integer n, halfword v, quarterword gl);
+halfword get_uc_code(integer n);
+void set_sf_code(integer n, halfword v, quarterword gl);
+halfword get_sf_code(integer n);
+void set_cat_code(integer h, integer n, halfword v, quarterword gl);
+halfword get_cat_code(integer h, integer n);
+void unsave_cat_codes(integer h, quarterword gl);
+int valid_catcode_table(int h);
+void unsave_text_codes(quarterword grouplevel);
+void initialize_text_codes(void);
+void dump_text_codes(void);
+void undump_text_codes(void);
+
+/* mathcodes.c */
+
+void set_math_code(integer n, halfword v, quarterword gl);
+halfword get_math_code(integer n);
+void set_del_code(integer n, halfword v, halfword w, quarterword gl);
+halfword get_del_code_a(integer n);
+halfword get_del_code_b(integer n);
+void unsave_math_codes(quarterword grouplevel);
+void initialize_math_codes(void);
+void dump_math_codes(void);
+void undump_math_codes(void);
+
+/* texlang.c */
+
+void dump_language_data(void);
+void undump_language_data(void);
+char *exception_strings(struct tex_language *lang);
+
+/* llualib.c */
+
+void dump_luac_registers(void);
+void undump_luac_registers(void);
+
+/* ltexlib.c */
+void luacstring_start(int n);
+void luacstring_close(int n);
+int luacstring_detokenized(void);
+int luacstring_defaultcattable(void);
+integer luacstring_cattable(void);
+int luacstring_simple(void);
+int luacstring_penultimate(void);
+int luacstring_input(void);
+
+
+/* luatoken.c */
+void do_get_token_lua(integer callback_id);
+
+/* luanode.c */
+int visible_last_node_type(int n);
+void print_node_mem_stats(int n, int o);
+
+/* writeimg.c */
+integer epdf_orig_y(integer i);
+integer epdf_orig_x(integer i);
+
+/* limglib.c */
+void lua_setximage(integer i);
+
+/* vfovf.c */
+void vf_expand_local_fonts(internal_font_number f);
+internal_font_number letter_space_font(halfword u, internal_font_number f,
+                                       integer e);
+internal_font_number auto_expand_font(internal_font_number f, integer e);
+str_number expand_font_name(internal_font_number f, integer e);
+void pdf_check_vf_cur_val(void);
+
+/* ltexiolib.c */
+void flush_loggable_info(void);
+
+/* luastuff.c */
+void closelua(int n);
+void luacall(int n, int s);
+void luatokencall(int n, int p);
+
+void tex_error(char *msg, char **hlp);
+
+scaled divide_scaled(scaled s, scaled m, integer dd);
+scaled divide_scaled_n(double s, double m, double d);
+
+/* texpdf.c */
+void pdf_print_char(internal_font_number f, integer c);
+void pdf_print(str_number n);
+void pdf_print_str(str_number n);
+void pdf_print_int(integer n);
+
+/* textoken.c */
+
+void get_next(void);
+void get_token_lua(void);
+
+#endif                          /* PDFTEXLIB */
diff --git a/Build/source/texk/web2c/luatexdir/ptexmac.h b/Build/source/texk/web2c/luatexdir/ptexmac.h
new file mode 100644
index 00000000000..2f795ce3e71
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ptexmac.h
@@ -0,0 +1,236 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+#ifndef PDFTEXMAC
+#  define PDFTEXMAC
+
+/* Not all systems define it. */
+#  ifndef M_PI
+#    define M_PI           3.14159265358979323846
+                                                /* pi */
+#    define M_PI_2         1.5707963267948966192E0
+                                                /*Hex  2^ 0 * 1.921FB54442D18 */
+#    define M_PI_4         7.8539816339744830962E-1
+                                                /*Hex  2^-1 * 1.921FB54442D18 */
+#  endif
+
+#  ifdef WIN32
+/* Why relying on gmalloc() ???*/
+#    define gmalloc(n) xmalloc(n)
+#    define gfree(p) free(p)
+#    define inline __inline
+#    define srandom(n) srand(n)
+#    define random() rand()
+#  endif
+
+/* Pascal WEB macros */
+#  define maxinteger 0x7FFFFFFF
+#  define maxdimen   0x3FFFFFFF
+
+#  define objinfo(n) objtab[n].int0
+
+#  define pdfroom(n) do {                                      \
+    if ((unsigned)(n + pdf_ptr) > (unsigned)pdf_buf_size) {     \
+        if (pdf_os_mode)                                       \
+            zpdf_os_get_os_buf(n);                               \
+        else {                                               \
+            if ((unsigned)(n) > (unsigned)pdf_buf_size)        \
+                pdftex_fail("PDF output buffer overflowed"); \
+            else                                             \
+                pdf_flush();                                  \
+        }                                                    \
+    }                                                        \
+} while (0)
+
+#  define pdfout(c)  do {   \
+    pdfroom(1);           \
+    pdf_buf[pdf_ptr++] = c; \
+} while (0)
+
+#  define pdfoffset()     (pdf_gone + pdf_ptr)
+
+#  define MAX_CHAR_CODE       255
+#  define PRINTF_BUF_SIZE     1024
+#  define MAX_CSTRING_LEN     1024 * 1024
+#  define MAX_PSTRING_LEN     1024
+#  define SMALL_BUF_SIZE      256
+#  define SMALL_ARRAY_SIZE    256
+#  define FONTNAME_BUF_SIZE   128
+                                /* a PDF name can be maximum 127 chars long */
+
+#  define pdftex_debug    tex_printf
+
+extern void check_buffer_overflow(int wsize);
+extern void check_pool_overflow (int wsize);
+
+#  define check_buf(size, buf_size)										\
+  if ((unsigned)(size) > (unsigned)(buf_size))							\
+	pdftex_fail("buffer overflow: %d > %d at file %s, line %d",			\
+				(int)(size), (int)(buf_size), __FILE__,  __LINE__ )
+
+#  define append_char_to_buf(c, p, buf, buf_size) do {       \
+    if (c == 9)                                            \
+        c = 32;                                            \
+    if (c == 13 || c == EOF)                               \
+        c = 10;                                            \
+    if (c != ' ' || (p > buf && p[-1] != 32)) {            \
+        check_buf(p - buf + 1, (buf_size));                \
+        *p++ = c;                                          \
+    }                                                      \
+} while (0)
+
+#  define append_eol(p, buf, buf_size) do {                  \
+    check_buf(p - buf + 2, (buf_size));                    \
+    if (p - buf > 1 && p[-1] != 10)                        \
+        *p++ = 10;                                         \
+    if (p - buf > 2 && p[-2] == 32) {                      \
+        p[-2] = 10;                                        \
+        p--;                                               \
+    }                                                      \
+    *p = 0;                                                \
+} while (0)
+
+#  define remove_eol(p, buf) do {                            \
+    p = strend(buf) - 1;                                   \
+    if (*p == 10)                                          \
+        *p = 0;                                            \
+} while (0)
+
+#  define skip(p, c)   if (*p == c)  p++
+
+#  define alloc_array(T, n, s) do {                           \
+    if (T##_array == NULL) {                                \
+        T##_limit = (s);                                    \
+        if ((unsigned)(n) > T##_limit)                      \
+            T##_limit = (n);                                \
+        T##_array = xtalloc(T##_limit, T##_entry);          \
+        T##_ptr = T##_array;                                \
+    }                                                       \
+    else if ((unsigned)(T##_ptr - T##_array + (n)) > T##_limit) {       \
+        last_ptr_index = T##_ptr - T##_array;               \
+        T##_limit *= 2;                                     \
+        if ((unsigned)(T##_ptr - T##_array + (n)) > T##_limit)          \
+            T##_limit = T##_ptr - T##_array + (n);          \
+        xretalloc(T##_array, T##_limit, T##_entry);         \
+        T##_ptr = T##_array + last_ptr_index;               \
+    }                                                       \
+} while (0)
+
+#  define is_cfg_comment(c) \
+    (c == 10 || c == '*' || c == '#' || c == ';' || c == '%')
+
+#  define define_array(T)                     \
+T##_entry      *T##_ptr, *T##_array = NULL;    \
+size_t          T##_limit
+
+#  define xfree(p)            do { if (p != NULL) free(p); p = NULL; } while (0)
+#  define strend(s)           strchr(s, 0)
+#  define xtalloc             XTALLOC
+#  define xretalloc           XRETALLOC
+
+#  define ASCENT_CODE         0
+#  define CAPHEIGHT_CODE      1
+#  define DESCENT_CODE        2
+#  define ITALIC_ANGLE_CODE   3
+#  define STEMV_CODE          4
+#  define XHEIGHT_CODE        5
+#  define FONTBBOX1_CODE      6
+#  define FONTBBOX2_CODE      7
+#  define FONTBBOX3_CODE      8
+#  define FONTBBOX4_CODE      9
+#  define FONTNAME_CODE       10
+#  define GEN_KEY_NUM         (XHEIGHT_CODE + 1)
+#  define MAX_KEY_CODE        (FONTBBOX1_CODE + 1)
+#  define INT_KEYS_NUM        (FONTBBOX4_CODE + 1)
+#  define FONT_KEYS_NUM       (FONTNAME_CODE + 1)
+
+#  define F_INCLUDED          0x01
+#  define F_SUBSETTED         0x02
+#  define F_STDT1FONT         0x04
+#  define F_SUBFONT           0x08
+#  define F_TYPE1             0x10
+#  define F_TRUETYPE          0x20
+#  define F_OTF               0x40
+#  define F_CIDKEYED          0x80
+
+#  define set_included(fm)    ((fm)->type |= F_INCLUDED)
+#  define set_subsetted(fm)   ((fm)->type |= F_SUBSETTED)
+#  define set_std_t1font(fm)  ((fm)->type |= F_STDT1FONT)
+#  define set_subfont(fm)     ((fm)->type |= F_SUBFONT)
+#  define set_type1(fm)       ((fm)->type |= F_TYPE1)
+#  define set_truetype(fm)    ((fm)->type |= F_TRUETYPE)
+#  define set_opentype(fm)    ((fm)->type |= F_OTF)
+#  define set_subfont(fm)     ((fm)->type |= F_SUBFONT)
+#  define set_cidkeyed(fm)    ((fm)->type |= F_CIDKEYED)
+
+#  define unset_included(fm)  ((fm)->type &= ~F_INCLUDED)
+#  define unset_subsetted(fm) ((fm)->type &= ~F_SUBSETTED)
+#  define unset_std_t1font(fm)((fm)->type &= ~F_STDT1FONT)
+#  define unset_subfont(fm)   ((fm)->type &= ~F_SUBFONT)
+#  define unset_type1(fm)     ((fm)->type &= ~F_TYPE1)
+#  define unset_truetype(fm)  ((fm)->type &= ~F_TRUETYPE)
+#  define unset_opentype(fm)  ((fm)->type &= ~F_OTF)
+#  define unset_subfont(fm)   ((fm)->type &= ~F_SUBFONT)
+#  define unset_cidkeyed(fm)  ((fm)->type &= ~F_CIDKEYED)
+
+#  define is_included(fm)     (((fm)->type & F_INCLUDED) != 0)
+#  define is_subsetted(fm)    (((fm)->type & F_SUBSETTED) != 0)
+#  define is_std_t1font(fm)   (((fm)->type & F_STDT1FONT) != 0)
+#  define is_subfont(fm)      (((fm)->type & F_SUBFONT) != 0)
+#  define is_type1(fm)        (((fm)->type & F_TYPE1) != 0)
+#  define is_truetype(fm)     (((fm)->type & F_TRUETYPE) != 0)
+#  define is_opentype(fm)     (((fm)->type & F_OTF) != 0)
+#  define is_subfont(fm)      (((fm)->type & F_SUBFONT) != 0)
+#  define is_cidkeyed(fm)     (((fm)->type & F_CIDKEYED) != 0)
+
+#  define fm_slant(fm)        (fm)->slant
+#  define fm_extend(fm)       (fm)->extend
+#  define fm_fontfile(fm)     (fm)->ff_name
+
+#  define is_reencoded(fm)    ((fm)->encname != NULL)
+#  define is_fontfile(fm)     (fm_fontfile(fm) != NULL)
+#  define is_t1fontfile(fm)   (is_fontfile(fm) && is_type1(fm))
+#  define is_builtin(fm)      (!is_fontfile(fm))
+
+#  define LINK_TFM            0x01
+#  define LINK_PS             0x02
+#  define set_tfmlink(fm)     ((fm)->links |= LINK_TFM)
+#  define set_pslink(fm)      ((fm)->links |= LINK_PS)
+#  define unset_tfmlink(fm)   ((fm)->links &= ~LINK_TFM)
+#  define unset_pslink(fm)    ((fm)->links &= ~LINK_PS)
+#  define has_tfmlink(fm)     ((fm)->links & LINK_TFM)
+#  define has_pslink(fm)      ((fm)->links & LINK_PS)
+
+
+#  define set_cur_file_name(s)      \
+    cur_file_name = s;      \
+    pack_file_name(maketexstring(cur_file_name), get_nullstr(), get_nullstr())
+
+#  define cmp_return(a, b) \
+    if ((a) > (b))         \
+        return 1;        \
+    if ((a) < (b))         \
+        return -1
+
+#  define str_prefix(s1, s2)  (strncmp((s1), (s2), strlen(s2)) == 0)
+
+#endif                          /* PDFTEXMAC */
diff --git a/Build/source/texk/web2c/luatexdir/svnversion.h b/Build/source/texk/web2c/luatexdir/svnversion.h
new file mode 100644
index 00000000000..9a139c2d294
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/svnversion.h
@@ -0,0 +1,3 @@
+#define BUILD_REVISION "$Revision: 915 $"
+#define BUILD_DATE 20071128
+#define BUILD_TIME 1092554
diff --git a/Build/source/texk/web2c/luatexdir/tex/linebreak.c b/Build/source/texk/web2c/luatexdir/tex/linebreak.c
new file mode 100644
index 00000000000..910d26b9f27
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tex/linebreak.c
@@ -0,0 +1,2095 @@
+/* $Id: linebreak.c 1102 2008-03-11 09:52:54Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+/* Glue nodes in a horizontal list that is being paragraphed are not supposed to
+   include ``infinite'' shrinkability; that is why the algorithm maintains
+   four registers for stretching but only one for shrinking. If the user tries to
+   introduce infinite shrinkability, the shrinkability will be reset to finite
+   and an error message will be issued. A boolean variable |no_shrink_error_yet|
+   prevents this error message from appearing more than once per paragraph.
+*/
+
+#define check_shrinkage(a)				\
+  if ((shrink_order((a))!=normal)&&(shrink((a))!=0))	\
+    a=finite_shrink((a))
+
+static boolean no_shrink_error_yet; /*have we complained about infinite shrinkage?*/
+
+halfword 
+finite_shrink(halfword p) { /* recovers from infinite shrinkage */
+  halfword q; /*new glue specification*/
+  char *hlp[] = { 
+    "The paragraph just ended includes some glue that has",
+    "infinite shrinkability, e.g., `\\hskip 0pt minus 1fil'.",
+    "Such glue doesn't belong there---it allows a paragraph",
+    "of any length to fit on one line. But it's safe to proceed,",
+    "since the offensive shrinkability has been made finite.",
+    NULL };    
+  if (no_shrink_error_yet) {
+    no_shrink_error_yet=false;
+    tex_error("Infinite glue shrinkage found in a paragraph",hlp);
+  }
+  q=new_spec(p); shrink_order(q)=normal;
+  delete_glue_ref(p); 
+  return q;
+}
+
+/* A pointer variable |cur_p| runs through the given horizontal list as we look
+   for breakpoints. This variable is global, since it is used both by |line_break|
+   and by its subprocedure |try_break|.
+
+   Another global variable called |threshold| is used to determine the feasibility
+   of individual lines: breakpoints are feasible if there is a way to reach
+   them without creating lines whose badness exceeds |threshold|.  (The
+   badness is compared to |threshold| before penalties are added, so that
+   penalty values do not affect the feasibility of breakpoints, except that
+   no break is allowed when the penalty is 10000 or more.) If |threshold|
+   is 10000 or more, all legal breaks are considered feasible, since the
+   |badness| function specified above never returns a value greater than~10000.
+   
+   Up to three passes might be made through the paragraph in an attempt to find at
+   least one set of feasible breakpoints. On the first pass, we have
+   |threshold=pretolerance| and |second_pass=final_pass=false|.
+   If this pass fails to find a
+   feasible solution, |threshold| is set to |tolerance|, |second_pass| is set
+   |true|, and an attempt is made to hyphenate as many words as possible.
+   If that fails too, we add |emergency_stretch| to the background
+   stretchability and set |final_pass=true|.
+*/
+
+static boolean second_pass; /* is this our second attempt to break this paragraph? */
+static boolean final_pass; /*is this our final attempt to break this paragraph? */
+static integer threshold; /* maximum badness on feasible lines */
+
+/* skipable nodes at the margins during character protrusion */
+
+#define cp_skipable(a) ((! is_char_node((a))) &&			\
+			((type((a)) == ins_node)			\
+			 || (type((a)) == mark_node)			\
+			 || (type((a)) == adjust_node)			\
+			 || (type((a)) == penalty_node)			\
+			 || ((type((a)) == whatsit_node) &&		\
+			     (subtype((a)) != pdf_refximage_node) &&	\
+			     (subtype((a)) != pdf_refxform_node))	\
+			 /* reference to an image or XObject form */	\
+			 || ((type((a)) == disc_node) &&		\
+			     (vlink_pre_break(a) == null) &&		\
+			     (vlink_post_break(a) == null) &&		\
+			     (vlink_no_break(a) == null))		\
+			 /* an empty |disc_node| */			\
+			 || ((type((a)) == math_node) &&		\
+			     (surround((a)) == 0))			\
+			 || ((type((a)) == kern_node) &&		\
+			     ((width((a)) == 0) ||			\
+			      (subtype((a)) == normal)))		\
+			 || ((type((a)) == glue_node) &&		\
+			     (glue_ptr((a)) == zero_glue))		\
+			 || ((type((a)) == hlist_node) &&		\
+			     (width((a)) == 0) &&			\
+			     (height((a)) == 0) &&			\
+			     (depth((a)) == 0) &&			\
+			     (list_ptr((a)) == null))			\
+			 ))
+
+/* maximum fill level for |hlist_stack|*/
+#define max_hlist_stack 512 /* maybe good if larger than |2 *
+			       max_quarterword|, so that box nesting
+			       level would overflow first */
+
+/* stack for |find_protchar_left()| and |find_protchar_right()| */
+static halfword hlist_stack[max_hlist_stack]; 
+
+/* fill level for |hlist_stack| */
+static short hlist_stack_level = 0; 
+
+void push_node(halfword p) {
+  if (hlist_stack_level >= max_hlist_stack) 
+    pdf_error("push_node", "stack overflow");
+  hlist_stack[hlist_stack_level++] = p;
+}
+
+halfword pop_node (void) {
+  if (hlist_stack_level <= 0) /* would point to some bug */
+    pdf_error("pop_node", "stack underflow (internal error)");
+  return hlist_stack[--hlist_stack_level];
+}
+
+#define null_font 0
+
+static integer max_stretch_ratio=0; /*maximal stretch ratio of expanded fonts*/
+static integer max_shrink_ratio=0; /*maximal shrink ratio of expanded fonts*/
+static integer cur_font_step=0; /*the current step of expanded fonts*/
+
+
+boolean check_expand_pars(internal_font_number f) {
+  internal_font_number k;
+  
+  if ((pdf_font_step(f) == 0) || ((pdf_font_stretch(f) == null_font)  &&
+								  (pdf_font_shrink(f) == null_font)))
+    return false;
+  if (cur_font_step < 0)
+    cur_font_step = pdf_font_step(f);
+  else if (cur_font_step != pdf_font_step(f)) 
+    pdf_error("font expansion", 
+	      "using fonts with different step of expansion in one paragraph is not allowed");
+  k = pdf_font_stretch(f);
+  if( k != null_font) {
+    if (max_stretch_ratio < 0)
+      max_stretch_ratio = pdf_font_expand_ratio(k);
+    else if (max_stretch_ratio != pdf_font_expand_ratio(k)) 
+      pdf_error("font expansion", 
+		"using fonts with different limit of expansion in one paragraph is not allowed");
+  }
+  k = pdf_font_shrink(f);
+  if( k != null_font) {
+    if (max_shrink_ratio < 0) 
+      max_shrink_ratio = -pdf_font_expand_ratio(k);
+    else if (max_shrink_ratio != -pdf_font_expand_ratio(k)) 
+      pdf_error("font expansion", 
+		"using fonts with different limit of expansion in one paragraph is not allowed");
+  }
+  return true;
+}
+
+/* searches left to right from list head |l|, returns 1st non-skipable item*/
+/*public*/ halfword find_protchar_left(halfword l, boolean d) {
+  halfword t;
+  boolean run;
+  if ((vlink(l) != null) && (type(l) == hlist_node) && (width(l) == 0)
+      && (height(l) == 0) && (depth(l) == 0) && (list_ptr(l) == null)) {
+    l = vlink(l); /*for paragraph start with \.{\\parindent = 0pt*/
+  } else if (d) {
+    while ((vlink(l) != null) && (!(is_char_node(l) || non_discardable(l)))) {
+      l = vlink(l); /* std.\ discardables at line break, \TeX book, p 95 */
+    }
+  }
+  hlist_stack_level = 0;
+  run = true;
+  do {
+    t = l;
+    while (run && (type(l) == hlist_node) && (list_ptr(l) != null)) {
+      push_node(l);
+      l = list_ptr(l);
+    }
+    while (run && cp_skipable(l)) {
+      while ((vlink(l) == null) && (hlist_stack_level > 0)) {
+	l = pop_node(); /* don't visit this node again */
+      }
+      if (vlink(l) != null)
+	l = vlink(l);
+      else if (hlist_stack_level == 0) 
+	run = false;
+    }
+  } while (t != l);
+  return l;
+}
+
+
+/* searches right to left from list tail |r| to head |l|, returns 1st non-skipable item */
+/*public*/ halfword find_protchar_right(halfword l, halfword r) {
+  halfword  t;
+  boolean run;
+  if (r == null) 
+    return null;
+  hlist_stack_level = 0;
+  run = true;
+  do {
+    t = r;
+    while (run && (type(r) == hlist_node) && (list_ptr(r) != null)) {
+      push_node(l);
+      push_node(r);
+      l = list_ptr(r);
+      r = l;
+      while (vlink(r) != null) {
+        halfword s = r;
+        r = vlink(r);
+        alink(r) = s;
+      }
+    }
+    while (run && cp_skipable(r)) {
+      while ((r == l) && (hlist_stack_level > 0)) {
+		r = pop_node(); /* don't visit this node again */
+		l = pop_node();
+      }
+      if ((r != l) && (r != null) ) {
+        assert(vlink(alink(r))==r);
+        r = alink(r);
+      } else if ((r == l) && (hlist_stack_level == 0)) 
+		run = false;
+    }
+  } while (t != r);
+  return r;
+}
+
+#define left_pw(a) char_pw((a), left_side)
+#define right_pw(a) char_pw((a), right_side)
+
+#if 0
+/* returns the total width of character protrusion of a line;
+  |cur_break(break_node(q))| and |p| is the leftmost resp. rightmost
+  node in the horizontal list representing the actual line */
+
+scaled total_pw (halfword first_p, halfword q, halfword p) {
+  halfword l, r;
+  l = (break_node(q) == null) ? first_p : cur_break(break_node(q));
+  assert(vlink(alink(p))==p);
+  r = alink(r);
+  /* let's look at the right margin first */
+  if ((p != null) && (type(p) == disc_node) && (vlink(pre_break(p)) != null)) {
+    /* a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break| */
+    r = vlink(pre_break(p));
+    while (vlink(r) != null) 
+      r = vlink(r);
+  } else { 
+    r = find_protchar_right(l, r);
+  }
+  /* now the left margin */
+  if ((l != null) && (type(l) == disc_node)) {
+    if (vlink(post_break(l)) != null) {
+      l = vlink(post_break(l)); /* protrude the first char */
+      goto DONE;
+    }
+  }
+  l = find_protchar_left(l, true);
+DONE:
+  return (left_pw(l) + right_pw(r));
+}
+#endif
+
+
+/* When looking for optimal line breaks, \TeX\ creates a ``break node'' for
+   each break that is {\sl feasible}, in the sense that there is a way to end
+   a line at the given place without requiring any line to stretch more than
+   a given tolerance. A break node is characterized by three things: the position
+   of the break (which is a pointer to a |glue_node|, |math_node|, |penalty_node|,
+   or |disc_node|); the ordinal number of the line that will follow this
+   breakpoint; and the fitness classification of the line that has just
+   ended, i.e., |tight_fit|, |decent_fit|, |loose_fit|, or |very_loose_fit|.
+*/
+
+typedef enum {
+  very_loose_fit = 0, /* fitness classification for lines stretching more than
+						 their stretchability */
+  loose_fit,  /* fitness classification for lines stretching 0.5 to 1.0 of their
+				 stretchability */
+  decent_fit, /* fitness classification for all other lines*/
+  tight_fit  /* fitness classification for lines shrinking 0.5 to 1.0 of their
+				shrinkability */
+} fitness_value ;
+
+
+/* The algorithm essentially determines the best possible way to achieve
+   each feasible combination of position, line, and fitness. Thus, it answers
+   questions like, ``What is the best way to break the opening part of the
+   paragraph so that the fourth line is a tight line ending at such-and-such
+   a place?'' However, the fact that all lines are to be the same length
+   after a certain point makes it possible to regard all sufficiently large
+   line numbers as equivalent, when the looseness parameter is zero, and this
+   makes it possible for the algorithm to save space and time.
+   
+   An ``active node'' and a ``passive node'' are created in |mem| for each
+   feasible breakpoint that needs to be considered. Active nodes are three
+   words long and passive nodes are two words long. We need active nodes only
+   for breakpoints near the place in the paragraph that is currently being
+   examined, so they are recycled within a comparatively short time after
+   they are created.
+*/
+
+/* An active node for a given breakpoint contains six fields:
+   
+|vlink| points to the next node in the list of active nodes; the
+last active node has |vlink=active|.
+
+|break_node| points to the passive node associated with this
+breakpoint.
+
+|line_number| is the number of the line that follows this
+breakpoint.
+
+|fitness| is the fitness classification of the line ending at this
+breakpoint.
+
+|type| is either |hyphenated_node| or |unhyphenated_node|, depending on
+whether this breakpoint is a |disc_node|.
+
+|total_demerits| is the minimum possible sum of demerits over all
+lines leading from the beginning of the paragraph to this breakpoint.
+
+The value of |vlink(active)| points to the first active node on a vlinked list
+of all currently active nodes. This list is in order by |line_number|,
+except that nodes with |line_number>easy_line| may be in any order relative
+to each other.
+*/
+
+void 
+initialize_active (void) {
+  type(active)=hyphenated_node; 
+  line_number(active)=max_halfword;
+  subtype(active)=0; /* the |subtype| is never examined */
+}
+
+/* The passive node for a given breakpoint contains EIGHT fields:
+
+|vlink| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+|serial| is equal to |n| if this passive node is the |n|th
+one created during the current pass. (This field is used only when
+printing out detailed statistics about the line-breaking calculations.)
+
+|passive_pen_inter| holds the current \.{\\localinterlinepenalty}
+
+|passive_pen_broken| holds the current \.{\\localbrokenpenalty}
+
+There is a global variable called |passive| that points to the most
+recently created passive node. Another global variable, |printed_node|,
+is used to help print out the paragraph when detailed information about
+the line-breaking computation is being displayed.
+*/
+
+static halfword passive; /* most recent node on passive list */
+static halfword printed_node; /*most recent node that has been printed*/
+static halfword pass_number; /*the number of passive nodes allocated on this pass*/
+
+/*
+@ The active list also contains ``delta'' nodes that help the algorithm
+compute the badness of individual lines. Such nodes appear only between two
+active nodes, and they have |type=delta_node|. If |p| and |r| are active nodes
+and if |q| is a delta node between them, so that |vlink(p)=q| and |vlink(q)=r|,
+then |q| tells the space difference between lines in the horizontal list that
+start after breakpoint |p| and lines that start after breakpoint |r|. In
+other words, if we know the length of the line that starts after |p| and
+ends at our current position, then the corresponding length of the line that
+starts after |r| is obtained by adding the amounts in node~|q|. A delta node
+contains seven scaled numbers, since it must record the net change in glue
+stretchability with respect to all orders of infinity. The natural width
+difference appears in |mem[q+1].sc|; the stretch differences in units of
+pt, sfi, fil, fill, and filll appear in |mem[q+2..q+6].sc|; and the shrink
+difference appears in |mem[q+7].sc|. The |subtype| field of a delta node
+is not used.
+
+Actually, we have two more fields that are used by |pdftex|.
+*/
+
+/* As the algorithm runs, it maintains a set of seven delta-like registers
+for the length of the line following the first active breakpoint to the
+current position in the given hlist. When it makes a pass through the
+active list, it also maintains a similar set of seven registers for the
+length following the active breakpoint of current interest. A third set
+holds the length of an empty line (namely, the sum of \.{\\leftskip} and
+\.{\\rightskip}); and a fourth set is used to create new delta nodes.
+
+When we pass a delta node we want to do operations like
+$$\hbox{\ignorespaces|for
+k:=1 to 7 do cur_active_width[k]:=cur_active_width[k]+mem[q+k].sc|};$$ and we
+want to do this without the overhead of |for| loops. The |do_all_six|
+macro makes such six-tuples convenient.
+*/
+
+#define save_active_width(a) prev_active_width[(a)] = active_width[(a)]
+#define restore_active_width(a) active_width[(a)] = prev_active_width[(a)]
+
+static scaled active_width[10] = {0}; /*distance from first active node to~|cur_p|*/
+static scaled background[10] = {0}; /*length of an ``empty'' line*/
+static scaled break_width[10] = {0}; /*length being computed after current break*/
+
+static boolean auto_breaking; /*make |auto_breaking| accessible out of |line_break|*/
+static boolean try_prev_break; /*force break at the previous legal breakpoint?*/
+static halfword prev_legal; /*the previous legal breakpoint*/
+static halfword rejected_cur_p; /*the last |cur_p| that has been rejected*/
+static boolean before_rejected_cur_p; /*|cur_p| is still before |rejected_cur_p|?*/
+
+/* Let's state the principles of the delta nodes more precisely and concisely,
+   so that the following programs will be less obscure. For each legal
+   breakpoint~|p| in the paragraph, we define two quantities $\alpha(p)$ and
+   $\beta(p)$ such that the length of material in a line from breakpoint~|p|
+   to breakpoint~|q| is $\gamma+\beta(q)-\alpha(p)$, for some fixed $\gamma$.
+   Intuitively, $\alpha(p)$ and $\beta(q)$ are the total length of material from
+   the beginning of the paragraph to a point ``after'' a break at |p| and to a
+   point ``before'' a break at |q|; and $\gamma$ is the width of an empty line,
+   namely the length contributed by \.{\\leftskip} and \.{\\rightskip}.
+   
+   Suppose, for example, that the paragraph consists entirely of alternating
+   boxes and glue skips; let the boxes have widths $x_1\ldots x_n$ and
+   let the skips have widths $y_1\ldots y_n$, so that the paragraph can be
+   represented by $x_1y_1\ldots x_ny_n$. Let $p_i$ be the legal breakpoint
+   at $y_i$; then $\alpha(p_i)=x_1+y_1+\cdots+x_i+y_i$, and $\beta(p_i)=
+   x_1+y_1+\cdots+x_i$. To check this, note that the length of material from
+   $p_2$ to $p_5$, say, is $\gamma+x_3+y_3+x_4+y_4+x_5=\gamma+\beta(p_5)
+   -\alpha(p_2)$.
+
+   The quantities $\alpha$, $\beta$, $\gamma$ involve glue stretchability and
+   shrinkability as well as a natural width. If we were to compute $\alpha(p)$
+   and $\beta(p)$ for each |p|, we would need multiple precision arithmetic, and
+   the multiprecise numbers would have to be kept in the active nodes.
+   \TeX\ avoids this problem by working entirely with relative differences
+   or ``deltas.'' Suppose, for example, that the active list contains
+   $a_1\,\delta_1\,a_2\,\delta_2\,a_3$, where the |a|'s are active breakpoints
+   and the $\delta$'s are delta nodes. Then $\delta_1=\alpha(a_1)-\alpha(a_2)$
+   and $\delta_2=\alpha(a_2)-\alpha(a_3)$. If the line breaking algorithm is
+   currently positioned at some other breakpoint |p|, the |active_width| array
+   contains the value $\gamma+\beta(p)-\alpha(a_1)$. If we are scanning through
+   the list of active nodes and considering a tentative line that runs from
+   $a_2$ to~|p|, say, the |cur_active_width| array will contain the value
+   $\gamma+\beta(p)-\alpha(a_2)$. Thus, when we move from $a_2$ to $a_3$,
+   we want to add $\alpha(a_2)-\alpha(a_3)$ to |cur_active_width|; and this
+   is just $\delta_2$, which appears in the active list between $a_2$ and
+   $a_3$. The |background| array contains $\gamma$. The |break_width| array
+   will be used to calculate values of new delta nodes when the active
+   list is being updated.
+*/
+
+/* The heart of the line-breaking procedure is `|try_break|', a subroutine
+   that tests if the current breakpoint |cur_p| is feasible, by running
+   through the active list to see what lines of text can be made from active
+   nodes to~|cur_p|.  If feasible breaks are possible, new break nodes are
+   created.  If |cur_p| is too far from an active node, that node is
+   deactivated.
+   
+   The parameter |pi| to |try_break| is the penalty associated
+   with a break at |cur_p|; we have |pi=eject_penalty| if the break is forced,
+   and |pi=inf_penalty| if the break is illegal.
+   
+   The other parameter, |break_type|, is set to |hyphenated_node| or |unhyphenated_node|,
+   depending on whether or not the current break is at a |disc_node|. The
+   end of a paragraph is also regarded as `|hyphenated_node|'; this case is
+   distinguishable by the condition |cur_p=null|.
+*/
+
+
+
+static integer internal_pen_inter; /* running \.{\\localinterlinepenalty} */
+static integer internal_pen_broken; /* running \.{\\localbrokenpenalty} */
+static halfword internal_left_box; /* running \.{\\localleftbox} */
+static integer internal_left_box_width; /* running \.{\\localleftbox} width */
+static halfword init_internal_left_box; /* running \.{\\localleftbox} */
+static integer init_internal_left_box_width; /* running \.{\\localleftbox} width */
+static halfword internal_right_box; /* running \.{\\localrightbox} */
+static integer internal_right_box_width; /* running \.{\\localrightbox} width */
+
+static scaled disc_width [10] = {0}; /* the length of discretionary material preceding a break*/
+
+/* As we consider various ways to end a line at |cur_p|, in a given line number
+   class, we keep track of the best total demerits known, in an array with
+   one entry for each of the fitness classifications. For example,
+   |minimal_demerits[tight_fit]| contains the fewest total demerits of feasible
+   line breaks ending at |cur_p| with a |tight_fit| line; |best_place[tight_fit]|
+   points to the passive node for the break before~|cur_p| that achieves such
+   an optimum; and |best_pl_line[tight_fit]| is the |line_number| field in the
+   active node corresponding to |best_place[tight_fit]|. When no feasible break
+   sequence is known, the |minimal_demerits| entries will be equal to
+   |awful_bad|, which is $2^{30}-1$. Another variable, |minimum_demerits|,
+   keeps track of the smallest value in the |minimal_demerits| array.
+*/
+
+
+static integer minimal_demerits[4]; /* best total demerits known for current 
+                                line class and position, given the fitness */
+static integer minimum_demerits; /* best total demerits known for current line class
+                             and position */
+static halfword best_place[4]; /* how to achieve  |minimal_demerits| */
+static halfword best_pl_line[4]; /*corresponding line number*/
+
+
+/*
+ The length of lines depends on whether the user has specified
+\.{\\parshape} or \.{\\hangindent}. If |par_shape_ptr| is not null, it
+points to a $(2n+1)$-word record in |mem|, where the |vinfo| in the first
+word contains the value of |n|, and the other $2n$ words contain the left
+margins and line lengths for the first |n| lines of the paragraph; the
+specifications for line |n| apply to all subsequent lines. If
+|par_shape_ptr=null|, the shape of the paragraph depends on the value of
+|n=hang_after|; if |n>=0|, hanging indentation takes place on lines |n+1|,
+|n+2|, \dots, otherwise it takes place on lines 1, \dots, $\vert
+n\vert$. When hanging indentation is active, the left margin is
+|hang_indent|, if |hang_indent>=0|, else it is 0; the line length is
+$|hsize|-\vert|hang_indent|\vert$. The normal setting is
+|par_shape_ptr=null|, |hang_after=1|, and |hang_indent=0|.
+Note that if |hang_indent=0|, the value of |hang_after| is irrelevant.
+@^length of lines@> @^hanging indentation@>
+*/
+
+static halfword easy_line; /*line numbers |>easy_line| are equivalent in break nodes*/
+static halfword last_special_line; /*line numbers |>last_special_line| all have the same width */
+static scaled first_width; /*the width of all lines |<=last_special_line|, if
+                      no \.{\\parshape} has been specified*/
+static scaled second_width; /*the width of all lines |>last_special_line|*/
+static scaled first_indent; /*left margin to go with |first_width|*/
+static scaled second_indent; /*left margin to go with |second_width|*/
+
+static halfword best_bet; /*use this passive node and its predecessors */
+static integer fewest_demerits; /*the demerits associated with |best_bet|*/
+static halfword best_line; /*line number following the last line of the new paragraph*/
+static integer actual_looseness; /*the difference between |line_number(best_bet)|
+							and the optimum |best_line|*/
+static integer line_diff; /*the difference between the current line number and
+					 the optimum |best_line|*/
+
+
+
+/* \TeX\ makes use of the fact that |hlist_node|, |vlist_node|,
+   |rule_node|, |ins_node|, |mark_node|, |adjust_node|, 
+   |disc_node|, |whatsit_node|, and |math_node| are at the low end of the
+   type codes, by permitting a break at glue in a list if and only if the
+   |type| of the previous node is less than |math_node|. Furthermore, a
+   node is discarded after a break if its type is |math_node| or~more.
+*/
+
+#define do_all_six(a) a(1);a(2);a(3);a(4);a(5);a(6);a(7)
+#define do_seven_eight(a) if (pdf_adjust_spacing > 1) { a(8);a(9); }
+#define do_all_eight(a) do_all_six(a); do_seven_eight(a)
+#define do_one_seven_eight(a) a(1); do_seven_eight(a)
+
+#define store_background(a) {active_width[a]=background[a];}
+
+#define act_width active_width[1] /*length from first active node to current node*/
+
+#define kern_break() {  \
+    if ((!is_char_node(vlink(cur_p))) && auto_breaking)  \
+      if (type(vlink(cur_p))==glue_node)  \
+        ext_try_break(0,unhyphenated_node, pdf_adjust_spacing,  \
+                      par_shape_ptr, adj_demerits,  \
+                      tracing_paragraphs, pdf_protrude_chars,  \
+                      line_penalty, last_line_fit,  \
+                      double_hyphen_demerits,  final_hyphen_demerits,first_p,cur_p);  \
+    if (type(cur_p)!=math_node) act_width+=width(cur_p);  \
+    else                        act_width+=surround(cur_p);  \
+  }
+
+#define clean_up_the_memory() {  \
+    q=vlink(active);  \
+    while (q!=active) {  \
+      cur_p=vlink(q);  \
+      if (type(q)==delta_node)         flush_node(q);  \
+      else                        flush_node(q);  \
+      q=cur_p;  \
+    }  \
+    q=passive;  \
+    while (q!=null) {  \
+      cur_p=vlink(q);  \
+      flush_node(q);  \
+      q=cur_p;  \
+    }  \
+  }
+
+#define inf_bad 10000 /* infinitely bad value */
+
+static boolean do_last_line_fit; /* special algorithm for last line of paragraph? */
+static scaled fill_width[4]; /* infinite stretch components of  |par_fill_skip| */
+static scaled best_pl_short[4]; /* |shortfall|  corresponding to |minimal_demerits| */
+static scaled best_pl_glue[4]; /*corresponding glue stretch or shrink */
+
+#define awful_bad 07777777777 /* more than a billion demerits */
+
+#define before 0 /* |subtype| for math node that introduces a formula */
+#define after 1 /* |subtype| for math node that winds up a formula */
+
+#define reset_disc_width(a) disc_width[(a)] = 0
+
+#define add_disc_width_to_break_width(a)     break_width[(a)] += disc_width[(a)]
+#define sub_disc_width_from_active_width(a)  active_width[(a)] -= disc_width[(a)]
+
+#define add_char_shrink(a,b)  a += char_shrink((b))
+#define add_char_stretch(a,b) a += char_stretch((b))
+#define sub_char_shrink(a,b)  a -= char_shrink((b))
+#define sub_char_stretch(a,b) a -= char_stretch((b))
+
+#define add_kern_shrink(a,b)  a += kern_shrink((b))
+#define add_kern_stretch(a,b) a += kern_stretch((b))
+#define sub_kern_shrink(a,b)  a -= kern_shrink((b))
+#define sub_kern_stretch(a,b) a -= kern_stretch((b))
+
+
+/* When we insert a new active node for a break at |cur_p|, suppose this
+   new node is to be placed just before active node |a|; then we essentially
+   want to insert `$\delta\,|cur_p|\,\delta^\prime$' before |a|, where
+   $\delta=\alpha(a)-\alpha(|cur_p|)$ and $\delta^\prime=\alpha(|cur_p|)-\alpha(a)$
+   in the notation explained above.  The |cur_active_width| array now holds
+   $\gamma+\beta(|cur_p|)-\alpha(a)$; so $\delta$ can be obtained by
+   subtracting |cur_active_width| from the quantity $\gamma+\beta(|cur_p|)-
+   \alpha(|cur_p|)$. The latter quantity can be regarded as the length of a
+   line ``from |cur_p| to |cur_p|''; we call it the |break_width| at |cur_p|.
+   
+   The |break_width| is usually negative, since it consists of the background
+   (which is normally zero) minus the width of nodes following~|cur_p| that are
+   eliminated after a break. If, for example, node |cur_p| is a glue node, the
+   width of this glue is subtracted from the background; and we also look
+   ahead to eliminate all subsequent glue and penalty and kern and math
+   nodes, subtracting their widths as well.
+     
+   Kern nodes do not disappear at a line break unless they are |explicit|.
+*/
+
+/* assigned-to globals: 
+   break_width[] 
+*/
+/* used globals: 
+   disc_width[]
+   line_break_dir
+*/
+static void 
+compute_break_width (int break_type, int pdf_adjust_spacing, halfword p
+    /*, halfword s*/) {
+  halfword s; /* glue and other 'whitespace' to be skipped after a break
+               * used if unhyphenated, or post_break==empty */
+  s=p;
+  if (break_type>unhyphenated_node && p!=null) {
+    /*@<Compute the discretionary |break_width| values@>;*/
+    /* When |p| is a discretionary break, the length of a line
+       ``from |p| to |p|'' has to be defined properly so
+       that the other calculations work out.  Suppose that the
+       pre-break text at |p| has length $l_0$, the post-break
+       text has length $l_1$, and the replacement text has length
+       |l|. Suppose also that |q| is the node following the
+       replacement text. Then length of a line from |p| to |q|
+       will be computed as $\gamma+\beta(q)-\alpha(|p|)$, where
+       $\beta(q)=\beta(|p|)-l_0+l$. The actual length will be
+       the background plus $l_1$, so the length from |p| to
+       |p| should be $\gamma+l_0+l_1-l$.  If the post-break text
+       of the discretionary is empty, a break may also discard~|q|;
+       in that unusual case we subtract the length of~|q| and any
+       other nodes that will be discarded after the discretionary
+       break.
+
+       TH: I don't quite understand the above remarks.
+               
+       The value of $l_0$ need not be computed, since |line_break|
+       will put it into the global variable |disc_width| before
+       calling |try_break|.
+    */
+    /* In case of nested discretionaries, we always follow the no_break
+       path, as we are talking about the breaking on _this_ position.
+    */
+
+    halfword v;
+    for (v=vlink_no_break(p); v!=null; v=vlink(v)) {
+      /* @<Subtract the width of node |v| from |break_width|@>; */
+      /* Replacement texts and discretionary texts are supposed to contain
+         only character nodes, kern nodes, and box or rule nodes.*/
+      if (is_char_node(v)) {
+        if (is_rotated(line_break_dir)) {
+          break_width[1] -= (glyph_height(v)+glyph_depth(v));
+        } else {
+          break_width[1] -= glyph_width(v);
+        }
+        if ((pdf_adjust_spacing > 1) && check_expand_pars(font(v))) {
+          set_prev_char_p(v);
+          sub_char_stretch(break_width[8],v);
+          sub_char_shrink(break_width[9],v);
+        }
+      } else {
+        switch (type(v)) {
+        case hlist_node:
+        case vlist_node:
+          if (!(dir_orthogonal(dir_primary[box_dir(v)],
+                               dir_primary[line_break_dir])))
+            break_width[1] -= width(v);
+          else
+            break_width[1] -= (depth(v)+height(v));
+          break;
+        case kern_node: 
+          if ((pdf_adjust_spacing > 1) && (subtype(v) == normal)) {
+            sub_kern_stretch(break_width[8],v);
+            sub_kern_shrink(break_width[9],v);
+          }
+          /* fall through */
+        case rule_node:
+          break_width[1] -= width(v);
+          break;
+        case disc_node:
+          assert(vlink(v)==null); /* discs are _always_ last */
+          v = no_break(v);
+          break;
+        default:
+          tconfusion("disc1");
+          break;
+        }
+      }
+    }
+
+    for (v=vlink_post_break(p); v!=null; v=vlink(v)) {
+      /* @<Add the width of node |v| to |break_width|@>; */
+      if (is_char_node(v)) { 
+        if (is_rotated(line_break_dir)) 
+          break_width[1] += (glyph_height(v)+glyph_depth(v));
+        else
+          break_width[1] += glyph_width(v);
+        if ((pdf_adjust_spacing > 1) && check_expand_pars(font(v))) {
+          set_prev_char_p(v);
+          add_char_stretch(break_width[8],v);
+          add_char_shrink(break_width[9],v);
+        }
+      } else  { 
+        switch (type(v)) {
+        case hlist_node:
+        case vlist_node: 
+          if (!(dir_orthogonal(dir_primary[box_dir(v)],
+                               dir_primary[line_break_dir])))
+            break_width[1] += width(v);
+          else
+            break_width[1] += (depth(v)+height(v));
+          break;
+        case kern_node:
+          if ((pdf_adjust_spacing > 1) && (subtype(v) == normal)) {
+            add_kern_stretch(break_width[8],v);
+            add_kern_shrink(break_width[9],v);
+          }
+          /* fall through */
+        case rule_node:
+          break_width[1] += width(v);
+          break;
+        case disc_node:
+          assert(vlink(v)==null);
+          v = no_break(v);
+          break;
+        default:
+          tconfusion("disc2");
+        }
+      }
+    }
+
+    do_one_seven_eight(add_disc_width_to_break_width);
+    if (vlink_post_break(p)==null) {
+      s=vlink(p); /* no post_break: 'skip' any 'whitespace' following */
+    } else {
+      s=null;
+    }
+  } else {
+    s = p; /* unhyphenated: we need to 'skip' any 'whitespace' following */
+  }
+  while (s!=null) {
+    switch (type(s)) {
+    case glue_node:
+      /*@<Subtract glue from |break_width|@>;*/
+      {halfword v=glue_ptr(s);
+      break_width[1] -= width(v);
+      break_width[2+stretch_order(v)] -= stretch(v);
+      break_width[7] -= shrink(v);
+      }break;
+    case penalty_node: 
+      break;
+    case math_node: 
+      break_width[1] -= surround(s);
+      break;
+    case kern_node: 
+      if (subtype(s)!=explicit) 
+        return;
+      else 
+        break_width[1] -= width(s);
+      break;
+    default: 
+      return;
+    };
+    s=vlink(s);
+  }
+}
+
+
+static void
+print_break_node(halfword q, fitness_value fit_class,
+    quarterword break_type, halfword cur_p) {
+  /* @<Print a symbolic description of the new break node@> */
+  tprint_nl("@@"); 
+  print_int(serial(passive));
+  tprint(": line "); 
+  print_int(line_number(q)-1);
+  print_char('.'); 
+  print_int(fit_class);
+  if (break_type==hyphenated_node) 
+    print_char('-');
+  tprint(" t="); 
+  print_int(total_demerits(q));
+  if (do_last_line_fit) {
+    /*@<Print additional data in the new active node@>; */
+    tprint(" s="); 
+    print_scaled(active_short(q));
+    if (cur_p==null) 
+      tprint(" a=");
+    else 
+      tprint(" g=");
+    print_scaled(active_glue(q));
+  }
+  tprint(" -> @@");
+  if (prev_break(passive)==null) 
+    print_char('0');
+  else 
+    print_int(serial(prev_break(passive)));
+}
+
+
+static void 
+print_feasible_break(halfword cur_p, pointer r, halfword b, integer pi,
+    integer d, boolean artificial_demerits) {
+  /* @<Print a symbolic description of this feasible break@>;*/
+  if (printed_node!=cur_p) {
+    /* @<Print the list between |printed_node| and |cur_p|, then
+       set |printed_node:=cur_p|@>;*/
+    tprint_nl("");
+    if (cur_p==null) {
+      short_display(vlink(printed_node));
+    } else {
+      halfword save_link=vlink(cur_p);
+      vlink(cur_p)=null; 
+      tprint_nl(""); 
+      short_display(vlink(printed_node));
+      vlink(cur_p)=save_link;
+    }
+    printed_node=cur_p;
+  }
+  tprint_nl("@");
+  if (cur_p==null) { 
+    tprint_esc("par"); 
+  } else if (type(cur_p)!=glue_node) {
+    if      (type(cur_p)==penalty_node)  tprint_esc("penalty");
+    else if (type(cur_p)==disc_node)     tprint_esc("discretionary");
+    else if (type(cur_p)==kern_node)     tprint_esc("kern");
+    else                                 tprint_esc("math");
+  }
+  tprint(" via @@");
+  if (break_node(r)==null) 
+    print_char('0');
+  else 
+    print_int(serial(break_node(r)));
+  tprint(" b=");
+  if (b>inf_bad)  
+    print_char('*');
+  else 
+    print_int(b);
+  tprint(" p="); 
+  print_int(pi); 
+  tprint(" d=");
+  if (artificial_demerits) 
+    print_char('*');
+  else 
+    print_int(d);
+}
+
+#define add_disc_width_to_active_width(a)   active_width[a] += disc_width[a]
+#define update_width(a) cur_active_width[a] += varmem[(r+(a))].cint
+
+#define set_break_width_to_background(a) break_width[a]=background[(a)]
+
+#define convert_to_break_width(a)  \
+  varmem[(prev_r+(a))].cint -= (cur_active_width[(a)]+break_width[(a)])
+
+#define store_break_width(a)      active_width[(a)]=break_width[(a)]
+
+#define new_delta_to_break_width(a)  \
+  varmem[(q+(a))].cint=break_width[(a)]-cur_active_width[(a)]
+
+#define new_delta_from_break_width(a)  \
+  varmem[(q+(a))].cint=cur_active_width[(a)]-break_width[(a)]
+
+#define copy_to_cur_active(a) cur_active_width[(a)]=active_width[(a)]
+
+#define combine_two_deltas(a) varmem[(prev_r+(a))].cint += varmem[(r+(a))].cint
+#define downdate_width(a) cur_active_width[(a)] -= varmem[(prev_r+(a))].cint
+#define update_active(a) active_width[(a)]+=varmem[(r+(a))].cint
+
+#define total_font_stretch cur_active_width[8]
+#define total_font_shrink cur_active_width[9]
+
+#define max_dimen 07777777777 /* $2^{30}-1$ */
+
+#define left_side 0
+#define right_side 1
+
+
+#define cal_margin_kern_var(a) {  \
+  character(cp) = character((a));  \
+  font(cp) = font((a));  \
+  do_subst_font(cp, 1000);  \
+  if (font(cp) != font((a)))  \
+    margin_kern_stretch += (left_pw((a)) - left_pw(cp));	\
+  font(cp) = font((a));  \
+  do_subst_font(cp, -1000);  \
+  if (font(cp) != font((a)))  \
+    margin_kern_shrink += (left_pw(cp) - left_pw((a)));	\
+  }
+
+static void 
+ext_try_break(integer pi,
+              quarterword break_type,
+              int pdf_adjust_spacing,
+              int par_shape_ptr, 
+              int adj_demerits, 
+              int tracing_paragraphs, 
+              int pdf_protrude_chars,
+              int line_penalty,
+              int last_line_fit, 
+              int double_hyphen_demerits, 
+              int final_hyphen_demerits,
+              halfword first_p,
+              halfword cur_p) {
+  /* CONTINUE,DEACTIVATE,FOUND,NOT_FOUND; */
+  pointer r;  /* runs through the active list */
+  scaled margin_kern_stretch;
+  scaled margin_kern_shrink;
+  halfword lp, rp, cp;
+  halfword prev_r;  /* stays a step behind |r| */
+  halfword prev_prev_r; /*a step behind |prev_r|, if |type(prev_r)=delta_node|*/
+  halfword old_l; /* maximum line number in current equivalence class of lines */
+  boolean no_break_yet; /* have we found a feasible break at |cur_p|? */
+  halfword q; /*points to a new node being created*/
+  halfword l; /*line number of current active node*/
+  boolean node_r_stays_active; /*should node |r| remain in the active list?*/
+  scaled line_width; /*the current line will be justified to this width*/
+  fitness_value fit_class; /*possible fitness class of test line*/
+  halfword b; /*badness of test line*/
+  integer d; /*demerits of test line*/
+  boolean artificial_demerits; /*has |d| been forced to zero?*/
+
+  scaled shortfall; /*used in badness calculations*/
+  scaled g; /*glue stretch or shrink of test line, adjustment for last line*/
+  scaled cur_active_width[10] = {0}; /*distance from current active node*/
+
+  line_width=0;  g=0; prev_prev_r=null;
+  /*@<Make sure that |pi| is in the proper range@>;*/
+  if (pi>=inf_penalty) {
+    return; /* this breakpoint is inhibited by infinite penalty */
+  } else if (pi<=-inf_penalty) {
+    pi=eject_penalty; /*this breakpoint will be forced*/
+  }
+
+  no_break_yet=true; 
+  prev_r=active; 
+  old_l=0;
+  do_all_eight(copy_to_cur_active);
+
+  while (1)  {
+    r=vlink(prev_r);
+    /* @<If node |r| is of type |delta_node|, update |cur_active_width|,
+       set |prev_r| and |prev_prev_r|, then |goto continue|@>; */
+    /* The following code uses the fact that |type(active)<>delta_node| */
+    if (type(r)==delta_node) {
+      do_all_eight(update_width); /* IMPLICIT ,r */
+      prev_prev_r=prev_r; 
+      prev_r=r; 
+      continue;
+    }
+    /* @<If a line number class has ended, create new active nodes for
+       the best feasible breaks in that class; then |return|
+       if |r=active|, otherwise compute the new |line_width|@>; */
+    /* The first part of the following code is part of \TeX's inner loop, so
+       we don't want to waste any time. The current active node, namely node |r|,
+       contains the line number that will be considered next. At the end of the
+       list we have arranged the data structure so that |r=active| and
+       |line_number(active)>old_l|.
+    */
+    l=line_number(r);
+    if (l>old_l) { /* now we are no longer in the inner loop */
+      if ((minimum_demerits<awful_bad)&&((old_l!=easy_line)||(r==active))) {
+        /*@<Create new active nodes for the best feasible breaks just found@>*/
+        /* It is not necessary to create new active nodes having |minimal_demerits|
+           greater than
+           |minimum_demerits+abs(adj_demerits)|, since such active nodes will never
+           be chosen in the final paragraph breaks. This observation allows us to
+           omit a substantial number of feasible breakpoints from further consideration.
+        */
+        if (no_break_yet) {
+          no_break_yet=false; 
+          do_all_eight(set_break_width_to_background);
+          compute_break_width(break_type, pdf_adjust_spacing, cur_p);
+        }
+        /* @<Insert a delta node to prepare for breaks at |cur_p|@>;*/
+        /* We use the fact that |type(active)<>delta_node|.*/
+        if (type(prev_r)==delta_node) {/* modify an existing delta node */
+          do_all_eight(convert_to_break_width);  /* IMPLICIT prev_r */
+        } else if (prev_r==active) { /* no delta node needed at the beginning */
+          do_all_eight(store_break_width);                                
+        } else {                                                        
+          q=new_node(delta_node,0); 
+          vlink(q)=r; 
+          do_all_eight(new_delta_to_break_width); /* IMPLICIT q */
+          vlink(prev_r)=q;  
+          prev_prev_r=prev_r; 
+          prev_r=q;                
+        }
+
+        if (abs(adj_demerits)>=awful_bad-minimum_demerits)
+          minimum_demerits=awful_bad-1;
+        else 
+          minimum_demerits += abs(adj_demerits);
+        for (fit_class=very_loose_fit;fit_class<=tight_fit;fit_class++) {
+          if (minimal_demerits[fit_class]<=minimum_demerits) {
+            /* @<Insert a new active node from |best_place[fit_class]|
+               to |cur_p|@>; */
+            /* When we create an active node, we also create the corresponding
+               passive node.
+            */
+            q=new_node(passive_node,0); 
+            vlink(q)=passive; 
+            passive=q; 
+            cur_break(q)=cur_p;
+            incr(pass_number); 
+            serial(q)=pass_number;
+            prev_break(q)=best_place[fit_class];
+            /*Here we keep track of the subparagraph penalties in the break nodes*/
+            passive_pen_inter(q)=internal_pen_inter;
+            passive_pen_broken(q)=internal_pen_broken;
+            passive_last_left_box(q)=internal_left_box;
+            passive_last_left_box_width(q)=internal_left_box_width;
+            if (prev_break(q)!=null) {
+              passive_left_box(q)=passive_last_left_box(prev_break(q));
+              passive_left_box_width(q)=passive_last_left_box_width(prev_break(q));
+            } else {
+              passive_left_box(q)=init_internal_left_box;
+              passive_left_box_width(q)=init_internal_left_box_width;
+            }
+            passive_right_box(q)=internal_right_box;
+            passive_right_box_width(q)=internal_right_box_width;
+            q=new_node(break_type,fit_class); 
+            break_node(q)=passive;
+            line_number(q)=best_pl_line[fit_class]+1;
+            total_demerits(q)=minimal_demerits[fit_class];
+            if (do_last_line_fit) {
+              /*@<Store \(a)additional data in the new active node@>*/
+              /* Here we save these data in the active node
+                 representing a potential line break.*/
+              active_short(q)=best_pl_short[fit_class];
+              active_glue(q)=best_pl_glue[fit_class];
+            }
+            vlink(q)=r;
+            vlink(prev_r)=q; 
+            prev_r=q;
+            if (tracing_paragraphs>0) 
+              print_break_node(q,fit_class,break_type,cur_p);
+          }
+          minimal_demerits[fit_class]=awful_bad;
+        }
+        minimum_demerits=awful_bad;
+        /* @<Insert a delta node to prepare for the next active node@>;*/
+        /* When the following code is performed, we will have just inserted at
+           least one active node before |r|, so |type(prev_r)<>delta_node|. 
+        */
+        if (r!=active) {                                                
+          q=new_node(delta_node,0); 
+          vlink(q)=r; 
+          do_all_eight(new_delta_from_break_width);  /* IMPLICIT q */
+          vlink(prev_r)=q; 
+          prev_prev_r=prev_r; 
+          prev_r=q;                        
+        }
+      }
+      if (r==active) 
+        return;
+      /*@<Compute the new line width@>;*/
+      /* When we come to the following code, we have just encountered
+         the first active node~|r| whose |line_number| field contains
+         |l|. Thus we want to compute the length of the $l\mskip1mu$th
+         line of the current paragraph. Furthermore, we want to set
+         |old_l| to the last number in the class of line numbers
+         equivalent to~|l|.
+      */
+      if (l>easy_line) {                                        
+        old_l=max_halfword-1;        
+        line_width=second_width; 
+      } else  {                                                
+        old_l=l;                                                
+        if (l>last_special_line) {
+          line_width=second_width;
+        } else if (par_shape_ptr==null) {
+          line_width=first_width;                                
+        } else {
+          line_width=varmem[(par_shape_ptr+2*l+1)].cint;        
+        }
+      }
+    }
+    /* /If a line number class has ended, create new active nodes for
+       the best feasible breaks in that class; then |return|
+       if |r=active|, otherwise compute the new |line_width|@>; */
+
+    /* @<Consider the demerits for a line from |r| to |cur_p|;
+       deactivate node |r| if it should no longer be active;
+       then |goto continue| if a line from |r| to |cur_p| is infeasible,
+       otherwise record a new feasible break@>; */
+    artificial_demerits=false;
+    shortfall = line_width
+      - cur_active_width[1]
+      -(( break_node(r)==null)
+        ? init_internal_left_box_width
+        : passive_last_left_box_width(break_node(r)))
+      - internal_right_box_width;
+    if (pdf_protrude_chars > 1) {
+      halfword l, o;
+      l = (break_node(r) == null) ? first_p : cur_break(break_node(r));
+      if (cur_p==null) {
+        o = null;
+      } else { /* TODO if (is_character_node(alink(cur_p))) */
+        o = alink(cur_p);
+        assert(vlink(o)==cur_p);
+      }
+      /* let's look at the right margin first */
+      if ((cur_p != null) && (type(cur_p) == disc_node) && (vlink_pre_break(cur_p) != null)) {
+        /* a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break| */
+        o = tlink_pre_break(cur_p);
+      } else { 
+        o = find_protchar_right(l, o);
+      }
+      /* now the left margin */
+      if ((l != null) && (type(l) == disc_node) &&  (vlink_post_break(l) != null)) {
+        /* FIXME: first 'char' could be a disc! */
+        l = vlink_post_break(l); /* protrude the first char */
+      } else {
+        l = find_protchar_left(l, true);
+      }
+      shortfall += (left_pw(l) + right_pw(o));
+    }
+    if ((shortfall != 0) && (pdf_adjust_spacing > 1)) {
+      margin_kern_stretch = 0;
+      margin_kern_shrink = 0;
+      if (pdf_protrude_chars > 1) {
+        /* @<Calculate variations of marginal kerns@>;*/
+        lp = last_leftmost_char;
+        rp = last_rightmost_char;
+        cp = raw_glyph_node();
+        if (lp != null) {
+          cal_margin_kern_var(lp);
+        }
+        if (rp != null) {
+          cal_margin_kern_var(rp);
+        }
+        flush_node(cp);
+      }
+      if ((shortfall > 0) && ((total_font_stretch + margin_kern_stretch) > 0)) {
+        if ((total_font_stretch + margin_kern_stretch) > shortfall)
+          shortfall = ((total_font_stretch + margin_kern_stretch) /
+                       (max_stretch_ratio / cur_font_step)) / 2;
+        else
+          shortfall -= (total_font_stretch + margin_kern_stretch);
+      } else if ((shortfall < 0) && ((total_font_shrink + margin_kern_shrink) > 0)) {
+        if ((total_font_shrink + margin_kern_shrink) > -shortfall)
+          shortfall = -((total_font_shrink + margin_kern_shrink) /
+                        (max_shrink_ratio / cur_font_step)) / 2;
+        else
+	  shortfall += (total_font_shrink + margin_kern_shrink);
+      }
+    }
+    if (shortfall>0) {
+      /* @<Set the value of |b| to the badness for stretching the line,
+         and compute the corresponding |fit_class|@> */
+
+      /* When a line must stretch, the available stretchability can be
+         found in the subarray |cur_active_width[2..6]|, in units of
+         points, sfi, fil, fill and filll.
+
+         The present section is part of \TeX's inner loop, and it is
+         most often performed when the badness is infinite; therefore
+         it is worth while to make a quick test for large width excess
+         and small stretchability, before calling the |badness|
+         subroutine.  @^inner loop@> */
+      
+      if ((cur_active_width[3]!=0)||(cur_active_width[4]!=0)||
+          (cur_active_width[5]!=0)||(cur_active_width[6]!=0)) {
+        if (do_last_line_fit) {
+          if (cur_p==null)  { /* the last line of a paragraph */
+            /* @<Perform computations for last line and |goto found|@>;*/
+
+            /* Here we compute the adjustment |g| and badness |b| for
+               a line from |r| to the end of the paragraph.  When any
+               of the criteria for adjustment is violated we fall
+               through to the normal algorithm.
+               
+               The last line must be too short, and have infinite
+               stretch entirely due to |par_fill_skip|.*/
+            if ((active_short(r)==0)||(active_glue(r)<=0)) 
+              /* previous line was neither stretched nor shrunk, or
+                 was infinitely bad*/
+              goto NOT_FOUND;  
+            if ((cur_active_width[3]!=fill_width[0])||
+                (cur_active_width[4]!=fill_width[1])||
+                (cur_active_width[5]!=fill_width[2])||
+                (cur_active_width[6]!=fill_width[3]))
+              /* infinite stretch of this line not entirely due to
+                 |par_fill_skip| */
+              goto NOT_FOUND;
+            if (active_short(r)>0) 
+              g=cur_active_width[2];
+            else 
+              g=cur_active_width[7];
+            if (g<=0) 
+              /*no finite stretch resp.\ no shrink*/
+              goto NOT_FOUND; 
+            arith_error=false; 
+            g=fract(g,active_short(r),active_glue(r),max_dimen);
+            if (last_line_fit<1000)  
+              g=fract(g,last_line_fit,1000,max_dimen);
+            if (arith_error) {
+              if (active_short(r)>0) 
+                g=max_dimen; 
+              else 
+                g=-max_dimen;
+            }
+            if (g>0) {
+              /*@<Set the value of |b| to the badness of the last line
+                for stretching, compute the corresponding |fit_class,
+                and |goto found||@>*/
+              /* These badness computations are rather similar to
+                 those of the standard algorithm, with the adjustment
+                 amount |g| replacing the |shortfall|.*/
+              if (g>shortfall) 
+                g=shortfall;
+              if (g>7230584) {
+                if (cur_active_width[2]<1663497) {
+                  b=inf_bad; 
+                  fit_class=very_loose_fit; 
+                  goto FOUND;
+                }
+              }
+              b=badness(g,cur_active_width[2]);
+              if (b>99)      { fit_class=very_loose_fit; }
+              else if (b>12) { fit_class=loose_fit;  } 
+              else           { fit_class=decent_fit; }
+              goto FOUND;
+            } else if (g<0)  {
+              /*@<Set the value of |b| to the badness of the last line
+                for shrinking, compute the corresponding |fit_class,
+                and |goto found||@>;*/
+              if (-g>cur_active_width[7]) 
+                g=-cur_active_width[7];
+              b=badness(-g,cur_active_width[7]);
+              if (b>12) fit_class=tight_fit; 
+              else      fit_class=decent_fit;
+              goto FOUND;
+            }
+          }
+        NOT_FOUND:
+          shortfall=0;
+        }
+        b=0; 
+        fit_class=decent_fit; /* infinite stretch */
+      } else {
+        if (shortfall>7230584 && cur_active_width[2]<1663497) {
+          b=inf_bad; 
+          fit_class=very_loose_fit;
+        } else {
+          b=badness(shortfall,cur_active_width[2]); 
+          if (b>99)      { fit_class=very_loose_fit; }
+          else if (b>12) { fit_class=loose_fit;  } 
+          else           { fit_class=decent_fit; }
+        }
+      }
+    } else { 
+      /* Set the value of |b| to the badness for shrinking the line,
+         and compute the corresponding |fit_class|@>; */
+      /* Shrinkability is never infinite in a paragraph; we can shrink
+         the line from |r| to |cur_p| by at most
+         |cur_active_width[7]|.*/
+      if (-shortfall>cur_active_width[7]) 
+        b=inf_bad+1;
+      else 
+        b=badness(-shortfall,cur_active_width[7]);
+      if (b>12) 
+        fit_class=tight_fit; 
+      else 
+        fit_class=decent_fit;
+    }
+    if (do_last_line_fit) {
+      /* @<Adjust \(t)the additional data for last line@>; */
+      if (cur_p==null) shortfall=0;
+      if (shortfall>0)      { g=cur_active_width[2]; }
+      else if (shortfall<0) { g=cur_active_width[7]; }
+      else                  { g=0;}
+    }
+  FOUND:
+    if ((b>inf_bad)||(pi==eject_penalty)) {
+      /* @<Prepare to deactivate node~|r|, and |goto deactivate| unless
+         there is a reason to consider lines of text from |r| to |cur_p|@> */
+      /* During the final pass, we dare not lose all active nodes, lest we lose
+         touch with the line breaks already found. The code shown here makes
+         sure that such a catastrophe does not happen, by permitting overfull
+         boxes as a last resort. This particular part of \TeX\ was a source of
+         several subtle bugs before the correct program logic was finally
+         discovered; readers who seek to ``improve'' \TeX\ should therefore
+         think thrice before daring to make any changes here.
+         @^overfull boxes@>
+      */
+      if (final_pass && (minimum_demerits==awful_bad) && 
+          (vlink(r)==active) && (prev_r==active)) {
+        artificial_demerits=true; /* set demerits zero, this break is forced */
+      } else if (b>threshold) { 
+        goto DEACTIVATE;
+      }
+      node_r_stays_active=false;
+    } else { 
+      prev_r=r;
+      if (b>threshold) 
+        continue;
+      node_r_stays_active=true;
+    }
+    /* @<Record a new feasible break@>;*/
+    /* When we get to this part of the code, the line from |r| to |cur_p| is
+       feasible, its badness is~|b|, and its fitness classification is
+       |fit_class|.  We don't want to make an active node for this break yet,
+       but we will compute the total demerits and record them in the
+       |minimal_demerits| array, if such a break is the current champion among
+       all ways to get to |cur_p| in a given line-number class and fitness
+       class.
+    */
+    if (artificial_demerits) { 
+      d=0;
+    } else { 
+      /* @<Compute the demerits, |d|, from |r| to |cur_p|@>;*/
+      d=line_penalty+b;
+      if (abs(d)>=10000) d=100000000; else d=d*d;
+      if (pi!=0) {
+        if (pi>0) {
+          d += (pi*pi);
+        } else if (pi>eject_penalty) {
+          d -= (pi*pi);
+        }
+      }
+      if ((break_type==hyphenated_node)&&(type(r)==hyphenated_node)) {
+        if (cur_p!=null) 
+          d += double_hyphen_demerits;
+        else 
+          d += final_hyphen_demerits;
+      }
+      if (abs(fit_class-fitness(r))>1) d=d+adj_demerits;
+    }
+    if (tracing_paragraphs>0)
+      print_feasible_break(cur_p, r, b, pi, d, artificial_demerits);
+    d += total_demerits(r); /*this is the minimum total demerits
+                              from the beginning to |cur_p| via |r| */
+    if (d<=minimal_demerits[fit_class]) {
+      minimal_demerits[fit_class]=d;
+      best_place[fit_class]=break_node(r); 
+      best_pl_line[fit_class]=l;
+      if (do_last_line_fit) {
+        /* Store \(a)additional data for this feasible break@>; */
+        /* For each feasible break we record the shortfall and glue stretch or
+           shrink (or adjustment).*/
+        best_pl_short[fit_class]=shortfall; 
+        best_pl_glue[fit_class]=g;
+      }
+      if (d<minimum_demerits) 
+        minimum_demerits=d;
+    }
+    /* /Record a new feasible break */
+    if (node_r_stays_active) 
+      continue; /*|prev_r| has been set to |r| */
+  DEACTIVATE: 
+    /* @<Deactivate node |r|@>; */
+    /* When an active node disappears, we must delete an adjacent delta node if
+       the active node was at the beginning or the end of the active list, or
+       if it was surrounded by delta nodes. We also must preserve the property
+       that |cur_active_width| represents the length of material from
+       |vlink(prev_r)| to~|cur_p|.*/
+    
+    vlink(prev_r)=vlink(r); 
+    flush_node(r);
+    if (prev_r==active) {
+      /*@<Update the active widths, since the first active node has been
+        deleted@>*/
+      /* The following code uses the fact that |type(active)<>delta_node|.
+         If the active list has just become empty, we do not need to update the
+         |active_width| array, since it will be initialized when an active
+         node is next inserted.
+      */
+      r=vlink(active);
+      if (type(r)==delta_node) {
+        do_all_eight(update_active); /* IMPLICIT r */
+        do_all_eight(copy_to_cur_active);
+        vlink(active)=vlink(r); 
+        flush_node(r);
+      }
+    } else if (type(prev_r)==delta_node){
+      r=vlink(prev_r);
+      if (r==active) {
+        do_all_eight(downdate_width); /* IMPLICIT prev_r */
+        vlink(prev_prev_r)=active;
+        flush_node(prev_r); 
+        prev_r=prev_prev_r;
+      } else if (type(r)==delta_node) {
+        do_all_eight(update_width); /* IMPLICIT ,r */
+        do_all_eight(combine_two_deltas); /* IMPLICIT r prev_r */
+        vlink(prev_r)=vlink(r); 
+        flush_node(r);
+      }
+    }   
+  }
+}
+
+
+void
+ext_do_line_break (boolean d, 
+                   int pretolerance, 
+                   int tracing_paragraphs, 
+                   int tolerance, 
+                   scaled emergency_stretch,
+                   int looseness, 
+                   int hyphen_penalty, 
+                   int ex_hyphen_penalty,
+                   int pdf_adjust_spacing, 
+                   halfword par_shape_ptr, 
+                   int adj_demerits,
+                   int pdf_protrude_chars,
+                   int line_penalty, 
+                   int last_line_fit, 
+                   int double_hyphen_demerits,  
+                   int final_hyphen_demerits,
+                   int hang_indent, 
+                   int hsize, 
+                   int hang_after,
+                   halfword left_skip, 
+                   halfword right_skip,
+                   int pdf_each_line_height,
+                   int pdf_each_line_depth,
+                   int pdf_first_line_height,
+                   int pdf_last_line_depth,
+                   halfword inter_line_penalties_ptr,
+                   int inter_line_penalty,
+                   int club_penalty,
+                   halfword club_penalties_ptr,
+                   halfword display_widow_penalties_ptr,
+                   halfword widow_penalties_ptr,
+                   int display_widow_penalty,
+                   int widow_penalty,
+                   int broken_penalty,
+		   halfword final_par_glue) {
+  /* DONE,DONE1,DONE2,DONE3,DONE4,DONE5,CONTINUE;*/
+  halfword cur_p,q,r,s; /* miscellaneous nodes of temporary interest */
+
+  /* Get ready to start ... */
+  minimum_demerits=awful_bad;
+  minimal_demerits[tight_fit]=awful_bad;
+  minimal_demerits[decent_fit]=awful_bad;
+  minimal_demerits[loose_fit]=awful_bad;
+  minimal_demerits[very_loose_fit]=awful_bad;
+
+  /* We compute the values of |easy_line| and the other local variables relating
+     to line length when the |line_break| procedure is initializing itself. */
+  if (par_shape_ptr==null) {
+    if (hang_indent==0) {
+      last_special_line=0; 
+      second_width=hsize;
+      second_indent=0;
+    } else { 
+      /*  @<Set line length parameters in preparation for hanging indentation@>*/
+      /* We compute the values of |easy_line| and the other local variables relating
+         to line length when the |line_break| procedure is initializing itself. */
+      last_special_line=abs(hang_after);
+      if (hang_after<0) {
+        first_width=hsize-abs(hang_indent);
+        if (hang_indent>=0) 
+          first_indent=hang_indent;
+        else 
+          first_indent=0;
+        second_width=hsize; 
+        second_indent=0;
+      } else  {
+        first_width=hsize; 
+        first_indent=0;
+        second_width=hsize-abs(hang_indent);
+        if (hang_indent>=0) 
+          second_indent=hang_indent;
+        else 
+          second_indent=0;
+      }
+    }
+  } else {
+    last_special_line=vinfo(par_shape_ptr+1)-1;
+    second_indent=varmem[(par_shape_ptr+(2*last_special_line))].cint;
+    second_width=varmem[(par_shape_ptr+2*(last_special_line+1)+1)].cint;
+  }
+  if (looseness==0) 
+    easy_line=last_special_line;
+  else 
+    easy_line=max_halfword; 
+
+  no_shrink_error_yet=true;
+  check_shrinkage(left_skip); 
+  check_shrinkage(right_skip);
+  q=left_skip; 
+  r=right_skip; 
+  background[1]=width(q)+width(r);
+  background[2]=0; 
+  background[3]=0; 
+  background[4]=0; 
+  background[5]=0;
+  background[6]=0;
+  background[2+stretch_order(q)] = stretch(q);
+  background[2+stretch_order(r)] += stretch(r);
+  background[7]=shrink(q)+shrink(r);
+  if (pdf_adjust_spacing > 1) {
+    background[8] = 0;
+    background[9] = 0;
+    max_stretch_ratio = -1;
+    max_shrink_ratio = -1;
+    cur_font_step = -1;
+    set_prev_char_p(null);
+  }
+  /* @<Check for special treatment of last line of paragraph@>;*/
+  /* The new algorithm for the last line requires that the stretchability
+     |par_fill_skip| is infinite and the stretchability of |left_skip| plus
+     |right_skip| is finite.
+  */
+  do_last_line_fit=false; 
+  if (last_line_fit>0) {
+    q=glue_ptr(last_line_fill);
+    if ((stretch(q)>0)&&(stretch_order(q)>normal)) {
+      if ((background[3]==0)&&(background[4]==0)&&
+          (background[5]==0)&&(background[6]==0)) {
+        do_last_line_fit=true;
+        fill_width[0]=0; 
+        fill_width[1]=0; 
+        fill_width[2]=0; 
+        fill_width[3]=0;
+        fill_width[stretch_order(q)-1]=stretch(q);
+      }
+    }
+  }
+  /* @<DIR: Initialize |dir_ptr| for |line_break|@> */
+  if (dir_ptr!=null) {
+	fprintf(stdout,"-dir_node s %d\n",dir_ptr);
+	flush_node_list(dir_ptr);
+	dir_ptr=null; 
+  }
+  /*push_dir(paragraph_dir);*/ /* TODO what was the point of this? */
+
+  /* @<Find optimal breakpoints@>;*/
+  threshold=pretolerance;
+  if (threshold>=0) {
+    if (tracing_paragraphs>0) {
+      begin_diagnostic(); 
+      tprint_nl("@firstpass");
+    }
+    second_pass=false; 
+    final_pass=false;
+  } else  { 
+    threshold=tolerance; 
+    second_pass=true;
+    final_pass=(emergency_stretch<=0);
+    if (tracing_paragraphs>0) 
+      begin_diagnostic();
+  }
+    
+  while (1)  { 
+    halfword first_p;
+    halfword nest_stack[10];
+    int nest_index = 0;
+    if (threshold>inf_bad)
+      threshold=inf_bad;
+    /* Create an active breakpoint representing the beginning of the paragraph */
+    q=new_node(unhyphenated_node,decent_fit);
+    vlink(q)=active; 
+    break_node(q)=null;
+    line_number(q)=cur_list.pg_field+1; 
+    total_demerits(q)=0; 
+    active_short(q)=0;
+    active_glue(q)=0;
+    vlink(active)=q;
+    do_all_eight(store_background);
+    passive=null; 
+    printed_node=temp_head; 
+    pass_number=0;
+    font_in_short_display=null_font;
+    /* /Create an active breakpoint representing the beginning of the paragraph */
+    auto_breaking=true;
+    cur_p=vlink(temp_head); 
+    assert(alink(cur_p)==temp_head);
+    /* LOCAL: Initialize with first |local_paragraph| node */
+    if ((type(cur_p)==whatsit_node)&&(subtype(cur_p)==local_par_node)) {
+      internal_pen_inter=local_pen_inter(cur_p);
+      internal_pen_broken=local_pen_broken(cur_p);
+      init_internal_left_box=local_box_left(cur_p);
+      init_internal_left_box_width=local_box_left_width(cur_p);
+      internal_left_box=init_internal_left_box;
+      internal_left_box_width=init_internal_left_box_width;
+      internal_right_box=local_box_right(cur_p);
+      internal_right_box_width=local_box_right_width(cur_p);
+    } else {
+      internal_pen_inter=0; 
+      internal_pen_broken=0;
+      init_internal_left_box=null; 
+      init_internal_left_box_width=0;
+      internal_left_box=init_internal_left_box;
+      internal_left_box_width=init_internal_left_box_width;
+      internal_right_box=null; 
+      internal_right_box_width=0;
+    }
+    /* /LOCAL: Initialize with first |local_paragraph| node */
+    set_prev_char_p (null);
+    prev_legal = null;
+    rejected_cur_p = null;
+    try_prev_break = false;
+    before_rejected_cur_p = false;
+    first_p = cur_p; 
+    /* to access the first node of paragraph as the first active node
+                        has |break_node=null| */
+    while ((cur_p!=null)&&(vlink(active)!=active)) {
+      /* |try_break| if |cur_p| is a legal breakpoint; on the 2nd pass, also look at disc_nodes. */
+
+      while (is_char_node(cur_p)) {
+        /* Advance \(c)|cur_p| to the node following the present string of characters ;*/
+        /* The code that passes over the characters of words in a paragraph is part of
+           \TeX's inner loop, so it has been streamlined for speed. We use the fact that
+           `\.{\\parfillskip}' glue appears at the end of each paragraph; it is therefore
+           unnecessary to check if |vlink(cur_p)=null| when |cur_p| is a character node.
+        */
+        act_width += (is_rotated(line_break_dir))
+          ? (glyph_height(cur_p)+glyph_depth(cur_p))
+          : glyph_width(cur_p);
+        if ((pdf_adjust_spacing > 1) && check_expand_pars(font(cur_p))) {
+          set_prev_char_p (cur_p);
+          add_char_stretch(active_width[8],cur_p);
+          add_char_shrink(active_width[9],cur_p);
+        }
+        cur_p=vlink(cur_p);
+        while (cur_p==null && nest_index>0) {
+          cur_p = nest_stack[--nest_index];
+		  /*          fprintf(stderr,"Node Pop  %d [%d]\n",nest_index,(int)cur_p); */
+        }
+      }
+      if (cur_p==null) { /* TODO */
+        tconfusion("linebreak_tail");
+      }
+    /* Determine legal breaks: As we move through the hlist, we need to keep
+       the |active_width| array up to date, so that the badness of individual
+       lines is readily calculated by |try_break|. It is convenient to use the
+       short name |act_width| for the component of active width that represents
+       real width as opposed to glue. */
+
+      switch (type(cur_p)) {
+
+      case hlist_node:
+      case vlist_node:
+        act_width += (dir_orthogonal(dir_primary[box_dir(cur_p)], dir_primary[line_break_dir]))
+          ? (depth(cur_p)+height(cur_p))
+          : width(cur_p);
+        break;
+      case rule_node: 
+        act_width += width(cur_p);
+        break;
+      case whatsit_node: 
+        /* @<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>;*/
+        switch (subtype(cur_p)) {
+        case local_par_node: /* @<LOCAL: Advance past a |local_paragraph| node@>;*/
+          internal_pen_inter=local_pen_inter(cur_p);
+          internal_pen_broken=local_pen_broken(cur_p);
+          internal_left_box=local_box_left(cur_p);
+          internal_left_box_width=local_box_left_width(cur_p);
+          internal_right_box=local_box_right(cur_p);
+          internal_right_box_width=local_box_right_width(cur_p);
+          break;
+        case dir_node: /* @<DIR: Adjust the dir stack for the |line_break| routine@>;*/
+          if (dir_dir(cur_p)>=0) {
+            line_break_dir=dir_dir(cur_p);
+            push_dir_node(cur_p);
+          } else {
+            pop_dir_node();
+            if (dir_ptr!=null)
+              line_break_dir=dir_dir(dir_ptr);
+          }
+          break;
+        case pdf_refxform_node:
+        case pdf_refximage_node:
+          act_width += pdf_width(cur_p);
+        }
+        /* / Advance \(p)past a whatsit node in the \(l)|line_break| loop/; */
+        break;
+      case glue_node: 
+        /* @<If node |cur_p| is a legal breakpoint, call |try_break|;
+           then update the active widths by including the glue in
+           |glue_ptr(cur_p)|@>; */
+        /* When node |cur_p| is a glue node, we look at the previous to
+           see whether or not a breakpoint is legal at |cur_p|, as
+           explained above. */
+	if (auto_breaking) {
+          halfword prev_p = alink(cur_p);
+          if (prev_p!=temp_head &&
+             (is_char_node(prev_p) ||
+              precedes_break(prev_p)|| 
+              ((type(prev_p)==kern_node)&&(subtype(prev_p)!=explicit)))) {
+            ext_try_break(0,unhyphenated_node, pdf_adjust_spacing, par_shape_ptr, 
+                          adj_demerits, tracing_paragraphs, pdf_protrude_chars,
+                          line_penalty, last_line_fit,  double_hyphen_demerits,  
+                          final_hyphen_demerits,first_p,cur_p);
+          }
+        }
+        check_shrinkage(glue_ptr(cur_p)); 
+        q=glue_ptr(cur_p);
+        act_width += width(q);
+        active_width[2+stretch_order(q)] += stretch(q);
+        active_width[7] += shrink(q);
+        break;
+      case kern_node: 
+        if (subtype(cur_p)==explicit) {
+          kern_break();
+        } else {
+          act_width += width(cur_p);
+          if ((pdf_adjust_spacing > 1) && (subtype(cur_p) == normal)) {
+            add_kern_stretch(active_width[8],cur_p);
+            add_kern_shrink(active_width[9],cur_p);
+          }
+        }
+        break;
+      case disc_node: 
+        /* @<Try to break after a discretionary fragment, then |goto done5|@>;*/
+        /* The following code knows that discretionary texts contain
+           only character nodes, kern nodes, box nodes, and rule
+           nodes. */
+        if (second_pass) {
+          int actual_penalty = hyphen_penalty;
+          if (subtype(cur_p)==automatic_disc) 
+            actual_penalty = ex_hyphen_penalty;
+          s=vlink_pre_break(cur_p);
+          do_one_seven_eight(reset_disc_width);
+          if (s==null) { /* trivial pre-break */
+            ext_try_break(actual_penalty,hyphenated_node, pdf_adjust_spacing, 
+                          par_shape_ptr, adj_demerits, tracing_paragraphs, 
+                          pdf_protrude_chars, line_penalty, last_line_fit,  
+                          double_hyphen_demerits,  final_hyphen_demerits,first_p,cur_p);
+          } else {
+            do { 
+              /* @<Add the width of node |s| to |disc_width|@>;*/
+              if (is_char_node(s)) { 
+                if (is_rotated(line_break_dir)) {
+                  disc_width[1] += (glyph_height(s)+glyph_depth(s));
+                }  else {
+                  disc_width[1] += glyph_width(s);
+                }
+                if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
+                  set_prev_char_p (s);
+                  add_char_stretch(disc_width[8],s);
+                  add_char_shrink(disc_width[9],s);
+                }
+              } else { 
+                switch (type(s)) {
+                case hlist_node: 
+                case vlist_node: 
+                  if (!(dir_orthogonal(dir_primary[box_dir(s)],
+                                       dir_primary[line_break_dir]))) { 
+                    disc_width[1] += width(s); 
+                  } else { 
+                    disc_width[1] += (depth(s)+height(s));
+                  }
+                  break;
+                case kern_node: 
+                  if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
+                    add_kern_stretch(disc_width[8],s);
+                    add_kern_shrink(disc_width[9],s);
+                  }
+                  /* fall through */
+                case rule_node:
+                  disc_width[1] += width(s);
+                  break;
+                case disc_node:
+                  tconfusion("pre_break_disc");
+		  break;
+                default:
+                  tconfusion("disc3");
+                } 
+              }
+              /* /Add the width of node |s| to |disc_width| */
+              s=vlink(s);
+            } while (s!=null);
+            do_one_seven_eight(add_disc_width_to_active_width);
+            ext_try_break(actual_penalty,hyphenated_node, pdf_adjust_spacing, 
+                          par_shape_ptr, adj_demerits, tracing_paragraphs, 
+                          pdf_protrude_chars, line_penalty, last_line_fit,  
+                          double_hyphen_demerits, final_hyphen_demerits,
+                          first_p,cur_p);
+            do_one_seven_eight(sub_disc_width_from_active_width);
+          }
+#define FOO 1
+#if FOO
+#if 0
+          if (vlink(cur_p)!=null) nest_stack[nest_index++] = vlink(cur_p);
+          cur_p = no_break(cur_p);
+#else
+          s=vlink_no_break(cur_p);
+          while (s!=null) { 
+            /* @<Add the width of node |s| to |act_width|@>;*/
+            if (is_char_node(s)) { 
+              if (is_rotated(line_break_dir)) {
+                act_width += glyph_height(s)+glyph_depth(s);
+              } else {
+                act_width += glyph_width(s);
+              }
+              if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
+                set_prev_char_p (s);
+                add_char_stretch(active_width[8],s);
+                add_char_shrink(active_width[9],s);
+              };
+            } else  {
+              switch (type(s)) {
+              case hlist_node:
+              case vlist_node:
+                if (!(dir_orthogonal(dir_primary[box_dir(s)],
+                                     dir_primary[line_break_dir])))
+                  act_width += width(s);
+                else 
+                  act_width += (depth(s)+height(s));
+                break;
+              case kern_node: 
+                if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
+                  add_kern_stretch(active_width[8],s);
+                  add_kern_shrink(active_width[9],s);
+                }
+                /* fall through */
+              case rule_node:
+                act_width += width(s);
+                break;
+              case disc_node:
+                /* what now */
+                assert(vlink(s)==null); /* discs are _always_ last */
+                /* NB: temporary solution: not good, but not bad either */
+                s = no_break(s);
+                break;
+              default: 
+                tconfusion("disc5");
+              }
+            }
+            /* /Add the width of node |s| to |act_width|;*/
+            s=vlink(s);
+          }
+#endif
+        } else { /* first pass, just take the no_break path */
+#else /* FOO */
+        }
+#endif /* FOO */
+#if 0
+        if (vlink_no_break(cur_p)!=null) {
+          if (vlink(cur_p)!=null) nest_stack[nest_index++] = vlink(cur_p);
+		  /*          fprintf(stderr,"Node Push %d [%d]->[%d] / [%d]\n",(nest_index-1),(int)cur_p,(int)vlink(cur_p),(int)vlink_no_break(cur_p));*/
+          cur_p = no_break(cur_p);
+        }
+#else
+          s=vlink_no_break(cur_p);
+          while (s!=null) { 
+            /* @<Add the width of node |s| to |act_width|@>;*/
+            if (is_char_node(s)) { 
+              if (is_rotated(line_break_dir)) {
+                act_width += glyph_height(s)+glyph_depth(s);
+              } else {
+                act_width += glyph_width(s);
+              }
+              if ((pdf_adjust_spacing > 1) && check_expand_pars(font(s))) {
+                set_prev_char_p (s);
+                add_char_stretch(active_width[8],s);
+                add_char_shrink(active_width[9],s);
+              };
+            } else  {
+              switch (type(s)) {
+              case hlist_node:
+              case vlist_node:
+                if (!(dir_orthogonal(dir_primary[box_dir(s)],
+                                     dir_primary[line_break_dir])))
+                  act_width += width(s);
+                else 
+                  act_width += (depth(s)+height(s));
+                break;
+              case kern_node: 
+                if ((pdf_adjust_spacing > 1) && (subtype(s) == normal)) {
+                  add_kern_stretch(active_width[8],s);
+                  add_kern_shrink(active_width[9],s);
+                }
+                /* fall through */
+              case rule_node:
+                act_width += width(s);
+                break;
+              case disc_node:
+                assert(vlink(s)==null); /* discs are _always_ last */
+                s = no_break(s);
+                break;
+              default: 
+                tconfusion("disc4");
+              }
+            }
+            /* /Add the width of node |s| to |act_width|;*/
+            s=vlink(s);
+          }
+#endif
+#if FOO
+        }
+#endif /* FOO */
+        break;
+      case math_node: 
+        auto_breaking=(subtype(cur_p)==after); 
+        kern_break();
+        break;
+      case penalty_node: 
+        ext_try_break(penalty(cur_p),unhyphenated_node, pdf_adjust_spacing, 
+                      par_shape_ptr, adj_demerits, tracing_paragraphs, 
+                      pdf_protrude_chars, line_penalty, last_line_fit,
+                      double_hyphen_demerits,  final_hyphen_demerits,first_p,cur_p);
+        break;
+      case mark_node:
+      case ins_node:
+      case adjust_node: 
+        break;
+      case glue_spec_node: 
+        fprintf(stdout, "\nfound a glue_spec in a paragraph!"); 
+        break;
+      default: 
+        fprintf(stdout, "\ntype=%d",type(cur_p));
+        tconfusion("paragraph") ;
+      }
+      cur_p=vlink(cur_p); 
+      while (cur_p==null && nest_index>0) {
+        cur_p = nest_stack[--nest_index];
+		/*        fprintf(stderr,"Node Pop  %d [%d]\n",nest_index,(int)cur_p);*/
+      }
+    }
+    if (cur_p==null) {
+      /* Try the final line break at the end of the paragraph,
+         and |goto done| if the desired breakpoints have been found */
+
+      /* The forced line break at the paragraph's end will reduce the list of
+         breakpoints so that all active nodes represent breaks at |cur_p=null|.
+         On the first pass, we insist on finding an active node that has the
+         correct ``looseness.'' On the final pass, there will be at least one active
+         node, and we will match the desired looseness as well as we can.
+         
+         The global variable |best_bet| will be set to the active node for the best
+         way to break the paragraph, and a few other variables are used to
+         help determine what is best.
+      */
+         
+      ext_try_break(eject_penalty,hyphenated_node, pdf_adjust_spacing, 
+                    par_shape_ptr, adj_demerits, tracing_paragraphs, 
+                    pdf_protrude_chars,line_penalty, last_line_fit,
+                    double_hyphen_demerits,  final_hyphen_demerits,first_p,cur_p);
+      if (vlink(active)!=active) {
+        /* @<Find an active node with fewest demerits@>;*/
+        r=vlink(active); 
+        fewest_demerits=awful_bad;
+        do {
+          if (type(r)!=delta_node) {
+            if (total_demerits(r)<fewest_demerits) {
+              fewest_demerits=total_demerits(r); 
+              best_bet=r;
+            }
+          }
+          r=vlink(r);
+        } while (r!=active);
+        best_line=line_number(best_bet);
+
+        /* /Find an active node with fewest demerits;*/
+        if (looseness==0) 
+          goto DONE;
+        /*@<Find the best active node for the desired looseness@>;*/
+
+        /* The adjustment for a desired looseness is a slightly more complicated
+           version of the loop just considered. Note that if a paragraph is broken
+           into segments by displayed equations, each segment will be subject to the
+           looseness calculation, independently of the other segments.
+        */
+        r=vlink(active); 
+        actual_looseness=0;
+        do {
+          if (type(r)!=delta_node) {
+            line_diff=line_number(r)-best_line;
+            if (((line_diff<actual_looseness)&&(looseness<=line_diff))||
+                ((line_diff>actual_looseness)&&(looseness>=line_diff))) {
+              best_bet=r; 
+              actual_looseness=line_diff;
+              fewest_demerits=total_demerits(r);
+            } else if ((line_diff==actual_looseness)&&
+                       (total_demerits(r)<fewest_demerits)) {
+              best_bet=r; 
+              fewest_demerits=total_demerits(r);
+            }
+          }
+          r=vlink(r);
+        } while (r!=active);
+        best_line=line_number(best_bet);
+
+        /* /Find the best active node for the desired looseness;*/
+        if ((actual_looseness==looseness)|| final_pass) 
+          goto DONE;
+      }
+    }
+    
+    /* Clean up the memory by removing the break nodes; */
+    clean_up_the_memory();
+    /* /Clean up the memory by removing the break nodes; */
+
+    if (!second_pass)  { 
+      if (tracing_paragraphs>0) 
+        tprint_nl("@secondpass");
+      threshold=tolerance; 
+      second_pass=true; 
+      final_pass=(emergency_stretch<=0);
+    }  else {  /* if at first you do not succeed, \dots */
+      if (tracing_paragraphs>0)
+        tprint_nl("@emergencypass");
+      background[2] += emergency_stretch; 
+      final_pass=true;
+    }
+  }
+ DONE:  
+  if (tracing_paragraphs>0) { 
+    end_diagnostic(true); 
+    normalize_selector(); 
+  }
+  if (do_last_line_fit) {
+    /* Adjust \(t)the final line of the paragraph;*/
+    /* Here we either reset |do_last_line_fit| or adjust the |par_fill_skip| glue.
+     */
+    if (active_short(best_bet)==0) {
+      do_last_line_fit=false;
+    } else { 
+      q=new_spec(glue_ptr(last_line_fill));
+      delete_glue_ref(glue_ptr(last_line_fill));
+      width(q) += (active_short(best_bet)-active_glue(best_bet));
+      stretch(q)=0; 
+      glue_ptr(last_line_fill)=q;
+    }
+    /* /Adjust \(t)the final line of the paragraph;*/
+  }
+
+  /* @<Break the paragraph at the chosen...@>; */
+  /* Once the best sequence of breakpoints has been found (hurray), we call on the
+     procedure |post_line_break| to finish the remainder of the work.
+     (By introducing this subprocedure, we are able to keep |line_break|
+     from getting extremely long.)
+  */
+  ext_post_line_break(d,
+		      right_skip,
+		      left_skip,
+		      pdf_protrude_chars,
+		      par_shape_ptr,
+		      pdf_adjust_spacing,
+		      pdf_each_line_height,
+		      pdf_each_line_depth,
+		      pdf_first_line_height,
+		      pdf_last_line_depth,
+		      inter_line_penalties_ptr,
+		      inter_line_penalty,
+		      club_penalty,
+		      club_penalties_ptr,
+		      display_widow_penalties_ptr,
+		      widow_penalties_ptr,
+		      display_widow_penalty,
+		      widow_penalty,
+		      broken_penalty,
+		      final_par_glue,
+		      best_bet,
+		      last_special_line,
+		      second_width,
+		      second_indent,
+		      first_width,
+		      first_indent,
+		      best_line
+		      );
+  /* /Break the paragraph at the chosen... */
+  /* Clean up the memory by removing the break nodes; */
+  clean_up_the_memory();
+  /*
+	flush_node_list(dir_ptr);
+	dir_ptr=null;
+  */
+}
+
+
diff --git a/Build/source/texk/web2c/luatexdir/tex/postlinebreak.c b/Build/source/texk/web2c/luatexdir/tex/postlinebreak.c
new file mode 100644
index 00000000000..86b9562c262
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tex/postlinebreak.c
@@ -0,0 +1,512 @@
+/* $Id: postlinebreak.c 1078 2008-03-05 15:33:46Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+/* So far we have gotten a little way into the |line_break| routine, having
+covered its important |try_break| subroutine. Now let's consider the
+rest of the process.
+
+The main loop of |line_break| traverses the given hlist,
+starting at |vlink(temp_head)|, and calls |try_break| at each legal
+breakpoint. A variable called |auto_breaking| is set to true except
+within math formulas, since glue nodes are not legal breakpoints when
+they appear in formulas.
+
+The current node of interest in the hlist is pointed to by |cur_p|. Another
+variable, |prev_p|, is usually one step behind |cur_p|, but the real
+meaning of |prev_p| is this: If |type(cur_p)=glue_node| then |cur_p| is a legal
+breakpoint if and only if |auto_breaking| is true and |prev_p| does not
+point to a glue node, penalty node, explicit kern node, or math node.
+
+*/
+
+static halfword 
+do_push_dir_node (halfword p, halfword a ) {
+  halfword n;
+  n = copy_node(a);
+  vlink(n) = p; 
+  return n;
+}
+
+static halfword 
+do_pop_dir_node ( halfword p ) {
+  halfword n = vlink(p); 
+  flush_node(p);
+  return n;
+}
+
+
+/* The total number of lines that will be set by |post_line_break|
+is |best_line-prev_graf-1|. The last breakpoint is specified by
+|break_node(best_bet)|, and this passive node points to the other breakpoints
+via the |prev_break| links. The finishing-up phase starts by linking the
+relevant passive nodes in forward order, changing |prev_break| to
+|next_break|. (The |next_break| fields actually reside in the same memory
+space as the |prev_break| fields did, but we give them a new name because
+of their new significance.) Then the lines are justified, one by one.
+
+The |post_line_break| must also keep an dir stack, so that it can
+output end direction instructions at the ends of lines
+and begin direction instructions at the beginnings of lines.
+
+*/
+
+#define next_break prev_break /*new name for |prev_break| after links are reversed*/
+
+#define append_list(a,b)						\
+  { vlink(cur_list.tail_field)=vlink((a)); cur_list.tail_field = b; }
+
+#define left_skip_code 7 /*glue at left of justified lines*/
+#define right_skip_code 8 /*glue at right of justified lines*/
+
+/* the ints are actually halfwords */
+void ext_post_line_break(boolean d, 
+			 int right_skip,
+			 int left_skip,
+			 int pdf_protrude_chars,
+			 halfword par_shape_ptr,
+			 int pdf_adjust_spacing,
+			 int pdf_each_line_height,
+			 int pdf_each_line_depth,
+			 int pdf_first_line_height,
+			 int pdf_last_line_depth,
+			 halfword inter_line_penalties_ptr,
+			 int inter_line_penalty,
+			 int club_penalty,
+			 halfword club_penalties_ptr,
+			 halfword display_widow_penalties_ptr,
+			 halfword widow_penalties_ptr,
+			 int display_widow_penalty,
+			 int widow_penalty,
+			 int broken_penalty,
+			 halfword final_par_glue,
+			 halfword best_bet,
+			 halfword last_special_line,
+			 scaled second_width,
+			 scaled second_indent,
+			 scaled first_width,
+			 scaled first_indent,
+			 halfword best_line ) {
+
+  boolean have_directional = true;
+  halfword q,r,s; /* temporary registers for list manipulation */
+  halfword  p, k;
+  scaled w;
+  boolean glue_break; /* was a break at glue? */
+  boolean disc_break; /*was the current break at a discretionary node?*/
+  boolean post_disc_break; /*and did it have a nonempty post-break part?*/
+  scaled cur_width; /*width of line number |cur_line|*/
+  scaled cur_indent; /*left margin of line number |cur_line|*/
+  integer pen; /*use when calculating penalties between lines */
+  halfword cur_p; /* cur_p, but localized */
+  halfword cur_line; /*the current line number being justified*/
+
+  dir_ptr = cur_list.dirs_field;
+  /* @<Reverse the links of the relevant passive nodes, setting |cur_p| to 
+     the first breakpoint@>; */
+  /* The job of reversing links in a list is conveniently regarded as the job
+     of taking items off one stack and putting them on another. In this case we
+     take them off a stack pointed to by |q| and having |prev_break| fields;
+     we put them on a stack pointed to by |cur_p| and having |next_break| fields.
+     Node |r| is the passive node being moved from stack to stack.
+  */
+  q=break_node(best_bet); 
+  /*used_discs = used_disc(best_bet);*/
+  /*has_direction*/
+  cur_p=null;
+  do { 
+    r=q; 
+    q=prev_break(q); 
+    next_break(r)=cur_p; 
+    cur_p=r;
+  } while (q!=null);  
+  /* |cur_p| is now the first breakpoint; */
+
+  cur_line=cur_list.pg_field+1; /* prevgraf+1 */
+
+  do {
+    /* @<Justify the line ending at breakpoint |cur_p|, and append it to the
+       current vertical list, together with associated penalties and other
+       insertions@>;	*/
+    /* The current line to be justified appears in a horizontal list starting
+       at |vlink(temp_head)| and ending at |cur_break(cur_p)|. If |cur_break(cur_p)| is
+       a glue node, we reset the glue to equal the |right_skip| glue; otherwise
+       we append the |right_skip| glue at the right. If |cur_break(cur_p)| is a
+       discretionary node, we modify the list so that the discretionary break
+       is compulsory, and we set |disc_break| to |true|. We also append
+       the |left_skip| glue at the left of the line, unless it is zero. */
+
+#if 0
+	tprint("BEGIN OF LINE ");
+	print_int(cur_break(cur_p));
+	breadth_max=100000;
+	depth_threshold=100000;
+	show_node_list(temp_head);
+#endif
+    
+    /* DIR: Insert dir nodes at the beginning of the current line;*/
+    for (q=dir_ptr;q!=null;q=vlink(q)) {
+      halfword tmp = new_dir(dir_dir(q));
+      halfword nxt = vlink(temp_head);
+      couple_nodes(temp_head,tmp);
+      couple_nodes(tmp,nxt);
+    }
+    if (dir_ptr!=null) {
+      flush_node_list(dir_ptr); dir_ptr=null;
+    }
+
+    /* Modify the end of the line to reflect the nature of the break and to
+       include \.{\\rightskip}; also set the proper value of |disc_break|; */
+    /* At the end of the following code, |q| will point to the final node on the
+       list about to be justified. In the meanwhile |r| will point to the
+       node we will use to insert end-of-line stuff after. |q==null| means
+       we use the final position of |r| */
+    r = cur_break(cur_p); 
+    q = null;
+    disc_break=false; 
+    post_disc_break=false;
+    glue_break = false;
+
+    if (r==null) {
+      for (r=temp_head; vlink(r)!=null; r=vlink(r));
+      if (r==final_par_glue) {
+        /* This should almost always be true... */
+        /* TODO assert ? */
+        q = r;
+        /* |q| refers to the last node of the line (and paragraph) */
+        r = alink(r);
+      }
+      /* |r| refers to the node after which the dir nodes should be closed */
+    } else if (type(r)==glue_node) {
+      delete_glue_ref(glue_ptr(r));
+      glue_ptr(r)=right_skip;
+      subtype(r)=right_skip_code+1; 
+      incr(glue_ref_count(right_skip));
+      glue_break = true;
+      /* |q| refers to the last node of the line */
+      q = r;
+      r=alink(r);
+      assert(vlink(r)==q);
+      /* |r| refers to the node after which the dir nodes should be closed */
+    } else if (type(r)==disc_node) {
+      halfword a = alink(r);
+      assert(a!=null);
+      halfword v = vlink(r);
+      if (v==null) { /* nested disc, let's unfold */
+        fprintf(stderr,"Nested disc [%d]<-[%d]->null\n",(int)a,(int)r);
+        do {
+          halfword d;
+          while (alink(a)!=null) a = alink(a);
+          assert(type(a)==nesting_node);
+          assert(subtype(a)=no_break_head(0)); /* No_break */
+          d = a - subtype(a); /* MAGIC subtype is offset of nesting with disc */
+          assert(type(d)==disc_node);
+          v = vlink(d);
+          a = alink(d);
+          fprintf(stderr,"Up to disc [%d]<-[%d]->[%d] & link [%d]\n",(int)a,(int)d,(int)v,(int)vlink_no_break(d));
+          assert(a!=null);
+          couple_nodes(a,vlink_no_break(d));
+          vlink_no_break(d)=null; 
+          tlink_no_break(d)=null;
+          flush_node(d); 
+        } while (v==null);
+        couple_nodes(r,v);
+        fprintf(stderr,"Close list [%d]<->[%d] a=[%d]\n",(int)r,(int)v,(int)alink(r));
+        a = alink(r);
+      }
+      if (vlink_no_break(r)!=null) {
+        flush_node_list(vlink_no_break(r));
+        vlink_no_break(r)=null;
+        tlink_no_break(r)=null;
+      }
+      if (vlink_pre_break(r)!=null) {
+        couple_nodes(a,vlink_pre_break(r));
+        couple_nodes(tlink_pre_break(r),r);
+        vlink_pre_break(r)=null; 
+        tlink_pre_break(r)=null; 
+      }
+      if (vlink_post_break(r)!=null) {
+        couple_nodes(r,vlink_post_break(r));
+        couple_nodes(tlink_post_break(r),v);
+        vlink_post_break(r)=null; 
+        tlink_post_break(r)=null; 
+        post_disc_break = true;
+      }
+      disc_break=true;
+    } else if (type(r)==kern_node) {
+      width(r)=0;
+    } else if (type(r)==math_node) {
+      surround(r)=0;
+    }
+
+    /* DIR: Adjust the dir stack based on dir nodes in this line; */
+    /* TODO what about the previousparagraph ??? */
+    if (have_directional) {
+      halfword e;
+      halfword p;
+      for(e=vlink(temp_head); e!=null && e!=cur_break(cur_p); e=vlink(e)) {
+        if (type(e)!=whatsit_node || subtype(e)!=dir_node)
+          continue;
+        if (dir_dir(e)>=0) {
+          dir_ptr = do_push_dir_node(dir_ptr,e);
+        } else if (dir_ptr!=null && dir_dir(dir_ptr)==(dir_dir(e)+64)) {
+          dir_ptr = do_pop_dir_node(dir_ptr);
+        }
+      }
+      assert(e==cur_break(cur_p)); 
+
+      /* @<DIR: Insert dir nodes at the end of the current line@>;*/
+      e = vlink(r);
+      for (p=dir_ptr; p!=null; p=vlink(p)) {
+        halfword s=new_dir(dir_dir(p)-64);
+        couple_nodes(r,s);
+        try_couple_nodes(s,e);
+        r=s;
+      }
+    }
+    if (passive_right_box(cur_p)!=null) {
+      /* TODO: CHECK has |s| below a |alink| ? */
+      halfword s = copy_node_list(passive_right_box(cur_p));
+      halfword e = vlink(r);
+      couple_nodes(r,s);
+      try_couple_nodes(s,e);
+      r=s;
+    }
+    if (q==null) {
+      q = r;
+    }
+    /* Now [q] refers to the last node on the line */
+
+    /* FIXME from this point on we no longer keep alink() valid */
+
+    /* at this point |q| is the rightmost breakpoint; the only exception is
+       the case of a discretionary break with non-empty |pre_break|, then |q|
+       has been changed to the last node of the |pre_break| list */
+	/* If the par ends with a \break command, the last line is utterly empty.
+       That is the case of |q==temp_head| */
+    if (q!=temp_head && pdf_protrude_chars > 0) {
+      halfword ptmp;
+      if (disc_break && (is_char_node(q) || (type(q) != disc_node))) {
+        p = q; /* |q| has been reset to the last node of |pre_break| */
+        ptmp = p;
+      } else {
+        p = alink(q); /* get |vlink(p) = q| */
+		assert(vlink(p)==q);
+        ptmp = p;
+        p = find_protchar_right(vlink(temp_head), p);
+      }
+      w = char_pw(p, right_side);
+      if (w!=0) { /* we have found a marginal kern, append it after |ptmp| */
+		k = new_margin_kern(-w, last_rightmost_char, right_side);
+        vlink(k) = vlink(ptmp);
+        vlink(ptmp) = k;
+        if (ptmp == q) 
+	  q = vlink(q);
+      }
+    }
+    /* if |q| was not a breakpoint at glue and has been reset to |rightskip|
+       then we append |rightskip| after |q| now */
+    if (!glue_break) {
+      /* @<Put the \(r)\.{\\rightskip} glue after node |q|@>;*/
+      halfword r=new_param_glue(right_skip_code); 
+      vlink(r)=vlink(q); 
+      vlink(q)=r; 
+      q=r;
+    }
+
+    /* /Modify the end of the line to reflect the nature of the break and to
+       include \.{\\rightskip}; also set the proper value of |disc_break|; */
+
+    /* Put the \(l)\.{\\leftskip} glue at the left and detach this line;*/
+    /* The following code begins with |q| at the end of the list to be
+       justified. It ends with |q| at the beginning of that list, and with
+       |vlink(temp_head)| pointing to the remainder of the paragraph, if any. */
+    r=vlink(q); 
+    vlink(q)=null; 
+
+    q=vlink(temp_head); 
+    try_couple_nodes(temp_head,r);
+    if (passive_left_box(cur_p)!=null && passive_left_box(cur_p)!=0) {
+      /* omega bits: */
+      r=copy_node_list(passive_left_box(cur_p));
+      s=vlink(q);
+      vlink(r)=q;
+      q=r;
+      if ((cur_line==cur_list.pg_field+1) && (s!=null)) {
+	if (type(s)==hlist_node) {
+	  if (list_ptr(s)==null) {
+	    q=vlink(q);
+	    vlink(r)=vlink(s);
+	    vlink(s)=r;
+	  }
+	}
+      }
+    }
+    /*at this point |q| is the leftmost node; all discardable nodes have been discarded */
+    if (pdf_protrude_chars > 0) {
+      p = q;
+      p = find_protchar_left(p, false); /* no more discardables */
+      w =  char_pw(p, left_side);
+      if (w != 0) {
+        k = new_margin_kern(-w, last_leftmost_char, left_side);
+        vlink(k) = q;
+        q = k;
+      }
+    };
+    if (left_skip!=zero_glue) {
+      r=new_param_glue(left_skip_code);
+      vlink(r)=q; 
+      q=r;
+    }
+    /* /Put the \(l)\.{\\leftskip} glue at the left and detach this line;*/
+
+    /* Call the packaging subroutine, setting |just_box| to the justified box;*/
+    /* Now |q| points to the hlist that represents the current line of the
+       paragraph. We need to compute the appropriate line width, pack the
+       line into a box of this size, and shift the box by the appropriate
+       amount of indentation. */
+    if (cur_line>last_special_line) {
+      cur_width=second_width; 
+      cur_indent=second_indent;
+    } else if (par_shape_ptr==null) {
+      cur_width=first_width; 
+      cur_indent=first_indent;
+    } else  { 
+      cur_indent=varmem[(par_shape_ptr+2*cur_line)].cint;
+      cur_width=varmem[(par_shape_ptr+2*cur_line+1)].cint;
+    }
+    adjust_tail=adjust_head;
+    pack_direction=paragraph_dir;
+    pre_adjust_tail = pre_adjust_head;
+    if (pdf_adjust_spacing > 0 ) {
+      just_box = hpack(q, cur_width, cal_expand_ratio);
+    } else {
+      just_box = hpack(q, cur_width, exactly);
+    }
+    shift_amount(just_box)=cur_indent;
+    /* /Call the packaging subroutine, setting |just_box| to the justified box;*/
+
+    /* Append the new box to the current vertical list, followed by the list of
+       special nodes taken out of the box by the packager;*/
+    if (pdf_each_line_height!=0)
+      height(just_box) = pdf_each_line_height;
+    if (pdf_each_line_depth != 0)
+      depth(just_box) = pdf_each_line_depth;
+    if ((pdf_first_line_height != 0) && (cur_line ==  cur_list.pg_field + 1))
+      height(just_box) = pdf_first_line_height;
+    if ((pdf_last_line_depth != 0) && (cur_line + 1 == best_line))
+      depth(just_box) = pdf_last_line_depth;
+
+    if (pre_adjust_head != pre_adjust_tail) 
+      append_list(pre_adjust_head,pre_adjust_tail);
+    pre_adjust_tail = null;
+    append_to_vlist(just_box);
+    if (adjust_head != adjust_tail) 
+      append_list(adjust_head,adjust_tail);
+    adjust_tail = null;
+
+    /* /Append the new box to the current vertical list, followed by the list of
+       special nodes taken out of the box by the packager;*/
+
+    /* Append a penalty node, if a nonzero penalty is appropriate */
+    /* Penalties between the lines of a paragraph come from club and widow lines,
+       from the |inter_line_penalty| parameter, and from lines that end at
+       discretionary breaks.  Breaking between lines of a two-line paragraph gets
+       both club-line and widow-line penalties. The local variable |pen| will
+       be set to the sum of all relevant penalties for the current line, except
+       that the final line is never penalized. */
+    if (cur_line+1!=best_line) {
+      q=inter_line_penalties_ptr;
+      if (q!=null) {
+	r=cur_line;
+	if (r>penalty(q))
+	  r=penalty(q);
+	pen=penalty(q+r);
+      } else {
+	if (passive_pen_inter(cur_p)!=0) {
+	  pen=passive_pen_inter(cur_p);
+	} else {
+	  pen=inter_line_penalty;
+	}
+      }
+      q=club_penalties_ptr;
+      if (q!=null) {
+	r=cur_line-cur_list.pg_field; /* prevgraf */
+	if (r>penalty(q))  
+	  r=penalty(q);
+	pen += penalty(q+r);
+      } else if (cur_line==cur_list.pg_field+1) { /* prevgraf */
+	pen += club_penalty;
+      }
+      if (d)
+	q = display_widow_penalties_ptr;
+      else 
+	q = widow_penalties_ptr;
+      if (q!=null) {
+	r=best_line-cur_line-1;
+	if (r>penalty(q)) 
+	  r=penalty(q);
+	pen += penalty(q+r);
+      } else if (cur_line+2==best_line) {
+	if (d)
+	  pen += display_widow_penalty;
+	else
+	  pen += widow_penalty;
+      }
+      if (disc_break) {
+	if (passive_pen_broken(cur_p)!=0) {
+	  pen += passive_pen_broken(cur_p);
+	} else {
+	  pen += broken_penalty;
+	}
+      }
+      if (pen!=0) {
+		r=new_penalty(pen);
+		couple_nodes(cur_list.tail_field,r);
+		cur_list.tail_field=r;
+      }
+    }
+    /* /Append a penalty node, if a nonzero penalty is appropriate */
+    
+    /* /Justify the line ending at breakpoint |cur_p|, and append it to the
+       current vertical list, together with associated penalties and other
+       insertions@>;   */
+    incr(cur_line); 
+    cur_p=next_break(cur_p);
+    if (cur_p!=null && !post_disc_break) {
+      /* @<Prune unwanted nodes at the beginning of the next line@>; */
+      /* Glue and penalty and kern and math nodes are deleted at the
+	 beginning of a line, except in the anomalous case that the
+	 node to be deleted is actually one of the chosen
+	 breakpoints. Otherwise the pruning done here is designed to
+	 match the lookahead computation in |try_break|, where the
+	 |break_width| values are computed for non-discretionary
+	 breakpoints. */	  
+      r=temp_head;
+      while(1) {
+		q=vlink(r);
+		if (q==cur_break(cur_p) || is_char_node(q))
+		  break;
+		if (!((type(q)==whatsit_node)&&(subtype(q)==local_par_node))) {
+		  if (non_discardable(q) 
+			  || (type(q)==kern_node && subtype(q)!=explicit ))
+			break;
+		}
+		r=q; 
+      };
+      if (r!=temp_head) { 
+		vlink(r)=null; 
+		flush_node_list(vlink(temp_head));
+		try_couple_nodes(temp_head,q);
+      }
+    }
+  } while (cur_p!=null);
+  if ((cur_line!=best_line)||(vlink(temp_head)!=null)) 
+	tconfusion("line breaking");
+  cur_list.pg_field=best_line-1;  /* prevgraf */
+  cur_list.dirs_field=dir_ptr; /* dir_save */
+  dir_ptr = null;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/tex/texnodes.c b/Build/source/texk/web2c/luatexdir/tex/texnodes.c
new file mode 100644
index 00000000000..06004160503
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tex/texnodes.c
@@ -0,0 +1,1694 @@
+/* $Id: texnodes.c 1103 2008-03-11 14:32:50Z taco $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include "nodes.h"
+
+#define MAX_CHAIN_SIZE 12
+
+volatile memory_word *varmem = NULL;
+
+#ifndef NDEBUG
+char *varmem_sizes = NULL;
+#endif
+
+halfword var_mem_max = 0;
+halfword rover = 0;
+
+halfword free_chain[MAX_CHAIN_SIZE] = {null};
+
+static int prealloc=0;
+
+int fix_node_lists=1;
+
+int free_error_seen = 0;
+int copy_error_seen = 0;
+
+halfword slow_get_node (integer s) ; /* defined below */
+int copy_error (halfword p) ; /* define below */
+
+#undef link /* defined by cpascal.h */
+#define info(a)    fixmem[(a)].hhlh
+#define link(a)    fixmem[(a)].hhrh
+
+#define fake_node 100
+#define fake_node_size 2
+#define fake_node_name "fake"
+
+#define variable_node_size 2
+
+
+char * node_fields_list                       [] = { "attr", "width", "depth", "height", "dir", "shift", 
+ 						    "glue_order", "glue_sign", "glue_set" , "list",  NULL };
+char * node_fields_rule                       [] = { "attr", "width", "depth", "height", "dir", NULL };
+char * node_fields_insert                     [] = { "attr", "cost",  "depth", "height", "spec", "list", NULL };
+char * node_fields_mark                       [] = { "attr", "class", "mark", NULL }; 
+char * node_fields_adjust                     [] = { "attr", "list", NULL }; 
+char * node_fields_disc                       [] = { "attr", "pre", "post", "replace", NULL };
+char * node_fields_math                       [] = { "attr", "surround", NULL }; 
+char * node_fields_glue                       [] = { "attr", "spec", "leader", NULL }; 
+char * node_fields_kern                       [] = { "attr", "kern", NULL };
+char * node_fields_penalty                    [] = { "attr", "penalty", NULL };
+char * node_fields_unset                      [] = { "attr", "width", "depth", "height", "dir", "shrink",
+ 						    "glue_order", "glue_sign", "stretch" , "span",  "list",  NULL };
+char * node_fields_margin_kern                [] = { "attr", "width", "glyph", NULL };
+char * node_fields_glyph                      [] = { "attr", "char", "font", "lang", "left", "right", "uchyph", 
+ 						    "components", "xoffset", "yoffset", NULL };
+char * node_fields_style                      [] = { NULL };
+char * node_fields_choice                     [] = { NULL };
+char * node_fields_ord                        [] = { NULL };
+char * node_fields_op                         [] = { NULL };
+char * node_fields_bin                        [] = { NULL };
+char * node_fields_rel                        [] = { NULL };
+char * node_fields_open                       [] = { NULL };
+char * node_fields_close                      [] = { NULL };
+char * node_fields_punct                      [] = { NULL };
+char * node_fields_inner                      [] = { NULL };
+char * node_fields_radical                    [] = { NULL };
+char * node_fields_fraction                   [] = { NULL };
+char * node_fields_under                      [] = { NULL };
+char * node_fields_over                       [] = { NULL };
+char * node_fields_accent                     [] = { NULL };
+char * node_fields_vcenter                    [] = { NULL };
+char * node_fields_left                       [] = { NULL };
+char * node_fields_right                      [] = { NULL };
+
+char * node_fields_inserting                  [] = { "height", "last_ins_ptr", "best_ins_ptr", NULL};
+
+char * node_fields_splitup                    [] = { "height", "last_ins_ptr", "best_ins_ptr", 
+                                                     "broken_ptr", "broken_ins", NULL};
+						
+char * node_fields_action                     [] = { "action_type", "named_id", "action_id", 
+ 						    "file", "new_window", "data", "ref_count", NULL };
+char * node_fields_attribute                  []  = { "number", "value", NULL };
+char * node_fields_glue_spec                  []  = { "width", "stretch", "shrink", 
+ 						     "stretch_order", "shrink_order", "ref_count", NULL };
+char * node_fields_attribute_list             []  = { NULL };
+						
+char * node_fields_whatsit_open               [] = { "attr", "stream", "name", "area", "ext", NULL };
+char * node_fields_whatsit_write              [] = { "attr", "stream", "data", NULL };
+char * node_fields_whatsit_close              [] = { "attr", "stream", NULL };
+char * node_fields_whatsit_special            [] = { "attr", "data", NULL };
+						
+char * node_fields_whatsit_local_par          [] = { "attr", "pen_inter", "pen_broken", "dir", 
+ 						    "box_left", "box_left_width", "box_right", "box_right_width", NULL };
+char * node_fields_whatsit_dir                [] = { "attr", "dir", "level", "dvi_ptr", "dvi_h", NULL };
+						
+char * node_fields_whatsit_pdf_literal        [] = { "attr", "mode", "data", NULL };
+char * node_fields_whatsit_pdf_refobj         [] = { "attr", "objnum", NULL };
+char * node_fields_whatsit_pdf_refxform       [] = { "attr", "width", "height", "depth", "objnum", NULL };
+char * node_fields_whatsit_pdf_refximage      [] = { "attr", "width", "height", "depth", "objnum", NULL };
+char * node_fields_whatsit_pdf_annot          [] = { "attr", "width", "height", "depth", "objnum", "data", NULL };
+char * node_fields_whatsit_pdf_start_link     [] = { "attr", "width", "height", "depth", 
+ 						    "objnum", "link_attr", "action", NULL };
+char * node_fields_whatsit_pdf_end_link       [] = { "attr", NULL };
+char * node_fields_whatsit_pdf_dest           [] = { "attr", "width", "height", "depth", 
+ 						    "named_id", "dest_id", "dest_type", "xyz_zoom", "objnum",  NULL };
+char * node_fields_whatsit_pdf_thread         [] = { "attr", "width", "height", "depth", 
+ 						    "named_id", "thread_id", "thread_attr", NULL };
+char * node_fields_whatsit_pdf_start_thread   [] = { "attr", "width", "height", "depth", 
+ 						    "named_id", "thread_id", "thread_attr", NULL };
+char * node_fields_whatsit_pdf_end_thread     [] = { "attr", NULL };
+char * node_fields_whatsit_pdf_save_pos       [] = { "attr", NULL };
+char * node_fields_whatsit_late_lua           [] = { "attr", "reg", "data", NULL };
+char * node_fields_whatsit_close_lua          [] = { "attr", "reg", NULL };
+char * node_fields_whatsit_pdf_colorstack     [] = { "attr", "stack", "cmd", "data", NULL };
+char * node_fields_whatsit_pdf_setmatrix      [] = { "attr", "data", NULL };
+char * node_fields_whatsit_pdf_save           [] = { "attr", NULL };
+char * node_fields_whatsit_pdf_restore        [] = { "attr", NULL };
+char * node_fields_whatsit_cancel_boundary    [] = { "attr", NULL };
+char * node_fields_whatsit_user_defined       [] = { "attr", "user_id", "type", "value", NULL };
+
+node_info node_data[] = {
+  { hlist_node,           box_node_size,             node_fields_list,        "hlist"          },
+  { vlist_node,           box_node_size,             node_fields_list,        "vlist"          },
+  { rule_node,            rule_node_size,            node_fields_rule,        "rule"           },
+  { ins_node,             ins_node_size,             node_fields_insert,      "ins"            },
+  { mark_node,            mark_node_size,            node_fields_mark,        "mark"           },
+  { adjust_node,          adjust_node_size,          node_fields_adjust,      "adjust"         },
+  { fake_node,            fake_node_size,            NULL,                    fake_node_name  }, /* don't touch this! */
+  { disc_node,            disc_node_size,            node_fields_disc,        "disc"           },
+  { whatsit_node,         -1,                        NULL,                    "whatsit"        },
+  { math_node,            math_node_size,            node_fields_math,        "math"           },
+  { glue_node,            glue_node_size,            node_fields_glue,        "glue"           },
+  { kern_node,            kern_node_size,            node_fields_kern,        "kern"           },
+  { penalty_node,         penalty_node_size,         node_fields_penalty,     "penalty"        },
+  { unset_node,           box_node_size,             node_fields_unset,       "unset"          },
+  { style_node,           style_node_size,           node_fields_style,       "style"          },
+  { choice_node,          style_node_size,           node_fields_choice,      "choice"         },
+  { ord_noad,             noad_size,                 node_fields_ord,         "ord"            },
+  { op_noad,              noad_size,                 node_fields_op,          "op"             },
+  { bin_noad,             noad_size,                 node_fields_bin,         "bin"            },
+  { rel_noad,             noad_size,                 node_fields_rel,         "rel"            },
+  { open_noad,            noad_size,                 node_fields_open,        "open"           },
+  { close_noad,           noad_size,                 node_fields_close,       "close"          },
+  { punct_noad,           noad_size,                 node_fields_punct,       "punct"          },
+  { inner_noad,           noad_size,                 node_fields_inner,       "inner"          },
+  { radical_noad,         radical_noad_size,         node_fields_radical,     "radical"        },
+  { fraction_noad,        fraction_noad_size,        node_fields_fraction,    "fraction"       },
+  { under_noad,           noad_size,                 node_fields_under,       "under"          },
+  { over_noad,            noad_size,                 node_fields_over,        "over"           },
+  { accent_noad,          accent_noad_size,          node_fields_accent,      "accent"         },
+  { vcenter_noad,         noad_size,                 node_fields_vcenter,     "vcenter"        },
+  { left_noad,            noad_size,                 node_fields_left,        "left"           },
+  { right_noad,           noad_size,                 node_fields_right,       "right"          },
+  { margin_kern_node,     margin_kern_node_size,     node_fields_margin_kern, "margin_kern"    },
+  { glyph_node,           glyph_node_size,           node_fields_glyph,       "glyph"          }, /* 33 */
+  { align_record_node,    box_node_size,             NULL,                    "align_record"   },
+  { pseudo_file_node,     pseudo_file_node_size,     NULL,                    "pseudo_file"    },
+  { pseudo_line_node,     variable_node_size,        NULL,                    "pseudo_line"    },
+  { inserting_node,       page_ins_node_size,        node_fields_inserting,   "page_insert"    },
+  { split_up_node,        page_ins_node_size,        node_fields_splitup,     "split_insert"   },
+  { expr_node,            expr_node_size,            NULL,                    "expr_stack"     },
+  { nesting_node,         nesting_node_size,         NULL,                    "nested_list"    }, /* 40 */
+  { span_node,            span_node_size,            NULL,                    "span"           },
+  { attribute_node,       attribute_node_size,       node_fields_attribute,   "attribute"      },
+  { glue_spec_node,       glue_spec_size,            node_fields_glue_spec,   "glue_spec"      },
+  { attribute_list_node,  attribute_node_size,       node_fields_attribute_list,"attribute_list" },
+  { action_node,          pdf_action_size,           node_fields_action,      "action"         },
+  { temp_node,            temp_node_size,            NULL,                    "temp"           },
+  { align_stack_node,     align_stack_node_size,     NULL,                    "align_stack"    },
+  { movement_node,        movement_node_size,        NULL,                    "movement_stack" },
+  { if_node,              if_node_size,              NULL,                    "if_stack"       },
+  { unhyphenated_node,    active_node_size,          NULL,                    "unhyphenated"   }, /* 50 */
+  { hyphenated_node,      active_node_size,          NULL,                    "hyphenated"     },
+  { delta_node,           delta_node_size,           NULL,                    "delta"          },
+  { passive_node,         passive_node_size,         NULL,                    "passive"        },
+  { shape_node,           variable_node_size,        NULL,                    "shape"          },
+    { -1,                   -1,                      NULL,                     NULL            }};
+
+#define last_normal_node shape_node
+
+node_info whatsit_node_data[] = {
+  { open_node,             open_node_size,             node_fields_whatsit_open,            "open"            },
+  { write_node,            write_node_size,            node_fields_whatsit_write,           "write"           },
+  { close_node,            close_node_size,            node_fields_whatsit_close,           "close"           },
+  { special_node,          special_node_size,          node_fields_whatsit_special,         "special"         },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { local_par_node,        local_par_size,             node_fields_whatsit_local_par,       "local_par"       },
+  { dir_node,              dir_node_size,              node_fields_whatsit_dir,             "dir"             },
+  { pdf_literal_node,      write_node_size,            node_fields_whatsit_pdf_literal,     "pdf_literal"     },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { pdf_refobj_node,       pdf_refobj_node_size,       node_fields_whatsit_pdf_refobj,      "pdf_refobj"      },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { pdf_refxform_node,     pdf_refxform_node_size,     node_fields_whatsit_pdf_refxform,    "pdf_refxform"    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { pdf_refximage_node,    pdf_refximage_node_size,    node_fields_whatsit_pdf_refximage,   "pdf_refximage"   },
+  { pdf_annot_node,        pdf_annot_node_size,        node_fields_whatsit_pdf_annot,       "pdf_annot"       },
+  { pdf_start_link_node,   pdf_annot_node_size,        node_fields_whatsit_pdf_start_link,  "pdf_start_link"  },
+  { pdf_end_link_node,     pdf_end_link_node_size,     node_fields_whatsit_pdf_end_link,    "pdf_end_link"    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { pdf_dest_node,         pdf_dest_node_size,         node_fields_whatsit_pdf_dest,        "pdf_dest"        },
+  { pdf_thread_node,       pdf_thread_node_size,       node_fields_whatsit_pdf_thread,      "pdf_thread"      },
+  { pdf_start_thread_node, pdf_thread_node_size,       node_fields_whatsit_pdf_start_thread,"pdf_start_thread"},
+  { pdf_end_thread_node,   pdf_end_thread_node_size,   node_fields_whatsit_pdf_end_thread,  "pdf_end_thread"  },
+  { pdf_save_pos_node,     pdf_save_pos_node_size,     node_fields_whatsit_pdf_save_pos,    "pdf_save_pos"    },
+  { pdf_thread_data_node,  pdf_thread_node_size,       NULL,                                "pdf_thread_data" },
+  { pdf_link_data_node,    pdf_annot_node_size,        NULL,                                "pdf_link_data"   },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { late_lua_node,         write_node_size,            node_fields_whatsit_late_lua,        "late_lua"        },
+  { close_lua_node,        write_node_size,            node_fields_whatsit_close_lua,       "close_lua"       },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { fake_node,             fake_node_size,             NULL,                                fake_node_name    },
+  { pdf_colorstack_node,   pdf_colorstack_node_size,   node_fields_whatsit_pdf_colorstack,  "pdf_colorstack"  },
+  { pdf_setmatrix_node,    pdf_setmatrix_node_size,    node_fields_whatsit_pdf_setmatrix,   "pdf_setmatrix"   },
+  { pdf_save_node,         pdf_save_node_size,         node_fields_whatsit_pdf_save,        "pdf_save"        },
+  { pdf_restore_node,      pdf_restore_node_size,      node_fields_whatsit_pdf_restore,     "pdf_restore"     },
+  { cancel_boundary_node,  cancel_boundary_size,       node_fields_whatsit_cancel_boundary, "cancel_boundary" },
+  { user_defined_node,     user_defined_node_size,     node_fields_whatsit_user_defined,    "user_defined"    },
+  { -1,                    -1,                         NULL,                                NULL              }};
+
+#define last_whatsit_node user_defined_node
+
+#define  get_node_size(i,j) (i!=whatsit_node ? node_data[i].size : whatsit_node_data[j].size)
+#define  get_node_name(i,j) (i!=whatsit_node ? node_data[i].name : whatsit_node_data[j].name)
+
+halfword
+new_node(int i, int j) {
+  register int s;
+  register halfword n;
+  s = get_node_size(i,j);
+  n = get_node(s);
+  /* it should be possible to do this memset at free_node()  */
+  /* type() and subtype() will be set below, and vlink() is 
+     set to null by get_node(), so we can do we clearing one 
+     word less than |s| */
+  (void)memset((void *)(varmem+n+1),0, (sizeof(memory_word)*(s-1)));
+  switch (i) {
+  case glyph_node:
+    init_lang_data(n);
+    break;
+  case glue_node:
+  case kern_node:
+  case glue_spec_node:
+    break;
+  case hlist_node:
+  case vlist_node:
+    box_dir(n)=-1; 
+    break;
+  case whatsit_node:  
+    if (j==open_node) {
+      open_name(n) = get_nullstr();
+      open_area(n) = open_name(n);
+      open_ext(n) = open_name(n);
+    }
+    break;
+  case disc_node: 
+    pre_break(n)=pre_break_head(n); 
+    type(pre_break(n))= nesting_node; 
+    subtype(pre_break(n))=pre_break_head(0);
+    post_break(n)=post_break_head(n);
+    type(post_break(n))= nesting_node;  
+    subtype(post_break(n))=post_break_head(0);
+    no_break(n)=no_break_head(n);
+    type(no_break(n))= nesting_node;  
+    subtype(no_break(n))=no_break_head(0);
+    break;
+  case rule_node:
+    depth(n)=null_flag; 
+    height(n)=null_flag;
+    rule_dir(n)=-1;
+    /* fall through */
+  case unset_node:        
+    width(n) = null_flag;
+    break; 
+  case pseudo_line_node: 
+  case shape_node: 
+    /* this is a trick that makes pseudo_files slightly slower,
+     * but the overall allocation faster then an explicit test
+     * at the top of new_node().
+     */
+    free_node(n,variable_node_size);
+    n = slow_get_node(j);
+    (void)memset((void *)(varmem+n+1),0, (sizeof(memory_word)*(j-1)));
+    break;
+  default: 
+    break;
+  }  
+  if (nodetype_has_attributes(i)) {
+    build_attribute_list(n); 
+  }
+  type(n)=i;
+  subtype(n)=j;  
+  return n;
+}
+
+halfword
+raw_glyph_node(void) {
+  register halfword n;
+  n = get_node(glyph_node_size);
+  (void)memset((void *)(varmem+n+1),0, (sizeof(memory_word)*(glyph_node_size-1)));
+  type(n)=glyph_node;
+  subtype(n)=0;
+  return n;
+}
+
+halfword
+new_glyph_node(void) {
+  register halfword n;
+  n = get_node(glyph_node_size);
+  (void)memset((void *)(varmem+n+1),0, (sizeof(memory_word)*(glyph_node_size-1)));
+  type(n)=glyph_node;
+  subtype(n)=0;
+  build_attribute_list(n); 
+  return n;
+}
+
+
+/* makes a duplicate of the node list that starts at |p| and returns a
+   pointer to the new list */
+
+halfword 
+copy_node_list(halfword p) { 
+  halfword q; /* previous position in new list */
+  halfword h = null; /* head of the list */
+  copy_error_seen = 0;
+  while (p!=null) {
+    register halfword s = copy_node(p);
+    if (h==null) {
+      h = s;
+    } else {
+      couple_nodes(q,s);
+    }
+    q=s; 
+    p=vlink(p);
+  }
+  return h;
+}
+
+ /* make a dupe of a single node */
+halfword 
+copy_node(const halfword p) {
+  halfword r; /* current node being fabricated for new list */
+  register halfword s; /* a helper variable for copying into variable mem  */
+  register int i;
+  if (copy_error(p)) {
+	r = new_node(temp_node,0);
+	return r;
+  }
+  i = get_node_size(type(p), subtype(p));
+  r = get_node(i);
+  (void)memcpy((void *)(varmem+r),(void *)(varmem+p),(sizeof(memory_word)*i));
+
+  if (nodetype_has_attributes(type(p))) {
+    add_node_attr_ref(node_attr(p)); 
+	alink(r)=null; /* needs checking */
+  }
+  vlink(r)=null;
+  switch (type(p)) {
+  case glyph_node:  
+    s=copy_node_list(lig_ptr(p));
+    lig_ptr(r)=s;
+    break;
+  case glue_node:  
+    add_glue_ref(glue_ptr(p));
+    s=copy_node_list(leader_ptr(p));
+    leader_ptr(r)=s;
+    break;
+  case hlist_node:
+  case vlist_node:
+  case unset_node:  
+    s=copy_node_list(list_ptr(p));
+    list_ptr(r)=s;
+    break;
+  case ins_node:  
+    add_glue_ref(split_top_ptr(p)); 
+    s=copy_node_list(ins_ptr(p));
+    ins_ptr(r)=s;
+    break;
+  case margin_kern_node:  
+    s=copy_node(margin_char(p)); 
+    margin_char(r)=s;
+    break;
+  case disc_node:
+    pre_break(r)=pre_break_head(r); 
+    if (vlink_pre_break(p)!=null) {
+      s=copy_node_list(vlink_pre_break(p));
+      alink(s)=pre_break(r);
+      tlink_pre_break(r)=tail_of_list(s); 
+      vlink_pre_break(r)=s;
+    } else {
+      assert(tlink(pre_break(r))==null);
+    }
+    post_break(r)=post_break_head(r);
+    if (vlink_post_break(p)!=null) {
+      s=copy_node_list(vlink_post_break(p));
+      alink(s)=post_break(r);
+      tlink_post_break(r)=tail_of_list(s); 
+      vlink_post_break(r)=s;
+    } else {
+      assert(tlink_post_break(r)==null);
+    }
+    no_break(r)=no_break_head(r);
+    if (vlink(no_break(p))!=null) {
+      s=copy_node_list(vlink_no_break(p));
+      alink(s)=no_break(r);
+      tlink_no_break(r)=tail_of_list(s); 
+      vlink_no_break(r)=s;
+    } else {
+      assert(tlink_no_break(r)==null);
+    }
+    break;
+  case mark_node: 
+    add_token_ref(mark_ptr(p));
+    break;
+  case adjust_node:  
+    s=copy_node_list(adjust_ptr(p)); 
+    adjust_ptr(r)=s;
+    break;
+  case glue_spec_node: 
+    glue_ref_count(r)=null;
+    break;
+  case whatsit_node:
+    switch (subtype(p)) {
+    case dir_node:  
+    case local_par_node:  
+      break;
+    case write_node:
+    case special_node:  
+      add_token_ref(write_tokens(p)); 
+      break;
+    case pdf_literal_node:  
+      add_token_ref(pdf_literal_data(p)); 
+      break;
+    case pdf_colorstack_node: 
+      if (pdf_colorstack_cmd(p) <= colorstack_data)
+        add_token_ref(pdf_colorstack_data(p));
+      break;
+    case pdf_setmatrix_node:
+      add_token_ref(pdf_setmatrix_data(p));
+      break;
+    case late_lua_node:  
+      add_token_ref(late_lua_data(p));
+      break;
+    case pdf_annot_node:  
+      add_token_ref(pdf_annot_data(p));
+      break;
+    case pdf_start_link_node:  
+      if (pdf_link_attr(r) != null)
+        add_token_ref(pdf_link_attr(r));
+      add_action_ref(pdf_link_action(r));
+      break;
+    case pdf_dest_node:  
+      if (pdf_dest_named_id(p) > 0)
+        add_token_ref(pdf_dest_id(p));
+      break;
+    case pdf_thread_node:
+    case pdf_start_thread_node:
+      if (pdf_thread_named_id(p) > 0)
+        add_token_ref(pdf_thread_id(p));
+      if (pdf_thread_attr(p) != null)
+        add_token_ref(pdf_thread_attr(p));
+      break;
+    case user_defined_node:  
+      switch (user_node_type(p)) {
+      case 'a': add_node_attr_ref(user_node_value(p));
+        break;
+      case 't': add_token_ref(user_node_value(p));
+        break;
+      case 'n':  
+        s=copy_node_list(user_node_value(p)); 
+        user_node_value(r)=s; 
+        break;
+      }
+      break;
+    default: 
+      break;
+    }
+    break;
+  }
+  return r;
+}
+
+int valid_node (halfword p) {
+  if (p>prealloc) {
+    if (p<var_mem_max) {
+      if (varmem_sizes[p]>0)
+	return 1;
+    }
+  } else {
+    return 1;
+  }
+  return 0;
+}
+
+static void 
+do_free_error (halfword p) {
+  char errstr[255]= {0};
+  char *errhlp[] = {"When I tried to free the node mentioned in the error message, it turned",
+		    "out it was not (or no longer) actually in use.",
+		    "Errors such as these are often caused by Lua node list alteration,",
+		    "but could also point to a bug in the executable. It should be safe to continue.",
+		    NULL};
+
+  check_node_mem();
+  if (free_error_seen)
+    return;
+
+  halfword r = null;    
+  free_error_seen = 1;
+  if (type(p)==glyph_node) {
+    snprintf(errstr,255,"Attempt to double-free glyph (%c) node %d, ignored", (int)character (p), (int)p);
+  } else {
+    snprintf(errstr,255,"Attempt to double-free %s node %d, ignored", get_node_name(type(p),subtype(p)), (int)p);
+  }
+  tex_error(errstr,errhlp);
+  for (r=prealloc+1;r<var_mem_max;r++) {
+    if (vlink(r)==p) {
+      halfword s = r;
+      while (s>prealloc && varmem_sizes[s]==0)
+        s--;
+      if (s!=null 
+          && s!=prealloc 
+          && s!=var_mem_max 
+          && (r-s)<get_node_size(type(s),subtype(s) )
+          && alink(s)!=p ) {
+
+        if (type(s)==disc_node) {
+          fprintf(stdout,"  pointed to from %s node %d (vlink %d, alink %d): ", 
+      	    get_node_name(type(s),subtype(s)), (int)s, (int)vlink(s), (int)alink(s));
+          fprintf(stdout,"pre_break(%d,%d,%d), ",  (int)vlink_pre_break(s),  (int)tlink(pre_break(s)), (int)alink(pre_break(s)));
+          fprintf(stdout,"post_break(%d,%d,%d), ", (int)vlink_post_break(s), (int)tlink(post_break(s)), (int)alink(post_break(s)));
+          fprintf(stdout,"no_break(%d,%d,%d)",     (int)vlink_no_break(s),   (int)tlink(no_break(s)), (int)alink(no_break(s)));
+          fprintf(stdout,"\n");
+        } else { 
+          if (vlink(s)==p 
+      	|| (type(s)==glyph_node && lig_ptr(s)==p) 
+      	|| (type(s)==vlist_node && list_ptr(s)==p) 
+      	|| (type(s)==hlist_node && list_ptr(s)==p) 
+      	|| (type(s)==unset_node && list_ptr(s)==p) 
+      	|| (type(s)==ins_node && ins_ptr(s)==p) 
+      	) {
+            fprintf(stdout,"  pointed to from %s node %d (vlink %d, alink %d): ", 
+      	      get_node_name(type(s),subtype(s)), (int)s, (int)vlink(s), (int)alink(s));
+            if (type(s)==glyph_node) {
+      	fprintf(stdout,"lig_ptr(%d)", (int)lig_ptr(s));
+            } else if (type(s)==vlist_node || type(s)==hlist_node) {
+      	fprintf(stdout,"list_ptr(%d)", (int)list_ptr(s));
+            }
+            fprintf(stdout,"\n");
+          } else {
+            if ((type(s)!=penalty_node)
+      	  && (type(s)!=math_node)
+      	  && (type(s)!=kern_node)
+      	  ) {
+	      fprintf(stdout,"  pointed to from %s node %d\n",get_node_name(type(s),subtype(s)), (int)s); 
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
+int 
+free_error (halfword p) {
+  assert(p>prealloc);
+  assert(p<var_mem_max);
+  if (varmem_sizes[p]==0) {
+    do_free_error(p);
+    return 1; /* double free */
+  }
+  return 0;
+}
+
+
+static void 
+do_copy_error (halfword p) {
+  char errstr[255]= {0};
+  char *errhlp[] = {"When I tried to copy the node mentioned in the error message, it turned",
+		    "out it was not (or no longer) actually in use.",
+		    "Errors such as these are often caused by Lua node list alteration,",
+		    "but could also point to a bug in the executable. It should be safe to continue.",
+		    NULL};
+
+  if (copy_error_seen)
+    return;
+
+  copy_error_seen = 1;
+  if (type(p)==glyph_node) {
+    snprintf(errstr,255,"Attempt to copy free glyph (%c) node %d, ignored", (int)character (p), (int)p);
+  } else {
+    snprintf(errstr,255,"Attempt to copy free %s node %d, ignored", get_node_name(type(p),subtype(p)), (int)p);
+  }
+  tex_error(errstr,errhlp);
+}
+
+
+int 
+copy_error (halfword p) {
+  assert(p>=0);
+  assert(p<var_mem_max);
+  if (p>prealloc && varmem_sizes[p]==0) {
+    do_copy_error(p);
+    return 1; /* copy free node */
+  }
+  return 0;
+}
+
+
+
+void 
+flush_node (halfword p) {
+  
+  if (p==null) /* legal, but no-op */
+    return;
+
+  if (free_error(p))
+    return;
+  
+  switch(type(p)) {
+  case glyph_node:
+    flush_node_list(lig_ptr(p));
+    break;
+  case glue_node: 
+    delete_glue_ref(glue_ptr(p));
+    flush_node_list(leader_ptr(p));
+    break;
+
+  case attribute_node:
+  case attribute_list_node:
+  case temp_node:
+  case glue_spec_node:
+  case rule_node: 
+  case kern_node:
+  case math_node:
+  case penalty_node: 
+    break;
+
+  case hlist_node:
+  case vlist_node:
+  case unset_node:
+    flush_node_list(list_ptr(p));
+    break;
+  case whatsit_node: 
+    switch (subtype(p)) {
+
+    case dir_node: 
+      break;
+    case open_node: 
+    case write_node:
+    case close_node: 
+    case pdf_save_node: 
+    case pdf_restore_node: 
+    case cancel_boundary_node: 
+    case close_lua_node: 
+    case pdf_refobj_node:
+    case pdf_refxform_node:
+    case pdf_refximage_node:
+    case pdf_end_link_node:
+    case pdf_end_thread_node:
+    case pdf_save_pos_node:
+    case local_par_node: 
+      break;
+
+    case special_node: 
+      delete_token_ref(write_tokens(p));
+      break;
+    case pdf_literal_node:
+      delete_token_ref(pdf_literal_data(p));
+      break;
+    case pdf_colorstack_node: 
+      if (pdf_colorstack_cmd(p) <= colorstack_data)
+        delete_token_ref(pdf_colorstack_data(p));
+      break;
+    case pdf_setmatrix_node: 
+      delete_token_ref(pdf_setmatrix_data(p));
+      break;
+    case late_lua_node:
+      delete_token_ref(late_lua_data(p));
+      break;
+    case pdf_annot_node:
+      delete_token_ref(pdf_annot_data(p));
+      break;
+
+    case pdf_link_data_node:
+      break;
+
+    case pdf_start_link_node: 
+      if (pdf_link_attr(p) != null)
+        delete_token_ref(pdf_link_attr(p));
+      delete_action_ref(pdf_link_action(p));
+      break;
+    case pdf_dest_node: 
+      if (pdf_dest_named_id(p) > 0)
+        delete_token_ref(pdf_dest_id(p));
+      break;
+
+    case pdf_thread_data_node:
+      break;
+
+    case pdf_thread_node:
+    case pdf_start_thread_node: 
+      if (pdf_thread_named_id(p) > 0 ) delete_token_ref(pdf_thread_id(p));
+      if (pdf_thread_attr(p) != null)  delete_token_ref(pdf_thread_attr(p));
+      break;
+    case user_defined_node: 
+      switch( user_node_type(p)) {
+      case 'a': delete_attribute_ref(user_node_value(p)); break;
+      case 't': delete_token_ref(user_node_value(p));  break;
+      case 'n': flush_node_list(user_node_value(p));  break;
+      default:  tconfusion("extuser"); break;
+      }
+      break;
+
+    default:
+      tconfusion("ext3");
+      return;
+
+    }
+    break;
+  case ins_node:
+    flush_node_list(ins_ptr(p));
+    delete_glue_ref(split_top_ptr(p));
+    break;
+  case margin_kern_node:
+    flush_node(margin_char(p));
+    break;
+  case mark_node:
+    delete_token_ref(mark_ptr(p)); 
+    break;
+  case disc_node:
+    flush_node_list(vlink(pre_break(p)));
+    flush_node_list(vlink(post_break(p)));
+    flush_node_list(vlink(no_break(p)));
+    break;
+  case adjust_node:
+    flush_node_list(adjust_ptr(p)); 
+    break;
+  case style_node:  
+    break;
+  case choice_node: 
+    flush_node_list(display_mlist(p));
+    flush_node_list(text_mlist(p));
+    flush_node_list(script_mlist(p));
+    flush_node_list(script_script_mlist(p));
+    break;
+  case ord_noad:
+  case op_noad:
+  case bin_noad:
+  case rel_noad:
+  case open_noad:
+  case close_noad:
+  case punct_noad:
+  case inner_noad:
+  case radical_noad:
+  case over_noad:
+  case under_noad:
+  case vcenter_noad:
+  case accent_noad:
+     
+    /*
+     * if (math_type(nucleus(p))>=sub_box)
+     *  flush_node_list(vinfo(nucleus(p)));
+     * if (math_type(supscr(p))>=sub_box)
+     *  flush_node_list(vinfo(supscr(p)));
+     * if (math_type(subscr(p))>=sub_box)
+     *  flush_node_list(vinfo(subscr(p)));
+     */
+    
+    break;
+  case left_noad:
+  case right_noad: 
+    break;
+  case fraction_noad:  
+    flush_node_list(vinfo(numerator(p)));
+    flush_node_list(vinfo(denominator(p)));
+    break;
+  case pseudo_file_node:
+    flush_node_list(pseudo_lines(p));
+    break;
+  case pseudo_line_node:
+  case shape_node:
+    free_node(p,subtype(p));
+    return;
+    break;
+  case align_stack_node:
+  case span_node:
+  case movement_node: 
+  case if_node:
+  case nesting_node:
+  case unhyphenated_node:
+  case hyphenated_node:
+  case delta_node:
+  case passive_node:
+  case action_node: 
+  case inserting_node: 
+  case split_up_node: 
+  case expr_node:
+    break;
+  default:
+    fprintf(stdout,"flush_node: type is %d\n", type(p)); 
+    return;
+
+  }
+  if (nodetype_has_attributes(type(p)))
+    delete_attribute_ref(node_attr(p));
+  free_node(p,get_node_size(type(p),subtype(p)));
+  return;
+}
+
+void 
+flush_node_list(halfword pp) { /* erase list of nodes starting at |p| */
+  register halfword p=pp; 
+  free_error_seen = 0;
+  if (p==null) /* legal, but no-op */
+    return;
+  if (free_error(p))
+    return;
+
+  while (p!=null) {
+    register halfword q = vlink(p);
+    flush_node(p);
+    p=q;
+  }
+}
+
+static int test_count = 1;
+
+#define dorangetest(a,b,c)  do {					\
+    if (!(b>=0 && b<c)) {                                               \
+      fprintf(stdout,"For node p:=%d, 0<=%d<%d (l.%d,r.%d)\n",          \
+              (int)a, (int)b, (int)c, __LINE__,test_count);             \
+      tconfusion("dorangetest");					\
+    } } while (0)
+
+#define dotest(a,b,c) do {						\
+    if (b!=c) {                                                         \
+      fprintf(stdout,"For node p:=%d, %d==%d (l.%d,r.%d)\n",            \
+              (int)a, (int)b, (int)c, __LINE__,test_count);             \
+      tconfusion("dotest");						\
+    } } while (0)
+
+#define check_action_ref(a)     { dorangetest(p,a,var_mem_max); }
+#define check_glue_ref(a)       { dorangetest(p,a,var_mem_max); }
+#define check_attribute_ref(a)  { dorangetest(p,a,var_mem_max); }
+#define check_token_ref(a)      assert(1)
+
+void 
+check_node (halfword p) {
+
+  switch(type(p)) {
+  case glyph_node:
+    dorangetest(p,lig_ptr(p),var_mem_max);
+    break;
+  case glue_node: 
+    check_glue_ref(glue_ptr(p));
+    dorangetest(p,leader_ptr(p),var_mem_max);
+    break;
+  case hlist_node:
+  case vlist_node:
+  case unset_node:
+  case align_record_node:
+    dorangetest(p,list_ptr(p),var_mem_max);
+    break;
+  case ins_node:
+    dorangetest(p,ins_ptr(p),var_mem_max);
+    check_glue_ref(split_top_ptr(p));
+    break;
+  case whatsit_node: 
+    switch (subtype(p)) {
+    case special_node: 
+      check_token_ref(write_tokens(p));
+      break;
+    case pdf_literal_node:
+      check_token_ref(pdf_literal_data(p));
+      break;
+    case pdf_colorstack_node: 
+      if (pdf_colorstack_cmd(p) <= colorstack_data)
+        check_token_ref(pdf_colorstack_data(p));
+      break;
+    case pdf_setmatrix_node: 
+      check_token_ref(pdf_setmatrix_data(p));
+      break;
+    case late_lua_node:
+      check_token_ref(late_lua_data(p));
+      break;
+    case pdf_annot_node:
+      check_token_ref(pdf_annot_data(p));
+      break;
+    case pdf_start_link_node: 
+      if (pdf_link_attr(p) != null)
+        check_token_ref(pdf_link_attr(p));
+      check_action_ref(pdf_link_action(p));
+      break;
+    case pdf_dest_node: 
+      if (pdf_dest_named_id(p) > 0)
+        check_token_ref(pdf_dest_id(p));
+      break;
+    case pdf_thread_node:
+    case pdf_start_thread_node: 
+      if (pdf_thread_named_id(p) > 0 ) check_token_ref(pdf_thread_id(p));
+      if (pdf_thread_attr(p) != null)  check_token_ref(pdf_thread_attr(p));
+      break;
+    case user_defined_node: 
+      switch( user_node_type(p)) {
+      case 'a': check_attribute_ref(user_node_value(p)); break;
+      case 't': check_token_ref(user_node_value(p));  break;
+      case 'n': dorangetest(p,user_node_value(p),var_mem_max); break;
+      default:  tconfusion("extuser"); break;
+      }
+      break;
+    case dir_node: 
+    case open_node: 
+    case write_node:
+    case close_node: 
+    case pdf_save_node: 
+    case pdf_restore_node: 
+    case cancel_boundary_node: 
+    case close_lua_node: 
+    case pdf_refobj_node:
+    case pdf_refxform_node:
+    case pdf_refximage_node:
+    case pdf_end_link_node:
+    case pdf_end_thread_node:
+    case pdf_save_pos_node:
+    case local_par_node: 
+      break;
+    default:
+      tconfusion("ext3");
+    }
+    break;
+  case margin_kern_node:
+    check_node(margin_char(p));
+    break;
+  case disc_node:
+    dorangetest(p,vlink(pre_break(p)),var_mem_max);
+    dorangetest(p,vlink(post_break(p)),var_mem_max);
+    dorangetest(p,vlink(no_break(p)),var_mem_max);
+    break;
+  case adjust_node:
+    dorangetest(p,adjust_ptr(p),var_mem_max);
+    break;
+  case pseudo_file_node:
+    dorangetest(p,pseudo_lines(p),var_mem_max);
+    break;
+  case pseudo_line_node:
+  case shape_node:
+    break;
+  case choice_node: 
+    dorangetest(p,display_mlist(p),var_mem_max);
+    dorangetest(p,text_mlist(p),var_mem_max);
+    dorangetest(p,script_mlist(p),var_mem_max);
+    dorangetest(p,script_script_mlist(p),var_mem_max);
+    break;
+  case fraction_noad:  
+    dorangetest(p,vinfo(numerator(p)),var_mem_max);
+    dorangetest(p,vinfo(denominator(p)),var_mem_max);
+    break;
+  case rule_node: 
+  case kern_node:
+  case math_node:
+  case penalty_node: 
+  case mark_node:
+  case style_node:  
+  case ord_noad:
+  case op_noad:
+  case bin_noad:
+  case rel_noad:
+  case open_noad:
+  case close_noad:
+  case punct_noad:
+  case inner_noad:
+  case radical_noad:
+  case over_noad:
+  case under_noad:
+  case vcenter_noad:
+  case accent_noad:
+  case left_noad:
+  case right_noad: 
+  case attribute_list_node:  
+  case attribute_node:  
+  case glue_spec_node:  
+  case temp_node:
+  case align_stack_node:
+  case movement_node: 
+  case if_node:
+  case nesting_node:
+  case span_node:
+  case unhyphenated_node:
+  case hyphenated_node:
+  case delta_node:
+  case passive_node:
+  case expr_node:
+    break;
+  default:
+    fprintf(stdout,"check_node: type is %d\n", type(p)); 
+  }
+}
+
+void 
+check_static_node_mem (void) {
+  dotest(zero_glue,width(zero_glue),0);
+  dotest(zero_glue,type(zero_glue),glue_spec_node);
+  dotest(zero_glue,vlink(zero_glue),null);
+  dotest(zero_glue,stretch(zero_glue),0);
+  dotest(zero_glue,stretch_order(zero_glue),normal);
+  dotest(zero_glue,shrink(zero_glue),0);
+  dotest(zero_glue,shrink_order(zero_glue),normal);
+
+  dotest(sfi_glue,width(sfi_glue),0);
+  dotest(sfi_glue,type(sfi_glue),glue_spec_node);
+  dotest(sfi_glue,vlink(sfi_glue),null);
+  dotest(sfi_glue,stretch(sfi_glue),0);
+  dotest(sfi_glue,stretch_order(sfi_glue),sfi);
+  dotest(sfi_glue,shrink(sfi_glue),0);
+  dotest(sfi_glue,shrink_order(sfi_glue),normal);
+
+  dotest(fil_glue,width(fil_glue),0);
+  dotest(fil_glue,type(fil_glue),glue_spec_node);
+  dotest(fil_glue,vlink(fil_glue),null);
+  dotest(fil_glue,stretch(fil_glue),unity);
+  dotest(fil_glue,stretch_order(fil_glue),fil);
+  dotest(fil_glue,shrink(fil_glue),0);
+  dotest(fil_glue,shrink_order(fil_glue),normal);
+
+  dotest(fill_glue,width(fill_glue),0);
+  dotest(fill_glue,type(fill_glue),glue_spec_node);
+  dotest(fill_glue,vlink(fill_glue),null);
+  dotest(fill_glue,stretch(fill_glue),unity);
+  dotest(fill_glue,stretch_order(fill_glue),fill);
+  dotest(fill_glue,shrink(fill_glue),0);
+  dotest(fill_glue,shrink_order(fill_glue),normal);
+
+  dotest(ss_glue,width(ss_glue),0);
+  dotest(ss_glue,type(ss_glue),glue_spec_node);
+  dotest(ss_glue,vlink(ss_glue),null);
+  dotest(ss_glue,stretch(ss_glue),unity);
+  dotest(ss_glue,stretch_order(ss_glue),fil);
+  dotest(ss_glue,shrink(ss_glue),unity);
+  dotest(ss_glue,shrink_order(ss_glue),fil);
+
+  dotest(fil_neg_glue,width(fil_neg_glue),0);
+  dotest(fil_neg_glue,type(fil_neg_glue),glue_spec_node);
+  dotest(fil_neg_glue,vlink(fil_neg_glue),null);
+  dotest(fil_neg_glue,stretch(fil_neg_glue),-unity);
+  dotest(fil_neg_glue,stretch_order(fil_neg_glue),fil);
+  dotest(fil_neg_glue,shrink(fil_neg_glue),0);
+  dotest(fil_neg_glue,shrink_order(fil_neg_glue),normal);
+}
+
+void 
+check_node_mem(void ) { 
+  int i;
+  check_static_node_mem();
+  
+  for (i=(prealloc+1);i<var_mem_max;i++) {
+    if (varmem_sizes[i]>0) {
+      check_node(i);
+    }
+  }
+  test_count++;
+}
+
+void 
+fix_node_list (halfword head) {
+  halfword p,q;
+  if (head==null) 
+    return;
+  p = head;
+  q = vlink(p);
+  while (q!=null) {
+    alink(q) = p;
+    p = q;
+    q = vlink(p);
+  }
+}
+
+halfword 
+get_node (integer s) {
+  register halfword r;
+
+  /*check_static_node_mem();*/
+  assert(s<MAX_CHAIN_SIZE);
+
+  r = free_chain[s];
+  if (r!=null) {
+    free_chain[s] = vlink(r);
+#ifndef NDEBUG
+    varmem_sizes[r] = s;
+#endif
+    vlink(r)=null;
+    var_used += s; /* maintain usage statistics */
+    return r;
+  } 
+  /* this is the end of the 'inner loop' */
+  return slow_get_node(s);
+}
+
+void print_free_chain (int c) {
+  halfword p = free_chain[c];
+  fprintf(stdout, "\nfree chain[%d] =\n  ",c);
+  while (p!=null) {
+    fprintf(stdout, "%d,",p);
+    p = vlink(p);
+  }
+  fprintf(stdout, "null;\n");
+}
+
+void
+free_node (halfword p, integer s) {
+
+  if (p<=prealloc) { 
+    fprintf(stdout,"node %d (type %d) should not be freed!\n",(int)p, type(p));
+    return;
+  }
+
+#ifndef NDEBUG
+  varmem_sizes[p] = 0;
+#endif
+  if (s<MAX_CHAIN_SIZE) {
+    vlink(p) = free_chain[s];
+    free_chain[s] = p;
+  } else { 
+    /* todo ? it is perhaps possible to merge this node with an existing rover */
+    node_size(p)=s;
+    vlink(p) = rover;
+    while (vlink(rover)!=vlink(p)){ 
+      rover=vlink(rover);
+    }
+    vlink(rover) = p;
+  }
+  var_used -= s; /* maintain statistics */
+}
+
+void
+free_node_chain (halfword q, integer s) {
+  register halfword p = q;
+  while (vlink(p)!=null) {
+#ifndef NDEBUG
+    varmem_sizes[p] = 0;
+#endif
+    var_used -= s;
+    p = vlink(p);
+  }
+  var_used -= s;
+#ifndef NDEBUG
+  varmem_sizes[p] = 0;
+#endif
+  vlink(p) = free_chain[s];
+  free_chain[s] = q;
+}
+
+
+void
+init_node_mem (halfword prealloced, halfword t) {
+  prealloc=prealloced;
+  assert(whatsit_node_data[user_defined_node].id==user_defined_node);
+  assert(node_data[passive_node].id==passive_node);
+
+  varmem = (memory_word *)realloc((void *)varmem,sizeof(memory_word)*t);
+  if (varmem==NULL) {
+    overflow_string("node memory size",var_mem_max);
+  }
+  memset ((void *)(varmem),0,t*sizeof(memory_word));
+
+#ifndef NDEBUG
+  varmem_sizes = (char *)realloc(varmem_sizes,sizeof(char)*t);
+  if (varmem_sizes==NULL) {
+    overflow_string("node memory size",var_mem_max);
+  }
+  memset ((void *)varmem_sizes,0,sizeof(char)*t);
+#endif
+  var_mem_max=t; 
+  rover = prealloced+1; vlink(rover) = rover;
+  node_size(rover)=(t-rover);
+  var_used = 0;
+}
+
+void
+dump_node_mem (void) {
+  dump_int(var_mem_max);
+  dump_int(rover);
+  dump_things(varmem[0],var_mem_max);
+#ifndef NDEBUG
+  dump_things(varmem_sizes[0],var_mem_max);
+#endif
+  dump_things(free_chain[0],MAX_CHAIN_SIZE);
+  dump_int(var_used);
+  dump_int(prealloc);
+}
+
+/* it makes sense to enlarge the varmem array immediately */
+
+void
+undump_node_mem (void) {
+  int x;
+  undump_int(x);
+  undump_int(rover);
+  var_mem_max = (x<100000 ? 100000 : x);
+  varmem = xmallocarray (memory_word, var_mem_max);
+  /*memset ((void *)varmem,0,x*sizeof(memory_word));*/
+  undump_things(varmem[0],x);
+#ifndef NDEBUG
+  varmem_sizes = xmallocarray (char, var_mem_max);
+  memset ((void *)varmem_sizes,0,var_mem_max*sizeof(char));
+  undump_things(varmem_sizes[0],x);
+#endif
+  undump_things(free_chain[0],MAX_CHAIN_SIZE);
+  undump_int(var_used); 
+  undump_int(prealloc);
+  if (var_mem_max>x) {
+    /* todo ? it is perhaps possible to merge the new node with an existing rover */
+    vlink (x) = rover;
+    node_size(x) = (var_mem_max-x);
+    while(vlink(rover)!=vlink(x)) {rover=vlink(rover);}
+    vlink (rover) = x;
+  }
+}
+
+#if 0
+void test_rovers (char *s) {
+  int q = rover;
+  int r = q;
+  fprintf(stdout,"%s: {rover=%d,size=%d,link=%d}",s,r,node_size(r),vlink(r));
+  while (vlink(r)!=q) {
+    r = vlink(r);
+    fprintf(stdout,",{rover=%d,size=%d,link=%d}",r,node_size(r),vlink(r));
+  }
+  fprintf(stdout,"\n");
+}
+#else
+#define test_rovers(a)
+#endif
+
+halfword 
+slow_get_node (integer s) {
+  register int t;
+
+ RETRY:
+  t = node_size(rover);
+  assert(vlink(rover)<var_mem_max);
+  assert(vlink(rover)!=0);
+  test_rovers("entry");
+  if (t>s) {
+    register halfword r;
+    /* allocating from the bottom helps decrease page faults */
+    r = rover;
+    rover += s;
+    vlink(rover)=vlink(r);
+    node_size(rover) = node_size(r) - s;
+    if (vlink(rover)!=r) { /* list is longer than one */
+      halfword q = r;
+      while (vlink(q)!=r) { q=vlink(q);}
+      vlink(q) += s;
+    } else {
+      vlink(rover) += s;
+    }
+    test_rovers("taken");
+    assert(vlink(rover)<var_mem_max);
+#ifndef NDEBUG
+    varmem_sizes[r]=(s>127 ? 127 : s);
+#endif
+    vlink(r)=null;
+    var_used += s; /* maintain usage statistics */
+    return r; /* this is the only exit */
+  } else {
+    int x;
+    /* attempt to keep the free list small */
+    if (vlink(rover)!=rover) {
+      if (t<MAX_CHAIN_SIZE) {
+	halfword l = vlink(rover);
+	vlink(rover) = free_chain[t];
+	free_chain[t] = rover;
+	rover = l;
+	while (vlink(l)!=free_chain[t]) { l=vlink(l); }
+	vlink(l) = rover;
+	test_rovers("outtake");
+	goto RETRY;
+      } else {
+	halfword l = rover;
+	while (vlink(rover)!=l) { 
+	  if (node_size(rover)>s) {
+	    goto RETRY;
+	  }
+	  rover=vlink(rover);
+	}
+      }
+    }
+    /* if we are still here, it was apparently impossible to get a match */
+    x = (var_mem_max>>2)+s;
+    varmem = (memory_word *)realloc((void *)varmem,sizeof(memory_word)*(var_mem_max+x));
+    if (varmem==NULL) {
+      overflow_string("node memory size",var_mem_max);
+    }
+    memset ((void *)(varmem+var_mem_max),0,x*sizeof(memory_word));
+    
+#ifndef NDEBUG
+    varmem_sizes = (char *)realloc(varmem_sizes,sizeof(char)*(var_mem_max+x));
+    if (varmem_sizes==NULL) {
+      overflow_string("node memory size",var_mem_max);
+    }
+    memset ((void *)(varmem_sizes+var_mem_max),0,x*sizeof(char));
+#endif
+
+    /* todo ? it is perhaps possible to merge the new memory with an existing rover */
+    vlink(var_mem_max) = rover;
+    node_size(var_mem_max) = x;
+    while(vlink(rover)!=vlink(var_mem_max)) {rover=vlink(rover);}
+    vlink (rover) = var_mem_max;
+    rover = var_mem_max;
+    test_rovers("realloc");
+    var_mem_max += x;
+    goto RETRY;
+  }
+}
+
+char *
+sprint_node_mem_usage (void) {
+  int i,b;
+
+  char *s, *ss;
+  char msg[256];
+  int node_counts[last_normal_node+last_whatsit_node+2] = {0};
+
+  for (i=(var_mem_max-1);i>prealloc;i--) {
+    if (varmem_sizes[i]>0) {
+      if (type(i)>last_normal_node+last_whatsit_node) {
+        node_counts[last_normal_node+last_whatsit_node+1] ++;
+      } else if (type(i)==whatsit_node){
+        node_counts[(subtype(i)+last_normal_node+1)] ++;
+      } else {
+        node_counts[type(i)] ++;
+      }
+    }
+  }
+  s = strdup("");
+  b=0;
+  for (i=0;i<last_normal_node+last_whatsit_node+2;i++) {
+    if (node_counts[i]>0) {
+	  int j = (i>(last_normal_node+1) ? (i-last_normal_node-1) : 0);
+      snprintf(msg,255,"%s%d %s",(b ? ", " : ""),
+			   (int)node_counts[i],
+			   get_node_name((i>last_normal_node ? whatsit_node : i),j));
+      ss = concat(s,msg);
+      free (s);
+      s = ss;
+      b=1;
+    }
+  }
+  return s;
+}
+
+halfword
+list_node_mem_usage (void) {
+  halfword i, j;
+  halfword p = null,q = null;
+  char *saved_varmem_sizes = xmallocarray (char, var_mem_max);
+  memcpy (saved_varmem_sizes,varmem_sizes,var_mem_max);
+  for (i=prealloc+1;i<(var_mem_max-1);i++) {
+    if (saved_varmem_sizes[i]>0) {
+      j = copy_node(i);
+      if (p==null) {
+	q = j;
+      } else {
+	vlink(p)=j;
+      }
+      p = j;	  
+    }
+  }
+  free(saved_varmem_sizes);
+  return q;
+}
+
+void
+print_node_mem_stats (int num, int online) {
+  int i,b;
+  halfword j;
+  char msg[256];
+  char *s;
+  integer free_chain_counts[MAX_CHAIN_SIZE] = {0};
+
+  snprintf(msg,255,"node memory in use: %d words out of %d", (int)(var_used+prealloc), (int)var_mem_max);
+  tprint_nl(msg);
+  tprint_nl("rapidly available: ");
+  b=0;
+  for (i=1;i<MAX_CHAIN_SIZE;i++) {
+    for(j = free_chain[i];j!=null;j = vlink(j)) 
+      free_chain_counts[i] ++;
+    if (free_chain_counts[i]>0) {
+      snprintf(msg,255,"%s%d:%d",(b ? ", " : ""),i, (int)free_chain_counts[i]);
+      tprint(msg);
+      b=1;
+    }
+  }
+  tprint(" nodes");
+  s = sprint_node_mem_usage();
+  tprint_nl("current usage: ");
+  tprint(s);  free(s);
+  tprint(" nodes");
+  print_nlp(); /* newline, if needed */
+}
+
+/* this belongs in the web but i couldn't find the correct syntactic place */
+
+halfword 
+new_span_node(halfword n, int s, scaled w) {
+  halfword p=new_node(span_node,0);
+  span_link(p)=n; 
+  span_span(p)=s;
+  width(p)=w;
+  return p;
+}
+
+halfword 
+string_to_pseudo(integer l,integer pool_ptr, integer nl) {
+  halfword i, r, q = null;
+  four_quarters w;
+  int sz;
+  halfword h = new_node(pseudo_file_node,0);
+  while (l<pool_ptr) {
+    int m = l;
+    while ((l<pool_ptr)&&(str_pool[l]!=nl)) l++;
+    sz = (l-m+7) / 4;
+    if (sz==1) 
+      sz=2;
+    r = new_node(pseudo_line_node,sz);
+    i = r;
+    while (--sz>1) {
+      w.b0=str_pool[m++];   
+      w.b1=str_pool[m++];
+      w.b2=str_pool[m++]; 
+      w.b3=str_pool[m++];
+      varmem[++i].qqqq=w; 
+    }
+    w.b0 = (l>m ? str_pool[m++] : ' ');
+    w.b1 = (l>m ? str_pool[m++] : ' ');
+    w.b2 = (l>m ? str_pool[m++] : ' ');
+    w.b3 = (l>m ? str_pool[m]   : ' ');
+    varmem[++i].qqqq=w;
+    if (pseudo_lines(h)==null) {
+      pseudo_lines(h) = r;
+      q = r;
+    } else {
+      couple_nodes(q,r);
+    }
+    q = vlink(q);
+    if (str_pool[l]==nl) l++;
+  }
+  return h;
+}
+
+/* attribute stuff */
+
+static halfword 
+new_attribute_node (unsigned int i, int v) {
+  register halfword r = get_node(attribute_node_size);
+  type(r) = attribute_node;
+  attribute_id(r)= i;
+  attribute_value(r)= v;
+  return r;
+}
+
+halfword 
+copy_attribute_list(halfword n) {
+  halfword q = get_node(attribute_node_size); 
+  register halfword p = q;
+  type(p) = attribute_list_node;
+  attr_list_ref(p)=0;
+  n = vlink(n);
+  while (n!=null) {
+    register halfword r = get_node(attribute_node_size);
+    /* the link will be fixed automatically in the next loop */
+    (void)memcpy((void *)(varmem+r),(void *)(varmem+n),(sizeof(memory_word)*attribute_node_size));
+    vlink(p) = r;
+    p = r;
+    n = vlink(n);
+  }
+  return q;
+}
+
+void
+update_attribute_cache(void) {
+  halfword p;
+  register int i;
+  attr_list_cache=get_node(attribute_node_size); 
+  type(attr_list_cache) = attribute_list_node;
+  attr_list_ref(attr_list_cache)=0;
+  p=attr_list_cache; 
+  for (i=0;i<=max_used_attr;i++) {
+	register int v = get_attribute(i);
+	if (v>=0) {
+	  register halfword r = new_attribute_node(i,v);
+	  vlink(p)=r;
+	  p=r;
+	}
+  }
+  if (vlink(attr_list_cache)==null) {
+	free_node(attr_list_cache,attribute_node_size);
+	attr_list_cache = null;
+  } 
+  return;
+}
+
+void 
+build_attribute_list(halfword b) {
+  if (max_used_attr>=0) {
+    if (attr_list_cache==cache_disabled) {
+	  update_attribute_cache();
+	  if (attr_list_cache == null)
+		return;
+    }
+    attr_list_ref(attr_list_cache)++;
+    node_attr(b)=attr_list_cache;   
+  }
+}
+
+void 
+delete_attribute_ref(halfword b) {
+  if (b!=null){
+    assert(type(b)==attribute_list_node);
+    attr_list_ref(b)--;
+    if (attr_list_ref(b)==0) {
+      if (b==attr_list_cache) 
+	attr_list_cache=cache_disabled;
+      free_node_chain(b,attribute_node_size);
+    }
+    /* maintain sanity */
+    if (attr_list_ref(b)<0)
+      attr_list_ref(b)=0;
+  }
+}
+
+/* |p| is an attr list head, or zero */
+
+halfword 
+do_set_attribute (halfword p, int i, int val) {
+  register halfword q;
+  register int j = 0;
+  if (p==null) {  /* add a new head & node */
+    q = get_node(attribute_node_size); 
+    type(q) = attribute_list_node;
+    attr_list_ref(q)=1;
+    p = new_attribute_node(i,val);
+    vlink(q)=p;
+    return q;
+  }
+
+  assert(vlink(p)!=null);
+  while (vlink(p)!=null) {
+    int t = attribute_id(vlink(p));
+    if (t==i && attribute_value(vlink(p))==val)
+      return q; /* no need to do anything */
+    if (t>=i) 
+      break;
+    j++;
+    p = vlink(p);
+  }
+
+  p = q;
+  while (j-->0) p = vlink(p);
+  if (attribute_id(vlink(p))==i) {
+    attribute_value(vlink(p))=val;
+  } else { /* add a new node */
+    halfword r = new_attribute_node(i,val);
+    vlink(r)=vlink(p);
+    vlink(p)=r;
+  }
+  return q;
+}
+
+void 
+set_attribute (halfword n, int i, int val) {
+  register halfword p;
+  register int j = 0;
+  if (!nodetype_has_attributes(type(n)))
+    return;
+  p = node_attr(n);
+  if (p==null) {  /* add a new head & node */
+    p = get_node(attribute_node_size); 
+    type(p) = attribute_list_node;
+    attr_list_ref(p)=1;
+    node_attr(n) = p ;
+    p = new_attribute_node(i,val);
+    vlink(node_attr(n))=p;
+    return;
+  }
+  assert(vlink(p)!=null);
+  while (vlink(p)!=null) {
+    int t = attribute_id(vlink(p));
+    if (t==i && attribute_value(vlink(p))==val)
+      return;
+    if (t>=i) 
+      break;
+    j++;
+    p = vlink(p);
+  }
+  p = node_attr(n);
+  if (attr_list_ref(p)!=1) {
+    if (attr_list_ref(p)>1) {
+      p = copy_attribute_list (p);
+      delete_attribute_ref(node_attr(n));
+      node_attr(n) = p;
+    } else {
+      fprintf(stdout,"Node %d has an attribute list that is free already\n",(int)n);
+    }
+    attr_list_ref(p)=1;  
+  }
+  while (j-->0) p = vlink(p);
+
+  if (attribute_id(vlink(p))==i) {
+    attribute_value(vlink(p))=val;
+  } else { /* add a new node */
+    halfword r = new_attribute_node(i,val);
+    vlink(r)=vlink(p);
+    vlink(p)=r;
+  }
+  return;
+}
+
+
+int 
+unset_attribute (halfword n, int i, int val) {
+  register halfword p;
+  register int t;
+  register int j = 0;
+  
+  if (!nodetype_has_attributes(type(n)))
+    return null;
+  p = node_attr(n);
+  if (p==null)
+    return -1;
+  assert (vlink(p)!=null);
+  while (vlink(p)!=null) {
+    t = attribute_id(vlink(p));
+    if (t>i)
+      return -1;
+    if (t==i)
+      break;
+    j++;
+    p = vlink(p);
+  }
+  /* if we are still here, the attribute exists */
+  p = node_attr(n);
+  if (attr_list_ref(p)!=1) {
+    if (attr_list_ref(p)>1) {
+      p = copy_attribute_list (p);
+      delete_attribute_ref(node_attr(n));
+      node_attr(n) = p;
+    } else {
+      fprintf(stdout,"Node %d has an attribute list that is free already\n",(int)n);
+    }
+    attr_list_ref(p)=1;  
+  }
+  p = vlink(p);
+  while (j-->0) p = vlink(p);
+  t = attribute_value(p);
+  if (val==-1 || t==val) {
+    attribute_value(p)=-1;
+  }
+  return t;
+}
+
+int 
+has_attribute (halfword n,int i, int val) {
+  register halfword p;
+  if (!nodetype_has_attributes(type(n)))
+    return -1;
+  p = node_attr(n);
+  if (p==null || vlink(p)==null)
+    return -1; 
+  p = vlink(p);
+  while (p!=null) {
+    if (attribute_id(p)==i) {
+      int ret = attribute_value(p);
+      if (val==-1 || val==ret)
+	return ret;
+      return -1;
+    } else if (attribute_id(p)>i) {
+      return -1;
+    }
+    p=vlink(p);
+  }
+  return -1;
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/tex/texpdf.c b/Build/source/texk/web2c/luatexdir/tex/texpdf.c
new file mode 100644
index 00000000000..fbb4c2b7e21
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tex/texpdf.c
@@ -0,0 +1,169 @@
+/* $Id: texpdf.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include <ctype.h>
+
+#define number_chars 1114112
+#define string_offset 2097152
+#define str_start_macro(a) str_start[(a) - string_offset]
+#define str_length(a) (str_start_macro((a)+1)-str_start_macro(a))  /* the number of characters  in string number (a) */
+
+#define is_hex_char isxdigit
+
+/* output a byte to PDF buffer without checking of overflow */
+
+#define pdf_quick_out(a)  pdf_buf[pdf_ptr++] = a
+
+/* make sure that there are at least |n| bytes free in PDF buffer */
+
+#define pdf_room(a) do {										\
+	if ((pdf_os_mode) && ((a) + pdf_ptr > pdf_buf_size))		\
+	  pdf_os_get_os_buf(a);										\
+	else if ((!pdf_os_mode) && ((a) > pdf_buf_size) )			\
+	  overflow("PDF output buffer", pdf_op_buf_size);			\
+	else if ((!pdf_os_mode) && ((a) + pdf_ptr > pdf_buf_size))	\
+	  pdf_flush();												\
+  } while (0)
+
+/* do the same as |pdf_quick_out| and flush the PDF buffer if necessary  */
+
+#define pdf_out(a) do {   \
+	pdf_room(1);		  \
+    pdf_quick_out(a);	  \
+  } while (0)
+
+
+/* print out a character to PDF buffer; the character will be printed in octal
+ * form in the following cases: chars <= 32, backslash (92), left parenthesis
+ * (40) and  right parenthesis (41) 
+ */
+
+#define pdf_print_escaped(c)											\
+  if ((c)<=32||(c)=='\\'||(c)=='('||(c)==')'||(c)>127) {				\
+	pdf_room(4);														\
+	pdf_quick_out('\\');												\
+	pdf_quick_out('0' + (((c)>>6) & 0x3));								\
+	pdf_quick_out('0' + (((c)>>3) & 0x7));								\
+	pdf_quick_out('0' + ( (c)     & 0x7));								\
+  } else {																\
+	pdf_out((c));														\
+  }	
+
+void 
+pdf_print_char(internal_font_number f, integer cc) {
+  register int c;
+  pdf_mark_char(f, cc);
+  if (font_encodingbytes(f)==2) {
+	register int chari; 
+	chari = char_index(f, cc);
+	c = chari >> 8;
+	pdf_print_escaped(c);
+	c = chari & 0xFF;
+  } else {
+	if (cc>255) return;
+	c = cc;
+  }
+  pdf_print_escaped(c);
+}
+
+/* print out a string to PDF buffer */
+
+void 
+pdf_print(str_number s) { 
+  if (s < number_chars) {
+	assert(s<256);
+	pdf_out(s);
+  } else {
+	register pool_pointer j = str_start_macro(s);
+	while (j < str_start_macro(s + 1)) {
+	  pdf_out(str_pool[j++]);
+	}
+  }
+}
+
+/* print out a integer to PDF buffer */
+
+void 
+pdf_print_int(integer n) { 
+  register integer k = 0;    /*  current digit; we assume that $|n|<10^{23}$ */
+  if (n<0) {
+	pdf_out('-');
+    if (n<-0x7FFFFFFF) { /* need to negate |n| more carefully */
+      register integer m;
+	  k++;
+	  m =-1-n;  n=m / 10; m= (m % 10)+1;
+      if (m<10) { 
+		dig[0]=m ;
+	  } else {  
+		dig[0]=0; incr(n); 
+	  }
+	} else {
+	  n  = -n;
+	} 
+  }
+  do {
+	dig[k++] = n % 10; 
+	n = n / 10; 
+  } while (n!=0);
+  pdf_room(k);
+  while (k-->0) {
+    pdf_quick_out('0'+dig[k]);
+  }
+}
+
+
+/* print $m/10^d$ as real */
+void 
+pdf_print_real(integer m, integer d) {
+  if (m < 0) {
+    pdf_out('-');
+    m = -m;
+  };
+  pdf_print_int(m / ten_pow[d]);
+  m = m % ten_pow[d];
+  if (m > 0) {
+    pdf_out('.');
+    d--;
+    while (m < ten_pow[d]) {
+      pdf_out('0');
+      d--;
+    }
+    while (m % 10 == 0) 
+      m = m / 10;
+    pdf_print_int(m);
+  }
+}
+
+/* print out |s| as string in PDF output */
+
+void 
+pdf_print_str(str_number s) { 
+  pool_pointer i, j;
+  i = str_start_macro(s);
+  j = str_start_macro(s+1) - 1;
+  if (i > j) {
+    pdf_room(2);
+    pdf_quick_out('(');
+    pdf_quick_out(')');
+    return;
+  }
+  /* the next is not really safe, the string could be "(a)xx(b)" */
+  if ((str_pool[i] == '(') && (str_pool[j] == ')')) {
+    pdf_print(s);
+    return;
+  }
+  if ((str_pool[i] != '<') || (str_pool[j] != '>') || odd(str_length(s))) {
+    pdf_out('('); pdf_print(s); pdf_out(')');
+    return;
+  }
+  i++;
+  j--;
+  while (i < j) {
+    if (!is_hex_char(str_pool[i++])) {
+      pdf_out('('); pdf_print(s); pdf_out(')');
+      return;
+    }
+  } 
+  pdf_print(s); /* it was a hex string after all  */
+}
diff --git a/Build/source/texk/web2c/luatexdir/tex/textoken.c b/Build/source/texk/web2c/luatexdir/tex/textoken.c
new file mode 100644
index 00000000000..20c57b9479b
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tex/textoken.c
@@ -0,0 +1,753 @@
+/* $Id: textoken.c 1013 2008-02-14 00:09:02Z oneiros $ */
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+
+#include "tokens.h"
+
+/* Integer parameters and other command-related defines. This needs it's own header file! */
+
+#define end_line_char_code 48 /* character placed at the right end of the buffer */
+#define cat_code_table_code 63
+#define tex_int_pars 66 /* total number of \.{\\TeX} + Aleph integer parameters */
+/* this is not what happens in the pascal code! there the values shift from bare numbers to offsets ! */
+#define dir_base tex_int_pars
+#define dir_pars 5
+#define pdftex_first_integer_code dir_base+dir_pars /* base for \pdfTeX's integer parameters */
+#define pdf_int_pars pdftex_first_integer_code+27 /*total number of \pdfTeX's integer parameters*/
+#define etex_int_base pdf_int_pars /*base for \eTeX's integer parameters*/
+#define tracing_nesting_code etex_int_base+4 /*show incomplete groups and ifs within files*/
+
+#define int_par(a) zeqtb[static_int_base+a].cint /* an integer parameter */
+#define cat_code_table int_par(cat_code_table_code)
+#define tracing_nesting int_par(tracing_nesting_code)
+#define end_line_char int_par(end_line_char_code)
+
+#define every_eof get_every_eof()
+
+#define number_active_chars 65536+65536
+#define active_base 1 /* beginning of region 1, for active character equivalents */
+#define null_cs active_base+number_active_chars /* equivalent of \.{\\csname\\endcsname} */
+
+
+#define eq_level(a) zeqtb[a].hh.u.B1
+#define eq_type(a)  zeqtb[a].hh.u.B0
+#define equiv(a)    zeqtb[a].hh.v.RH
+
+/* leave an input level, re-enter the old */
+#define pop_input() cur_input=input_stack[--input_ptr]
+
+#define nonstop_mode 1
+
+/* command codes */
+#define relax 0 
+#define out_param 5
+#define max_command 117 /* fetched from C output */
+#define dont_expand 133 /* fetched from C output */
+
+#define terminal_input (name==0) /* are we reading from the terminal? */
+#define special_char 1114113 /* |biggest_char+2| */
+#define cur_file input_file[index] /* the current |alpha_file| variable */
+
+#define no_expand_flag special_char /*this characterizes a special variant of |relax|*/
+
+extern void insert_vj_template (void);
+
+#define do_get_cat_code(a) do {						\
+    if (local_catcode_table)						\
+      a=get_cat_code(line_catcode_table,cur_chr);			\
+    else								\
+      a=get_cat_code(cat_code_table,cur_chr);				\
+  } while (0)
+
+
+static void
+invalid_character_error (void) {
+  char *hlp[] = {"A funny symbol that I can't read has just been input.",
+		 "Continue, and I'll forget that it ever happened.",
+		 NULL};
+  deletions_allowed=false; 
+  tex_error("Text line contains an invalid character", hlp); 
+  deletions_allowed=true;
+}
+
+/* no longer done */
+
+static boolean process_sup_mark(void); /* below */
+
+static int scan_control_sequence(void); /* below */
+
+typedef enum {next_line_ok, next_line_return, next_line_restart } next_line_retval ;
+
+static next_line_retval next_line(void); /* below */
+
+/* @^inner loop@>*/
+
+static void 
+utf_error (void) { 
+  char *hlp[] = {"A funny symbol that I can't read has just been input.",
+		 "Just continue, I'll change it to 0xFFFD.",
+		 NULL };
+  deletions_allowed=false; 
+  tex_error("Text line contains an invalid utf-8 sequence", hlp); 
+  deletions_allowed=true;
+}
+
+static integer 
+qbuffer_to_unichar (integer *k) {
+  register int ch;
+  int val = 0xFFFD;
+  unsigned char *text = buffer+*k;
+  if ( (ch = *text++)<0x80 ) {
+    val = ch;
+    *k+=1;
+  } else if ( ch<=0xbf ) { /* error */
+    *k+=1;
+  } else if ( ch<=0xdf ) {
+    if ( *text>=0x80 && *text<0xc0 )
+      val = ((ch&0x1f)<<6) | (*text++&0x3f);
+    *k+=2;
+  } else if ( ch<=0xef ) {
+    if ( *text>=0x80 && *text<0xc0 && text[1]>=0x80 && text[1]<0xc0 ) {
+      val = ((ch&0xf)<<12) | ((text[0]&0x3f)<<6) | (text[1]&0x3f);
+      *k+=3;
+    }
+  } else {
+    int w = ( ((ch&0x7)<<2) | ((text[0]&0x30)>>4) )-1, w2;
+    w = (w<<6) | ((text[0]&0xf)<<2) | ((text[1]&0x30)>>4);
+    w2 = ((text[1]&0xf)<<6) | (text[2]&0x3f);
+    val = w*0x400 + w2 + 0x10000;
+    if ( *text<0x80 || text[1]<0x80 || text[2]<0x80 ||
+	 *text>=0xc0 || text[1]>=0xc0 || text[2]>=0xc0 )
+      val = 0xFFFD;
+    *k+=4;
+  }	
+  if (val==0xFFFD)
+    utf_error();	
+  return( val );
+}
+
+static boolean 
+get_next_file (void) {
+ SWITCH: 
+  if (loc<=limit) { /* current line not yet finished */
+    cur_chr = qbuffer_to_unichar(&loc); 
+  RESWITCH: 
+    if (detokenized_line) {
+      cur_cmd = (cur_chr==' ' ? 10 : 12) ;
+    } else {
+      do_get_cat_code(cur_cmd);
+    }
+	/* 
+	   @<Change state if necessary, and |goto switch| if the current
+	   character should be ignored, or |goto reswitch| if the current
+	   character changes to another@>;
+	*/
+	/* The following 48-way switch accomplishes the scanning quickly, assuming
+	   that a decent \PASCAL\ compiler has translated the code. Note that the numeric
+	   values for |mid_line|, |skip_blanks|, and |new_line| are spaced
+	   apart from each other by |max_char_code+1|, so we can add a character's
+	   command code to the state to get a single number that characterizes both.
+	*/
+	switch(state+cur_cmd) {
+	case mid_line    + ignore: 
+	case skip_blanks + ignore:
+	case new_line    + ignore: 
+	case skip_blanks + spacer:
+	case new_line    + spacer: /* @<Cases where character is ignored@> */
+	  goto SWITCH;
+	  break;
+	case mid_line    + escape: 
+	case new_line    + escape: 
+	case skip_blanks + escape: /* @<Scan a control sequence ...@>;*/
+	  state = scan_control_sequence();
+	  break;
+	case mid_line    + active_char: 
+	case new_line    + active_char: 
+	case skip_blanks + active_char: /* @<Process an active-character  */
+	  cur_cs=cur_chr+active_base;
+	  cur_cmd=eq_type(cur_cs); 
+	  cur_chr=equiv(cur_cs); 
+	  state=mid_line;
+	  break;
+	case mid_line    + sup_mark: 
+	case new_line    + sup_mark: 
+	case skip_blanks + sup_mark: /* @<If this |sup_mark| starts */
+	  if (process_sup_mark())
+	    goto RESWITCH;
+	  else 
+	    state=mid_line;
+	  break;
+	case mid_line    + invalid_char: 
+	case new_line    + invalid_char: 
+	case skip_blanks + invalid_char: /* @<Decry the invalid character and |goto restart|@>;*/
+	  invalid_character_error();
+	  return false; /* because state may be token_list now */
+	  break;
+	case mid_line    + spacer: /* @<Enter |skip_blanks| state, emit a space@>;*/
+	  state=skip_blanks; 
+	  cur_chr=' ';
+	  break;
+	case mid_line    + car_ret:   /* @<Finish line, emit a space@>;*/
+	  /* When a character of type |spacer| gets through, its character code is
+	     changed to $\.{"\ "}=@'40$. This means that the ASCII codes for tab and space,
+	     and for the space inserted at the end of a line, will
+	     be treated alike when macro parameters are being matched. We do this
+	     since such characters are indistinguishable on most computer terminal displays.
+	  */
+	  loc=limit+1; 
+	  cur_cmd=spacer; 
+	  cur_chr=' ';
+	  break;
+	case skip_blanks + car_ret:
+	case mid_line    + comment: 
+	case new_line    + comment: 
+	case skip_blanks + comment:  /* @<Finish line, |goto switch|@>;*/
+	  loc=limit+1; 
+	  goto SWITCH;
+	  break;
+	case new_line    + car_ret: /* @<Finish line, emit a \.{\\par}@>;*/
+	  loc=limit+1;
+	  cur_cs=par_loc; 
+	  cur_cmd=eq_type(cur_cs);
+	  cur_chr=equiv(cur_cs);
+	  break;
+	case skip_blanks + left_brace:
+	case new_line    + left_brace: 
+	  state=mid_line;  /* fall through */
+	case mid_line    + left_brace: 
+	  align_state++;
+	  break;
+	case skip_blanks + right_brace:
+	case new_line    + right_brace: 
+	  state=mid_line;  /* fall through */
+	case mid_line    + right_brace: 
+	  align_state--;
+	  break;
+	case mid_line + math_shift:
+	case mid_line + tab_mark: 
+	case mid_line + mac_param:
+	case mid_line + sub_mark: 
+	case mid_line + letter: 
+	case mid_line + other_char:
+	  break;
+	default:
+	  /*
+	    case skip_blanks + math_shift:
+	    case skip_blanks + tab_mark:
+	    case skip_blanks + mac_param:
+	    case skip_blanks + sub_mark:
+	    case skip_blanks + letter:
+	    case skip_blanks + other_char:	
+	    case new_line    + math_shift:
+	    case new_line    + tab_mark:
+	    case new_line    + mac_param:
+	    case new_line    + sub_mark:
+	    case new_line    + letter:
+	    case new_line    + other_char:	
+	  */
+	  state=mid_line;
+	  break;
+	}
+  } else {
+	if (current_ocp_lstack>0) {
+	  pop_input(); 
+	  return false;
+	}
+	if (name!=21)
+	  state=new_line;
+	
+	/*
+	  @<Move to next line of file,
+	  or |goto restart| if there is no next line,
+	  or |return| if a \.{\\read} line has finished@>;
+	*/
+	do { 
+	  next_line_retval r = next_line();
+	  if (r==next_line_return) {
+	    return true;
+	  } else if (r==next_line_restart) {
+	    return false;
+	  }
+	} while (0);
+	check_interrupt();
+	goto SWITCH;
+  }
+  return true;
+}
+
+#define is_hex(a) ((a>='0'&&a<='9')||(a>='a'&&a<='f'))
+
+#define add_nybble(a)	do {						\
+    if (a<='9') cur_chr=(cur_chr<<4)+a-'0';				\
+    else        cur_chr=(cur_chr<<4)+a-'a'+10;				\
+  } while (0)
+
+#define hex_to_cur_chr do {						\
+    if (c<='9')  cur_chr=c-'0';						\
+    else         cur_chr=c-'a'+10;					\
+    add_nybble(cc);							\
+  } while (0)
+
+#define four_hex_to_cur_chr do {					\
+    hex_to_cur_chr;							\
+    add_nybble(ccc); add_nybble(cccc);					\
+  } while (0)
+
+#define five_hex_to_cur_chr  do {					\
+    four_hex_to_cur_chr;						\
+    add_nybble(ccccc);							\
+  } while (0)
+
+#define six_hex_to_cur_chr do {						\
+    five_hex_to_cur_chr;						\
+    add_nybble(cccccc);							\
+  } while (0)
+
+
+/* Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.*/
+
+static boolean
+process_sup_mark(void) {
+  if (cur_chr==buffer[loc]) {
+    int c,cc;
+    if (loc<limit) {
+      if ((cur_chr==buffer[loc+1]) && (cur_chr==buffer[loc+2]) 
+	  && (cur_chr==buffer[loc+3]) && (cur_chr==buffer[loc+4]) 
+	  && ((loc+10)<=limit)) {
+	int ccc,cccc,ccccc,cccccc; /* constituents of a possible expanded code */
+	c=buffer[loc+5];      
+	cc=buffer[loc+6]; 
+	ccc=buffer[loc+7];    
+	cccc=buffer[loc+8]; 
+	ccccc=buffer[loc+9];  
+	cccccc=buffer[loc+10];
+	if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc)) && (is_hex(cccc))
+	    && (is_hex(ccccc)) && (is_hex(cccccc))) {
+	  loc=loc+11; 
+	  six_hex_to_cur_chr;
+	  return true;
+        }
+      }
+      if ((cur_chr==buffer[loc+1]) && (cur_chr==buffer[loc+2]) 
+	  && (cur_chr==buffer[loc+3]) && ((loc+8)<=limit)) {
+	int ccc,cccc,ccccc; /* constituents of a possible expanded code */
+	c=buffer[loc+4]; 
+	cc=buffer[loc+5]; 
+	ccc=buffer[loc+6]; 
+	cccc=buffer[loc+7]; 
+	ccccc=buffer[loc+8];
+	if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc)) && (is_hex(cccc)) && (is_hex(ccccc))) {
+	  loc=loc+9; 
+	  five_hex_to_cur_chr;
+	  return true;
+        }
+      }
+      if ((cur_chr==buffer[loc+1]) && (cur_chr==buffer[loc+2]) && ((loc+6)<=limit)) {
+	int ccc,cccc; /* constituents of a possible expanded code */
+	c=buffer[loc+3];   
+	cc=buffer[loc+4]; 
+	ccc=buffer[loc+5]; 
+	cccc=buffer[loc+6];
+	if ((is_hex(c)) && (is_hex(cc)) && (is_hex(ccc)) && (is_hex(cccc))) {
+	  loc=loc+7; 
+	  four_hex_to_cur_chr;
+	  return true;
+	}
+      }
+      c = buffer[loc+1]; 
+      if (c<0200) { /* yes we have an expanded char */
+	loc=loc+2;
+	if (is_hex(c) && loc<=limit) {
+	  cc=buffer[loc]; 
+	  if (is_hex(cc)){
+	    incr(loc); 
+	    hex_to_cur_chr; 
+	    return true;
+	  }
+        }
+	cur_chr = (c<0100 ? c+0100 : c-0100);
+	return true; 
+      }
+    }
+  }
+  return false;
+}
+
+/* Control sequence names are scanned only when they appear in some line of
+   a file; once they have been scanned the first time, their |eqtb| location
+   serves as a unique identification, so \TeX\ doesn't need to refer to the
+   original name any more except when it prints the equivalent in symbolic form.
+   
+   The program that scans a control sequence has been written carefully
+   in order to avoid the blowups that might otherwise occur if a malicious
+   user tried something like `\.{\\catcode\'15=0}'. The algorithm might
+   look at |buffer[limit+1]|, but it never looks at |buffer[limit+2]|.
+
+   If expanded characters like `\.{\^\^A}' or `\.{\^\^df}'
+   appear in or just following
+   a control sequence name, they are converted to single characters in the
+   buffer and the process is repeated, slowly but surely.
+*/
+
+static boolean check_expanded_code (integer *kk) ; /* below */
+
+static int scan_control_sequence (void ) {
+  int retval = mid_line;
+  if (loc>limit) {
+    cur_cs=null_cs; /* |state| is irrelevant in this case */
+  } else {
+    register int cat; /* |cat_code(cur_chr)|, usually */
+    while (1) {
+      integer k=loc; 
+      cur_chr = qbuffer_to_unichar(&k); 
+      do_get_cat_code(cat);
+      if (cat!=letter||k>limit) {
+	retval = (cat==spacer ? skip_blanks : mid_line);
+	if (cat==sup_mark && check_expanded_code(&k)) /* @<If an expanded...@>; */
+	  continue;
+      } else { 
+	retval=skip_blanks;
+	do {
+	  cur_chr = qbuffer_to_unichar(&k); 
+	  do_get_cat_code(cat); 
+	} while (cat==letter&&k<=limit);
+
+	if (cat==sup_mark && check_expanded_code(&k)) /* @<If an expanded...@>; */
+	  continue;
+	if (cat!=letter) {
+	  decr(k);
+	  if (cur_chr>0xFFFF)		  decr(k);
+	  if (cur_chr>0x7FF) 		  decr(k);
+	  if (cur_chr>0x7F)		  decr(k);
+	} /* now |k| points to first nonletter */
+      }
+      cur_cs=id_lookup(loc,k-loc); 
+      loc=k; 
+      break;
+    }
+  }
+  cur_cmd=eq_type(cur_cs); 
+  cur_chr=equiv(cur_cs);
+  return retval;
+}
+
+/* Whenever we reach the following piece of code, we will have
+   |cur_chr=buffer[k-1]| and |k<=limit+1| and |cat=get_cat_code(cat_code_table,cur_chr)|. If an
+   expanded code like \.{\^\^A} or \.{\^\^df} appears in |buffer[(k-1)..(k+1)]|
+   or |buffer[(k-1)..(k+2)]|, we
+   will store the corresponding code in |buffer[k-1]| and shift the rest of
+   the buffer left two or three places.
+*/
+
+static boolean
+check_expanded_code (integer *kk) {
+  int l;
+  int k = *kk;
+  int d =1; /* number of excess characters in an expanded code */
+  int c,cc,ccc,cccc,ccccc,cccccc; /* constituents of a possible expanded code */
+  if (buffer[k]==cur_chr && k<limit) {
+    if ((cur_chr==buffer[k+1]) && (cur_chr==buffer[k+2]) && ((k+6)<=limit)) {
+      d = 4;
+      if ((cur_chr==buffer[k+3]) && ((k+8)<=limit))
+	d = 5;
+      if ((cur_chr==buffer[k+4]) && ((k+10)<=limit)) 
+	d = 6;
+      c   = buffer[k+d-1];
+      cc  = buffer[k+d];
+      ccc = buffer[k+d+1];
+      cccc= buffer[k+d+2];
+      if (d==6) {
+	ccccc =buffer[k+d+3]; 
+	cccccc=buffer[k+d+4]; 
+	if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc) 
+	    && is_hex(ccccc) && is_hex(cccccc))
+	  six_hex_to_cur_chr;
+      } else if (d==5) {
+	ccccc=buffer[k+d+3]; 
+	if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc) && is_hex(ccccc))
+	  five_hex_to_cur_chr;
+      } else {
+	if (is_hex(c) && is_hex(cc) && is_hex(ccc) && is_hex(cccc))
+	  four_hex_to_cur_chr;
+      }
+    } else {
+      c=buffer[k+1]; 
+      if (c<0200) {
+	d=1;
+	if (is_hex(c) && (k+2)<=limit) {
+	  cc=buffer[k+2]; 
+	  if (is_hex(c) && is_hex(cc)) {
+	    d=2;
+	    hex_to_cur_chr;
+	  }
+	} else if (c<0100) {
+	  cur_chr=c+0100;
+	} else {
+	  cur_chr=c-0100;
+	}
+      }
+    }
+    if (d>2) 
+      d=2*d-1; 
+    else 
+      d++;
+    if (cur_chr <= 0x7F) {
+      buffer[k-1]= cur_chr;
+    } else if (cur_chr<=0x7FF) {
+      buffer[k-1]=0xC0 + cur_chr / 0x40;
+      k++; d--;
+      buffer[k-1]=0x80 + cur_chr % 0x40;
+    } else if (cur_chr<=0xFFFF){
+      buffer[k-1]=0xE0 + cur_chr / 0x1000;
+      k++;  d--;
+      buffer[k-1]=0x80 + (cur_chr % 0x1000) / 0x40;
+      k++;  d--;
+      buffer[k-1]=0x80 + (cur_chr % 0x1000) % 0x40;
+    } else {
+      buffer[k-1]=0xF0 + cur_chr / 0x40000;
+      k++;  d--;
+      buffer[k-1]=0x80 + (cur_chr % 0x40000) / 0x1000;
+      k++;  d--;
+      buffer[k-1]=0x80 + ((cur_chr % 0x40000) % 0x1000) / 0x40;
+      k++;  d--;
+      buffer[k-1]=0x80 + ((cur_chr % 0x40000) % 0x1000) % 0x40;
+    }
+    l = k;
+    limit = limit - d;
+    while (l<=limit) {
+      buffer[l]=buffer[l+d]; 
+      l++;
+    }
+    *kk =k;
+    return true;
+  }
+  return false;
+}
+
+#define end_line_char_inactive ((end_line_char<0)||(end_line_char>127))
+
+/* The global variable |force_eof| is normally |false|; it is set |true|
+  by an \.{\\endinput} command.
+
+ @<Glob...@>=
+ @!force_eof:boolean; {should the next \.{\\input} be aborted early?}
+
+*/
+
+
+/* All of the easy branches of |get_next| have now been taken care of.
+  There is one more branch.
+*/
+
+static next_line_retval 
+next_line (void) {
+  integer tab; /* a category table */
+  boolean inhibit_eol = false; /* a way to end a pseudo file without trailing space */
+  detokenized_line=false;  
+  local_catcode_table=false;  
+  if (name>17) { 
+    /* @<Read next line of file into |buffer|, or |goto restart| if the file has ended@> */
+    incr(line); 
+    first=start;
+    if (!force_eof) {
+      if (name<=20) {
+	if (pseudo_input()) { /* not end of file */
+	  firm_up_the_line(); /* this sets |limit| */
+	  if ((name==19)&&(pseudo_lines(pseudo_files)==null))
+	    inhibit_eol=true;
+	} else if ((every_eof!=null)&&!eof_seen[index]) {
+	  limit=first-1; eof_seen[index]=true; /* fake one empty line */
+	  if (name!=19) 
+	    begin_token_list(every_eof,every_eof_text); 
+	  return next_line_restart;
+	} else {
+	  force_eof=true;
+	}
+      } else {
+	if (name==21) {
+	  if (luacstring_input()) { /* not end of strings  */
+	    firm_up_the_line();
+	    if ((luacstring_penultimate())||(luacstring_simple())) 
+	      inhibit_eol=true;
+	    if (!luacstring_simple()) 
+	      state=new_line;
+	    if (luacstring_detokenized()) {
+	      inhibit_eol=true;
+	      detokenized_line=true;
+	    } else {
+	      if (! luacstring_defaultcattable()) {
+		tab=luacstring_cattable();
+		if (valid_catcode_table(tab)) {
+		  local_catcode_table=true;
+		  line_catcode_table=tab;
+		}
+	      }
+	    }
+	  } else {
+	    force_eof=true;
+	  }
+	} else {
+	  if (lua_input_ln(cur_file,0,true)) { /* not end of file */
+	    firm_up_the_line(); /* this sets |limit| */
+	  } else if ((every_eof!=null)&& (!eof_seen[index])) {
+	    limit=first-1; eof_seen[index]=true; /* fake one empty line */
+	    begin_token_list(every_eof,every_eof_text); 
+	    return next_line_restart;
+	  } else {
+	    force_eof=true;
+	  }
+	}
+      }
+    }
+    if (force_eof) {
+      if (tracing_nesting>0)
+	if ((grp_stack[in_open]!=cur_boundary)||(if_stack[in_open]!=cond_ptr))
+	  if (!((name==19)||(name=21)))
+	    file_warning(); /* give warning for some unfinished groups and/or conditionals */
+      if ((name>21)||(name==20)) {
+	if (tracefilenames)
+	  print_char(')'); 
+	open_parens--;
+	/* update_terminal();*/ /* show user that file has been read */
+      }
+      force_eof=false;
+      end_file_reading();
+      return next_line_restart;
+    }
+    if (inhibit_eol||end_line_char_inactive) 
+      limit--;
+    else  
+      buffer[limit]=end_line_char;
+    first=limit+1; 
+    loc=start; /* ready to read */
+  } else {
+    if (!terminal_input) { /* \.{\\read} line has ended */
+      cur_cmd=0; 
+      cur_chr=0; 
+      return next_line_return; /* OUTER */
+    }
+    if (input_ptr>0)  { /* text was inserted during error recovery */
+      end_file_reading(); 
+      return next_line_restart; /* resume previous level */
+    }
+    if (selector<log_only) 
+      open_log_file();
+    if (interaction>nonstop_mode) {
+      if (end_line_char_inactive) 
+	limit++;
+      if (limit==start) { /* previous line was empty */
+	tprint_nl("(Please type a command or say `\\end')");
+      }
+      print_ln(); 
+      first=start;
+      prompt_input((str_number)'*'); /* input on-line into |buffer| */
+      limit=last;
+      if (end_line_char_inactive) 
+	limit--;
+      else  
+	buffer[limit]=end_line_char;
+      first=limit+1;
+      loc=start;
+    } else {
+      fatal_error(maketexstring("*** (job aborted, no legal \\end found)"));
+      /* nonstop mode, which is intended for overnight batch processing,
+	 never waits for on-line input */
+    }
+  }
+  return next_line_ok;
+}
+
+
+
+
+/* Let's consider now what happens when |get_next| is looking at a token list. */
+
+static boolean 
+get_next_tokenlist (void) {
+  register halfword t; /* a token*/ 
+  t=info(loc); 
+  loc=link(loc); /* move to next */
+  if (t>=cs_token_flag) { /* a control sequence token */
+    cur_cs=t-cs_token_flag;
+    cur_cmd=eq_type(cur_cs); 
+    if (cur_cmd==dont_expand) {  /* @<Get the next token, suppressing expansion@>*/
+      /* The present point in the program is reached only when the |expand|
+	 routine has inserted a special marker into the input. In this special
+	 case, |info(loc)| is known to be a control sequence token, and |link(loc)=null|.
+      */
+      cur_cs=info(loc)-cs_token_flag; 
+      loc=null;
+      cur_cmd=eq_type(cur_cs); 
+      if (cur_cmd>max_command) {
+	cur_cmd=relax; 
+	cur_chr=no_expand_flag;
+	return true;
+      } 
+    }
+    cur_chr=equiv(cur_cs);
+  } else { 
+    cur_cmd=t >> string_offset_bits; /* cur_cmd=t / string_offset; */
+    cur_chr=t & (string_offset-1);   /* cur_chr=t % string_offset; */
+    switch (cur_cmd) {
+    case left_brace: 
+      align_state++; 
+      break;
+    case right_brace: 
+      align_state--;
+      break;
+    case out_param:  /* @<Insert macro parameter and |goto restart|@>; */
+      begin_token_list(param_stack[param_start+cur_chr-1],parameter);
+      return false;
+      break;
+    }
+  }
+  return true;
+}
+
+/* Now we're ready to take the plunge into |get_next| itself. Parts of
+   this routine are executed more often than any other instructions of \TeX.
+   @^mastication@>@^inner loop@>
+*/
+
+/* sets |cur_cmd|, |cur_chr|, |cur_cs| to next token */
+
+void 
+get_next (void) {
+ RESTART: 
+  cur_cs=0; 
+  if (state!=token_list) {
+    /* Input from external file, |goto restart| if no input found */	
+    if (!get_next_file())
+      goto RESTART;
+  } else {
+    if (loc==null) { 
+      end_token_list(); 
+      goto RESTART; /* list exhausted, resume previous level */
+    } else if (!get_next_tokenlist()) { 
+      goto RESTART; /* parameter needs to be expanded */
+    }
+  }
+  /* @<If an alignment entry has just ended, take appropriate action@> */
+  if ((cur_cmd==tab_mark || cur_cmd==car_ret) && align_state==0) {
+    insert_vj_template();
+    goto RESTART;
+  }
+}
+
+void
+get_token_lua (void) {
+  register int callback_id ; 
+  callback_id = callback_defined(token_filter_callback);
+  if (callback_id!=0) {
+    while (state==token_list && loc==null && index!=v_template)
+      end_token_list();
+    /* there is some stuff we don't want to see inside the callback */
+    if (!(state==token_list && 
+	  ((nofilter==true) || (index==backed_up && loc!=null)))) {
+      do_get_token_lua(callback_id);
+      return;
+    }
+  } 
+  get_next();
+}
diff --git a/Build/source/texk/web2c/luatexdir/textcodes.c b/Build/source/texk/web2c/luatexdir/textcodes.c
new file mode 100644
index 00000000000..05f85b941c4
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/textcodes.c
@@ -0,0 +1,278 @@
+
+/* 
+Copyright (c) 2006 Taco Hoekwater, <taco@elvenkind.com>
+
+This file is part of LuaTeX.
+
+LuaTeX 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.
+
+LuaTeX 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 LuaTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+*/
+
+
+#include "luatex-api.h"
+#include <ptexlib.h>
+#include <stdarg.h>
+
+#include "managed-sa.h"
+
+#define LCCODESTACK  8
+#define LCCODEDEFAULT 0
+
+static sa_tree  lccode_head  = NULL;
+
+#define UCCODESTACK  8
+#define UCCODEDEFAULT 0
+
+static sa_tree  uccode_head  = NULL;
+
+#define SFCODESTACK 8
+#define SFCODEDEFAULT 1000
+
+static sa_tree  sfcode_head  = NULL;
+
+#define CATCODESTACK 8
+#define CATCODEDEFAULT 12
+
+void  set_lc_code (integer n, halfword v, quarterword gl) {
+  set_sa_item(lccode_head,n,v,gl);
+}
+
+halfword get_lc_code (integer n) {
+  return (halfword)get_sa_item(lccode_head,n);
+}
+
+static void unsavelccodes (quarterword gl) {
+  restore_sa_stack(lccode_head,gl);
+}
+
+static void initializelccodes (void) {
+  lccode_head = new_sa_tree(LCCODESTACK,LCCODEDEFAULT);
+}
+
+static void dumplccodes (void) {
+  dump_sa_tree(lccode_head);
+}
+
+static void undumplccodes (void) {
+  lccode_head  = undump_sa_tree();
+}
+
+void  set_uc_code (integer n, halfword v, quarterword gl) {
+  set_sa_item(uccode_head,n,v,gl);
+}
+
+halfword get_uc_code (integer n) {
+  return (halfword)get_sa_item(uccode_head,n);
+}
+
+static void unsaveuccodes (quarterword gl) {
+  restore_sa_stack(uccode_head,gl);
+}
+
+static void initializeuccodes (void) {
+  uccode_head = new_sa_tree(UCCODESTACK,UCCODEDEFAULT);
+}
+
+static void dumpuccodes (void) {
+  dump_sa_tree(uccode_head);
+}
+
+static void undumpuccodes (void) {
+  uccode_head  = undump_sa_tree();
+}
+
+void  set_sf_code (integer n, halfword v, quarterword gl) {
+  set_sa_item(sfcode_head,n,v,gl);
+}
+
+halfword get_sf_code (integer n) {
+  return (halfword)get_sa_item(sfcode_head,n);
+}
+
+static void unsavesfcodes (quarterword gl) {
+  restore_sa_stack(sfcode_head,gl);
+}
+
+static void initializesfcodes (void) {
+  sfcode_head = new_sa_tree(SFCODESTACK,SFCODEDEFAULT);
+}
+
+static void dumpsfcodes (void) {
+  dump_sa_tree(sfcode_head);
+}
+
+static void undumpsfcodes (void) {
+  sfcode_head  = undump_sa_tree();
+}
+
+
+static sa_tree *catcode_heads = NULL;
+static int catcode_max = 0;
+static unsigned char *catcode_valid = NULL;
+
+void check_catcode_sizes (int h) {
+  int k;
+  if (h < 0)
+    uexit(1);
+  if (h>catcode_max) {
+	catcode_heads = Mxrealloc_array(catcode_heads,sa_tree,(h+1));
+	catcode_valid = Mxrealloc_array(catcode_valid,unsigned char,(h+1));
+	for (k=(catcode_max+1);k<=h;k++) {
+	  catcode_heads[k] = NULL;
+	  catcode_valid[k] = 0;
+	}
+	catcode_max = h;
+  }
+}
+
+void  set_cat_code (integer h, integer n, halfword v, quarterword gl) {
+  check_catcode_sizes(h);
+  if (catcode_heads[h] == NULL) {
+    catcode_heads[h] = new_sa_tree(CATCODESTACK,CATCODEDEFAULT);
+  }
+  set_sa_item(catcode_heads[h],n,v,gl);
+}
+
+halfword get_cat_code (integer h, integer n) {
+  check_catcode_sizes(h);
+  if (catcode_heads[h] == NULL) {
+    catcode_heads[h] = new_sa_tree(CATCODESTACK,CATCODEDEFAULT);
+  }
+  return (halfword)get_sa_item(catcode_heads[h],n);
+}
+
+void unsave_cat_codes (integer h, quarterword gl) {
+  int k;
+  check_catcode_sizes(h);
+  for (k=0;k<=catcode_max;k++) {
+    if (catcode_heads[k] != NULL)
+      restore_sa_stack(catcode_heads[k],gl);
+  }
+}
+
+void clearcatcodestack(integer h) {
+  clear_sa_stack(catcode_heads[h]);
+}
+
+static void initializecatcodes (void) {
+  catcode_max   = 0;
+  catcode_heads = Mxmalloc_array(sa_tree,(catcode_max+1));
+  catcode_valid = Mxmalloc_array(unsigned char,(catcode_max+1));
+  catcode_valid[0] = 1;
+  catcode_heads[0] = new_sa_tree(CATCODESTACK,CATCODEDEFAULT);
+}
+
+static void dumpcatcodes (void) {
+  int k,total;
+  dump_int(catcode_max);
+  total = 0;
+  for (k=0;k<=catcode_max;k++) {
+    if (catcode_valid[k]) {
+      total++;
+    }
+  }
+  dump_int(total);
+  for (k=0;k<=catcode_max;k++) {
+    if (catcode_valid[k]) {
+      dump_int(k);
+      dump_sa_tree(catcode_heads[k]);
+    }
+  }
+}
+
+static void undumpcatcodes (void) {
+  int total,h,k;
+  undump_int(catcode_max);
+  catcode_heads = Mxmalloc_array(sa_tree,(catcode_max+1));
+  catcode_valid = Mxmalloc_array(unsigned char,(catcode_max+1));
+  for (k=0;k<=catcode_max;k++) {
+    catcode_heads[k]=NULL;
+    catcode_valid[k]=0;
+  }
+  undump_int(total);
+  for (k=0;k<total;k++) {
+    undump_int(h);
+    catcode_heads[h] = undump_sa_tree(); 
+    catcode_valid[h] = 1;
+  }
+}
+
+int valid_catcode_table (int h) {
+  if (h<=catcode_max && h>=0 && catcode_valid[h]) {
+    return 1;
+  }
+  return 0;
+}
+
+void copy_cat_codes (int from, int to) {
+  if (from<0 || from>catcode_max || catcode_valid[from] == 0) {
+	uexit(1);
+  }
+  check_catcode_sizes(to);
+  destroy_sa_tree(catcode_heads[to]);
+  catcode_heads[to] = copy_sa_tree(catcode_heads[from]); 
+  catcode_valid[to] = 1;
+}
+
+void initex_cat_codes (int h) {
+  int k;
+  check_catcode_sizes(h);
+  destroy_sa_tree(catcode_heads[h]);
+  catcode_heads[h] = NULL;
+  set_cat_code(h,'\r',car_ret,1);
+  set_cat_code(h,' ',spacer,1);
+  set_cat_code(h,'\\',escape,1);
+  set_cat_code(h,'%',comment,1);
+  set_cat_code(h,127,invalid_char,1);
+  set_cat_code(h,0,ignore,1);
+  for (k='A';k<='Z';k++) {
+	set_cat_code(h,k,letter,1); 
+	set_cat_code(h,k+'a'-'A',letter,1);
+  }
+  catcode_valid[h] = 1;
+}
+
+void 
+unsave_text_codes (quarterword grouplevel) {
+  unsavesfcodes(grouplevel);
+  unsaveuccodes(grouplevel);
+  unsavelccodes(grouplevel);
+}
+
+void 
+initialize_text_codes (void) {
+  initializesfcodes();
+  initializeuccodes();
+  initializecatcodes();
+  initializelccodes();
+}
+
+void 
+dump_text_codes (void) {
+  dumpsfcodes();
+  dumpuccodes();
+  dumplccodes();
+  dumpcatcodes();
+}
+
+void 
+undump_text_codes (void) {
+  undumpsfcodes();
+  undumpuccodes();
+  undumplccodes();
+  undumpcatcodes();
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/tokens.h b/Build/source/texk/web2c/luatexdir/tokens.h
new file mode 100644
index 00000000000..6078644ba22
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/tokens.h
@@ -0,0 +1,68 @@
+/* $Id$ */
+
+
+#define token_list 0
+#define cs_token_flag 0x1FFFFFFF
+#define string_offset 0x200000
+#define string_offset_bits 21
+
+#define token_type index /* type of current token list */
+#define param_start limit /* base of macro parameters in |param_stack| */
+
+typedef enum {
+  parameter=0,  /*  code for parameter */
+  u_template=1,  /*  code for \<u_j> template */
+  v_template=2,  /*  code for \<v_j> template */
+  backed_up=3,  /*  code for text to be reread */
+  inserted=4,  /*  code for inserted texts */
+  macro=5,  /*  code for defined control sequences */
+  output_text=6,  /*  code for output routines */
+  every_par_text=7,  /*  code for \.{\\everypar}  */
+  every_math_text=8,  /*  code for \.{\\everymath} */
+  every_display_text=9,  /*  code for \.{\\everydisplay} */
+  every_hbox_text=10,  /*  code for \.{\\everyhbox} */
+  every_vbox_text=11,  /*  code for \.{\\everyvbox} */
+  every_job_text=12,  /*  code for \.{\\everyjob}/ */
+  every_cr_text=13,  /*  code for \.{\\everycr} */
+  mark_text=14,  /*  code for \.{\\topmark}, etc. */
+  every_eof_text=19 /* was calculated, value fetched from the generated C */
+} token_types;
+
+#undef link /* defined by cpascal.h */
+#define info(a)    fixmem[(a)].hhlh
+#define link(a)    fixmem[(a)].hhrh
+
+#define store_new_token(a) { q=get_avail(); link(p)=q; info(q)=(a); p=q; }
+#define free_avail(a)      { link((a))=avail; avail=(a); decr(dyn_used); }
+
+
+#define str_start_macro(a) str_start[(a) - string_offset]
+
+#define length(a) (str_start_macro((a)+1)-str_start_macro(a))
+
+#if defined(index)
+#undef index
+#endif
+
+#define loc      cur_input.loc_field       /* location of first unread character in |buffer| */
+#define state    cur_input.state_field     /* current scanner state */
+#define index    cur_input.index_field     /* reference for buffer information */
+#define start    cur_input.start_field     /* starting position in |buffer| */
+#define limit    cur_input.limit_field     /* end of current line in |buffer| */
+#define nofilter cur_input.nofilter_field  /* is token filtering explicitly disallowed? */
+#define name     cur_input.name_field      /* name of the current file */
+#define current_ocp_lstack cur_input.ocp_lstack_field /* name of the current ocp */
+#define current_ocp_no cur_input.ocp_no_field /* name of the current ocp */
+
+#define max_char_code 15 /* largest catcode for individual characters */
+
+typedef enum {  
+  mid_line=1, /* |state| code when scanning a line of characters */
+  skip_blanks=2+max_char_code, /* |state| code when ignoring blanks */
+  new_line=3+max_char_code+max_char_code, /* |state| code at start of line */
+} state_codes ;
+
+
+extern void make_token_table (lua_State *L, int cmd, int chr, int cs);
+
+
diff --git a/Build/source/texk/web2c/luatexdir/ttf2afm.c b/Build/source/texk/web2c/luatexdir/ttf2afm.c
new file mode 100644
index 00000000000..45524e658fa
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ttf2afm.c
@@ -0,0 +1,1053 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+/*
+#include <kpathsea/c-auto.h>
+#include <kpathsea/c-fopen.h>
+#include <kpathsea/c-limits.h>
+#include <kpathsea/c-memstr.h>
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-std.h>
+#include <kpathsea/c-unistd.h>
+#include <kpathsea/c-vararg.h>
+#include <kpathsea/getopt.h>
+*/
+#include <kpathsea/kpathsea.h>
+#include <time.h>
+#include <libgen.h>
+#include <pdftexdir/ptexmac.h>
+#include <pdftexdir/writettf.h>
+#include <string.h>
+
+/* constants used for print_glyph */
+#define AS_NAME         0
+#define AS_INDEX        1
+#define AS_UNICODE      2
+
+#define VERSION         "1.02"
+
+/* FIXME */
+#define NOGLYPH_ASSIGNED_YET USHRT_MAX
+
+#define enc_getchar()   xgetc(encfile)
+#define enc_eof()       feof(encfile)
+#define pdftex_fail     ttf_fail
+
+#define print_str(S)    if (S != NULL) fprintf(outfile, #S " %s\n", S)
+#define print_dimen(N)  if (N != 0) fprintf(outfile, #N " %i\n", (int)get_ttf_funit(N))
+
+#define get_ttf_funit(n) \
+    (n < 0 ? -((-n/upem)*1000 + ((-n%upem)*1000)/upem) :\
+    ((n/upem)*1000 + ((n%upem)*1000)/upem))
+
+typedef struct _unicode_entry {
+    TTF_USHORT code;
+    struct _unicode_entry *next;
+} unicode_entry;
+
+typedef struct {
+    TTF_ULONG wx;
+    const char *name;
+    TTF_USHORT index;
+    TTF_LONG bbox[4];
+    TTF_LONG offset;
+    char found;
+    unicode_entry *unicode_list;
+} mtx_entry;
+
+typedef struct _kern_entry {
+    TTF_FWORD value;
+    TTF_USHORT adjacent;
+    struct _kern_entry *next;
+} kern_entry;
+
+
+char *FontName = NULL;
+char *FullName = NULL;
+char *FamilyName = NULL;
+char *Notice = NULL;
+char *Version = NULL;
+char *Weight = NULL;
+TTF_LONG ItalicAngle = 0;
+TTF_LONG IsFixedPitch = 0;
+TTF_LONG FontBBox1 = 0;
+TTF_LONG FontBBox2 = 0;
+TTF_LONG FontBBox3 = 0;
+TTF_LONG FontBBox4 = 0;
+TTF_LONG UnderlinePosition = 0;
+TTF_LONG UnderlineThickness = 0;
+TTF_LONG CapHeight = 0;
+TTF_LONG XHeight = 0;
+TTF_LONG Ascender = 0;
+TTF_LONG Descender = 0;
+
+char *cur_file_name = NULL;
+char *bname = NULL;
+FILE *fontfile, *encfile, *outfile = NULL;
+char enc_line[ENC_BUF_SIZE];
+int print_glyph = AS_NAME;      /* print glyph as names by default */
+int print_cmap = 0;
+int use_ext_enc = 0;            /* use external encoding? */
+int select_unicode = 1;         /* use the first unicode mapping by default */
+int printing_enc = 0;           /* set to 1 while printing encodings */
+
+
+TTF_USHORT upem;
+TTF_USHORT ntabs;
+int nhmtx;
+int post_format;
+int loca_format;
+int nglyphs;
+int nkernpairs = 0;
+int names_count = 0;
+char *ps_glyphs_buf = NULL;
+dirtab_entry *dir_tab;
+mtx_entry *mtx_tab;
+kern_entry *kern_tab;
+char *enc_names[256];
+
+cmap_entry *cmap_tab;
+TTF_USHORT ncmapsubtabs;
+long cmap_offset;
+
+TTF_USHORT unicode_map[0xFFFF];
+
+#include "macnames.c"
+
+void ttf_fail(char *fmt, ...)
+{
+    va_list args;
+    va_start(args, fmt);
+    fprintf(stderr, "\nError: ttf2afm");
+    if (cur_file_name)
+        fprintf(stderr, " (file %s)", cur_file_name);
+    fprintf(stderr, ": ");
+    vfprintf(stderr, fmt, args);
+    fprintf(stderr, "\n");
+    va_end(args);
+    exit(-1);
+}
+
+void ttf_warn(char *fmt, ...)
+{
+    va_list args;
+    va_start(args, fmt);
+    fprintf(stderr, "\nWarning: ttf2afm");
+    if (cur_file_name)
+        fprintf(stderr, " (file %s)", cur_file_name);
+    fprintf(stderr, ": ");
+    vfprintf(stderr, fmt, args);
+    fprintf(stderr, "\n");
+    va_end(args);
+}
+
+int xgetc(FILE * stream)
+{
+    int c = getc(stream);
+    if (c < 0 && c != EOF)
+        ttf_fail("getc() failed");
+    return c;
+}
+
+long ttf_getnum(int s)
+{
+    long i = 0;
+    int c;
+    while (s > 0) {
+        if ((c = xgetc(fontfile)) < 0)
+            ttf_fail("unexpected EOF");
+        i = (i << 8) + c;
+        s--;
+    }
+    return i;
+}
+
+dirtab_entry *name_lookup(char *s)
+{
+    dirtab_entry *p;
+    for (p = dir_tab; p - dir_tab < ntabs; p++)
+        if (strncmp(p->tag, s, 4) == 0)
+            break;
+    if (p - dir_tab == ntabs)
+        p = NULL;
+    return p;
+}
+
+void ttf_seek_tab(char *name, TTF_LONG offset)
+{
+    dirtab_entry *p = name_lookup(name);
+    if (p == NULL)
+        ttf_fail("can't find table `%s'", name);
+    if (fseek(fontfile, p->offset + offset, SEEK_SET) < 0)
+        ttf_fail("fseek() failed while reading `%s' table", name);
+}
+
+void ttf_seek_off(char *name, TTF_LONG offset)
+{
+    if (fseek(fontfile, offset, SEEK_SET) < 0)
+        ttf_fail("fseek() failed while reading `%s' table", name);
+}
+
+void store_kern_value(TTF_USHORT i, TTF_USHORT j, TTF_FWORD v)
+{
+    kern_entry *pk;
+    for (pk = kern_tab + i; pk->next != NULL; pk = pk->next);
+    pk->next = xtalloc(1, kern_entry);
+    pk = pk->next;
+    pk->next = NULL;
+    pk->adjacent = j;
+    pk->value = v;
+}
+
+TTF_FWORD get_kern_value(TTF_USHORT i, TTF_USHORT j)
+{
+    kern_entry *pk;
+    for (pk = kern_tab + i; pk->next != NULL; pk = pk->next)
+        if (pk->adjacent == j)
+            return pk->value;
+    return 0;
+}
+
+void free_tabs()
+{
+    int i;
+    kern_entry *p, *q, *r;
+    unicode_entry *u, *v;
+    mtx_entry *pm;
+    xfree(ps_glyphs_buf);
+    xfree(dir_tab);
+    xfree(cmap_tab);
+    for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
+        if (pm->unicode_list != NULL) {
+            for (u = pm->unicode_list; u != NULL; u = v) {
+                v = u->next;
+                xfree(u);
+            }
+        }
+    xfree(mtx_tab);
+    for (i = 0; i < 256; i++)
+        if (enc_names[i] != notdef)
+            free(enc_names[i]);
+    if (kern_tab == NULL)
+        return;
+    for (p = kern_tab; p - kern_tab < nglyphs; p++)
+        if (p->next != NULL) {
+            for (q = p->next; q != NULL; q = r) {
+                r = q->next;
+                xfree(q);
+            }
+        }
+    xfree(kern_tab);
+}
+
+void enc_getline()
+{
+    char *p;
+    int c;
+  restart:
+    if (enc_eof())
+        ttf_fail("unexpected end of file");
+    p = enc_line;
+    do {
+        c = enc_getchar();
+        append_char_to_buf(c, p, enc_line, ENC_BUF_SIZE);
+    } while (c != 10);
+    append_eol(p, enc_line, ENC_BUF_SIZE);
+    if (p - enc_line <= 2 || *enc_line == '%')
+        goto restart;
+}
+
+void read_encoding(char *encname)
+{
+    char buf[ENC_BUF_SIZE], *q, *r;
+    int i;
+    cur_file_name = encname;
+    if ((encfile = kpse_open_file(encname, kpse_enc_format)) == NULL)
+        ttf_fail("can't open encoding file for reading");
+    enc_getline();
+    if (*enc_line != '/' || (r = strchr(enc_line, '[')) == 0)
+        ttf_fail("invalid encoding vector: name or `[' missing:\n%s", enc_line);
+    for (i = 0; i < 256; i++)
+        enc_names[i] = (char *) notdef;
+    if (r[1] == 32)
+        r += 2;
+    else
+        r++;
+    for (;;) {
+        while (*r == '/') {
+            for (q = buf, r++; *r != ' ' && *r != 10 && *r != ']' && *r != '/';
+                 *q++ = *r++);
+            *q = 0;
+            if (*r == ' ')
+                r++;
+            if (strcmp(buf, notdef) != 0)
+                enc_names[names_count] = xstrdup(buf);
+            if (++names_count > 256)
+                ttf_fail("encoding vector contains more than 256 names");
+        }
+        if (*r != 10 && *r != '%') {
+            if (str_prefix(r, "] def"))
+                goto done;
+            else
+                ttf_fail
+                    ("invalid encoding vector: a name or `] def' expected:\n%s",
+                     enc_line);
+        }
+        enc_getline();
+        r = enc_line;
+    }
+  done:
+    xfclose(encfile, cur_file_name);
+    if (names_count != 256)
+        ttf_warn("encoding vector contains only %i names (expected %i)",
+                 names_count, 256);
+}
+
+void append_unicode(long glyph_index, TTF_USHORT code)
+{
+    mtx_entry *m;
+    unicode_entry *u, *v;
+    assert(glyph_index >= 0 && glyph_index < nglyphs);
+    u = xtalloc(1, unicode_entry);
+    m = mtx_tab + glyph_index;
+    u->next = NULL;
+    u->code = code;
+    if (m->unicode_list == NULL)
+        m->unicode_list = u;
+    else {
+        for (v = m->unicode_list; v->next != NULL; v = v->next);
+        v->next = u;
+    }
+}
+
+void read_cmap()
+{
+    cmap_entry *e;
+    seg_entry *seg_tab, *s;
+    TTF_USHORT *glyphId, format, segCount;
+    long int n, i, k, length, index;
+    int unicode_map_count = 0;
+    ttf_seek_tab("cmap", TTF_USHORT_SIZE);      /* skip the table vesrion number (=0) */
+    ncmapsubtabs = get_ushort();
+    cmap_offset = xftell(fontfile, cur_file_name) - 2 * TTF_USHORT_SIZE;
+    cmap_tab = xtalloc(ncmapsubtabs, cmap_entry);
+    for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+        e->platform_id = get_ushort();
+        e->encoding_id = get_ushort();
+        e->offset = get_ulong();
+    }
+    for (i = 0; i < 0xFFFF; ++i)
+        unicode_map[i] = NOGLYPH_ASSIGNED_YET;
+    for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+        ttf_seek_off("cmap", cmap_offset + e->offset);
+        format = get_ushort();
+        if (is_unicode_mapping(e) && format == 4) {
+            ++unicode_map_count;
+            if (unicode_map_count == select_unicode)
+                goto read_unicode_mapping;
+        }
+        continue;
+      read_unicode_mapping:
+        length = get_ushort();  /* length of subtable */
+        (void) get_ushort();    /* skip the version number */
+        segCount = get_ushort() / 2;
+        (void) get_ushort();    /* skip searchRange */
+        (void) get_ushort();    /* skip entrySelector */
+        (void) get_ushort();    /* skip rangeShift */
+        seg_tab = xtalloc(segCount, seg_entry);
+        for (s = seg_tab; s - seg_tab < segCount; s++)
+            s->endCode = get_ushort();
+        (void) get_ushort();    /* skip reversedPad */
+        for (s = seg_tab; s - seg_tab < segCount; s++)
+            s->startCode = get_ushort();
+        for (s = seg_tab; s - seg_tab < segCount; s++)
+            s->idDelta = get_ushort();
+        for (s = seg_tab; s - seg_tab < segCount; s++)
+            s->idRangeOffset = get_ushort();
+        length -= 8 * TTF_USHORT_SIZE + 4 * segCount * TTF_USHORT_SIZE;
+        n = length / TTF_USHORT_SIZE;   /* number of glyphID's */
+        glyphId = xtalloc(n, TTF_USHORT);
+        for (i = 0; i < n; i++)
+            glyphId[i] = get_ushort();
+        for (s = seg_tab; s - seg_tab < segCount; s++) {
+            for (i = s->startCode; i <= s->endCode; i++) {
+                if (i == 0xFFFF)
+                    break;
+                if (s->idRangeOffset != 0xFFFF) {
+                    if (s->idRangeOffset == 0)
+                        index = (s->idDelta + i) & 0xFFFF;
+                    else {
+                        k = (i - s->startCode) + s->idRangeOffset / 2 +
+                            (s - seg_tab) - segCount;
+                        assert(k >= 0 && k < n);
+                        index = glyphId[k];
+                        if (index != 0)
+                            index = (index + s->idDelta) & 0xFFFF;
+                    }
+                    if (index < 0 || index >= nglyphs)
+                        ttf_fail("cmap: glyph index out of range [0..%i)",
+                                 nglyphs);
+                    if (unicode_map[i] != NOGLYPH_ASSIGNED_YET)
+                        ttf_fail
+                            ("cmap: unicode %.4X is mapped to multiple glyphs",
+                             i);
+                    if (unicode_map[i] == 0)
+                        ttf_warn("unicode %.4X is mapped to glyph 0", i);
+                    unicode_map[i] = index;
+                    append_unicode(index, i);
+                }
+            }
+        }
+        xfree(seg_tab);
+        xfree(glyphId);
+        break;
+    }
+    if (e - cmap_tab == ncmapsubtabs)
+        ttf_fail("Invalid argument `-m %i': out of range [1..%i]",
+                 select_unicode, unicode_map_count);
+}
+
+void read_font()
+{
+    long i, j, k, l, n, m, platform_id, encoding_id;
+    TTF_FWORD kern_value;
+    char buf[1024], *p;
+    dirtab_entry *pd;
+    kern_entry *pk;
+    mtx_entry *pm;
+    ttf_skip(TTF_FIXED_SIZE);
+    ntabs = get_ushort();
+    ttf_skip(3 * TTF_USHORT_SIZE);
+    dir_tab = xtalloc(ntabs, dirtab_entry);
+    for (pd = dir_tab; pd - dir_tab < ntabs; pd++) {
+        pd->tag[0] = get_char();
+        pd->tag[1] = get_char();
+        pd->tag[2] = get_char();
+        pd->tag[3] = get_char();
+        ttf_skip(TTF_ULONG_SIZE);
+        pd->offset = get_ulong();
+        pd->length = get_ulong();
+    }
+    ttf_seek_tab("head",
+                 2 * TTF_FIXED_SIZE + 2 * TTF_ULONG_SIZE + TTF_USHORT_SIZE);
+    upem = get_ushort();
+    ttf_skip(16);
+    FontBBox1 = get_fword();
+    FontBBox2 = get_fword();
+    FontBBox3 = get_fword();
+    FontBBox4 = get_fword();
+    ttf_skip(TTF_USHORT_SIZE);
+    ttf_skip(TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+    loca_format = get_short();
+    ttf_seek_tab("maxp", TTF_FIXED_SIZE);
+    nglyphs = get_ushort();
+    mtx_tab = xtalloc(nglyphs + 1, mtx_entry);
+    for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++) {
+        pm->name = NULL;        /* notdef */
+        pm->found = 0;
+        pm->unicode_list = NULL;
+    }
+    ttf_seek_tab("hhea", TTF_FIXED_SIZE);
+    Ascender = get_fword();
+    Descender = get_fword();
+    ttf_skip(TTF_FWORD_SIZE + TTF_UFWORD_SIZE + 3 * TTF_FWORD_SIZE +
+             8 * TTF_SHORT_SIZE);
+    nhmtx = get_ushort();
+    ttf_seek_tab("hmtx", 0);
+    for (pm = mtx_tab; pm - mtx_tab < nhmtx; pm++) {
+        pm->wx = get_ufword();
+        ttf_skip(TTF_FWORD_SIZE);
+    }
+    i = pm[-1].wx;
+    for (; pm - mtx_tab < nglyphs; pm++)
+        pm->wx = i;
+    ttf_seek_tab("post", 0);
+    post_format = get_fixed();
+    ItalicAngle = get_fixed();
+    UnderlinePosition = get_fword();
+    UnderlineThickness = get_fword();
+    IsFixedPitch = get_ulong();
+    ttf_skip(4 * TTF_ULONG_SIZE);
+    switch (post_format) {
+    case 0x00010000:
+        for (pm = mtx_tab; pm - mtx_tab < NMACGLYPHS; pm++)
+            pm->name = (char *) mac_glyph_names[pm - mtx_tab];
+        break;
+    case 0x00020000:
+        l = get_ushort();       /* some fonts have this value different from nglyphs */
+        for (pm = mtx_tab; pm - mtx_tab < l; pm++)
+            pm->index = get_ushort();
+        if ((pd = name_lookup("post")) == NULL)
+            ttf_fail("can't find table `post'");
+        n = pd->length - (xftell(fontfile, cur_file_name) - pd->offset);
+        ps_glyphs_buf = xtalloc(n + 1, char);
+        for (m = 0, p = ps_glyphs_buf; p - ps_glyphs_buf < n;) {
+            for (i = get_byte(); i > 0; i--)
+                *p++ = get_char();
+            *p++ = 0;
+            m++;
+        }
+        for (pm = mtx_tab; pm - mtx_tab < l; pm++) {
+            if (pm->index < NMACGLYPHS)
+                pm->name = (char *) mac_glyph_names[pm->index];
+            else {
+                k = pm->index - NMACGLYPHS;
+                if (k < m) {
+                    for (p = ps_glyphs_buf; k > 0; k--)
+                        p = (char *) strend(p) + 1;
+                    pm->name = p;
+                } else {
+                    pm->name = NULL;    /* index out of valid range, fix name to notdef */
+                }
+            }
+        }
+        break;
+    case 0x00030000:
+        if (print_glyph == AS_NAME) {
+            ttf_warn
+                ("no names available in `post' table, print glyph names as indices");
+            print_glyph = AS_INDEX;
+        }
+        break;
+    default:
+        ttf_fail("unsupported format (%.8X) of `post' table", post_format);
+    }
+    ttf_seek_tab("loca", 0);
+    for (pm = mtx_tab; pm - mtx_tab < nglyphs + 1; pm++)
+        pm->offset = (loca_format == 1 ? get_ulong() : get_ushort() << 1);
+    if ((pd = name_lookup("glyf")) == NULL)
+        ttf_fail("can't find table `glyf'");
+    for (n = pd->offset, pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+        ttf_seek_off("glyf", n + pm->offset);
+        ttf_skip(TTF_SHORT_SIZE);
+        pm->bbox[0] = get_fword();
+        pm->bbox[1] = get_fword();
+        pm->bbox[2] = get_fword();
+        pm->bbox[3] = get_fword();
+    }
+
+    ttf_seek_tab("name", 0);
+    i = ftell(fontfile);
+    (void) get_ushort();        /* skip Format selector (=0) */
+    n = get_ushort();           /* number of name records */
+    j = get_ushort() + i;       /* start of string storage */
+    i += 3 * TTF_USHORT_SIZE;   /* update the current offset */
+    while (n-- > 0) {
+        ttf_seek_off("name", i);
+        platform_id = get_ushort();
+        encoding_id = get_ushort();
+        (void) get_ushort();    /* skip language_id */
+        k = get_ushort();       /* name_id */
+        l = get_ushort();       /* string length */
+        if ((platform_id == 1 && encoding_id == 0) &&
+            (k == 0 || k == 1 || k == 4 || k == 5 || k == 6)) {
+            ttf_seek_off("name", j + get_ushort());
+            for (p = buf; l-- > 0; p++)
+                *p = get_char();
+            *p++ = 0;
+            p = xstrdup(buf);
+            switch (k) {
+            case 0:
+                Notice = p;
+                break;
+            case 1:
+                FamilyName = p;
+                break;
+            case 4:
+                FullName = p;
+                break;
+            case 5:
+                Version = p;
+                break;
+            case 6:
+                FontName = p;
+                break;
+            }
+            if (Notice != NULL && FamilyName != NULL &&
+                FullName != NULL && FontName != NULL && Version != NULL)
+                break;
+        }
+        i += 6 * TTF_USHORT_SIZE;
+    }
+    if ((pd = name_lookup("PCLT")) != NULL) {
+        ttf_seek_off("PCLT",
+                     pd->offset + TTF_FIXED_SIZE + TTF_ULONG_SIZE +
+                     TTF_USHORT_SIZE);
+        XHeight = get_ushort();
+        if (XHeight > FontBBox4) {
+            ttf_warn("XHeight is too big (%i)\n"
+                     "This is likely a font bug, so I discarded this parameter.",
+                     (int) get_ttf_funit(XHeight));
+            XHeight = 0;
+        }
+        ttf_skip(2 * TTF_USHORT_SIZE);
+        CapHeight = get_ushort();
+        if (CapHeight > FontBBox4) {
+            ttf_warn("CapHeight is too big (%i)\n"
+                     "This is likely a font bug, so I discarded this parameter.",
+                     (int) get_ttf_funit(CapHeight));
+            CapHeight = 0;
+        }
+    }
+    if ((pd = name_lookup("OS/2")) != NULL) {
+        ttf_seek_off("OS/2", pd->offset + TTF_USHORT_SIZE + TTF_SHORT_SIZE);
+        switch (get_ushort()) {
+        case 100:
+            Weight = xstrdup("Thin");
+            break;
+        case 200:
+            Weight = xstrdup("ExtraLight");
+            break;
+        case 300:
+            Weight = xstrdup("Light");
+            break;
+        case 400:
+            Weight = xstrdup("Normal");
+            break;
+        case 500:
+            Weight = xstrdup("Medium");
+            break;
+        case 600:
+            Weight = xstrdup("SemiBold");
+            break;
+        case 700:
+            Weight = xstrdup("Bold");
+            break;
+        case 800:
+            Weight = xstrdup("ExtraBold");
+            break;
+        case 900:
+            Weight = xstrdup("Black");
+            break;
+        }
+    }
+    read_cmap();
+    if ((pd = name_lookup("kern")) == NULL)
+        return;
+    kern_tab = xtalloc(nglyphs, kern_entry);
+    for (pk = kern_tab; pk - kern_tab < nglyphs; pk++) {
+        pk->next = NULL;
+        pk->value = 0;
+    }
+    ttf_seek_off("kern", pd->offset + TTF_USHORT_SIZE);
+    for (n = get_ushort(); n > 0; n--) {
+        ttf_skip(2 * TTF_USHORT_SIZE);
+        k = get_ushort();
+        if (!(k & 1) || (k & 2) || (k & 4))
+            return;
+        if (k >> 8 != 0) {
+            ttf_warn("warning: only format 0 supported of `kern' \
+                 subtables, others are ignored\n");
+            continue;
+        }
+        k = get_ushort();
+        ttf_skip(3 * TTF_USHORT_SIZE);
+        while (k-- > 0) {
+            i = get_ushort();
+            j = get_ushort();
+            kern_value = get_fword();
+            if (kern_value != 0) {
+                store_kern_value(i, j, kern_value);
+                nkernpairs++;
+            }
+        }
+    }
+}
+
+int null_glyph(const char *s)
+{
+    return (s == NULL || s == notdef);
+    /*
+       strcmp(s, ".null") == 0 ||
+       strcmp(s, ".notdef") == 0 ||
+       strcmp(s, "CR") == 0 ||
+       strcmp(s, "nonmarkingreturn") == 0
+     */
+}
+
+void print_glyph_name(FILE * f, long glyph_index, int convention)
+{
+    unicode_entry *u;
+    static char buf[1024];
+    const char *n;
+    assert(glyph_index >= 0 && glyph_index < nglyphs);
+    n = mtx_tab[glyph_index].name;
+    if (printing_enc && (n == notdef || glyph_index == 0)) {
+        fputs(notdef, f);
+        return;
+    }
+    switch (convention) {
+    case AS_NAME:
+        if (!null_glyph(n))
+            fprintf(f, "%s", mtx_tab[glyph_index].name);
+        else if (n == notdef && glyph_index == 0)
+            fputs(notdef, f);
+        else
+            fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+        break;
+    case AS_INDEX:
+        fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+        break;
+    case AS_UNICODE:
+        u = mtx_tab[glyph_index].unicode_list;
+        if (glyph_index == 0 || u == NULL)
+            fprintf(f, "%s%li", GLYPH_PREFIX_INDEX, glyph_index);
+        else {
+            fprintf(f, "%s%.4X", GLYPH_PREFIX_UNICODE, u->code);
+            if (u->next != NULL) {
+                *buf = 0;
+                for (; u != NULL; u = u->next) {
+                    assert(strlen(buf) + strlen(GLYPH_PREFIX_UNICODE) + 4 <
+                           sizeof(buf));
+                    sprintf(strend(buf), "%s%.4X ", GLYPH_PREFIX_UNICODE,
+                            u->code);
+                }
+                ttf_warn
+                    ("glyph %li have multiple encodings (the first one being used): %s",
+                     glyph_index, buf);
+            }
+        }
+        break;
+    }
+}
+
+void print_char_metric(FILE * f, int charcode, long glyph_index)
+{
+    assert(glyph_index >= 0 && glyph_index < nglyphs);
+    fprintf(f, "C %i ; WX %i ; N ", (int) charcode,
+            (int) get_ttf_funit(mtx_tab[glyph_index].wx));
+    print_glyph_name(f, glyph_index, print_glyph);
+    fprintf(f, " ; B %i %i %i %i ;\n",
+            (int) get_ttf_funit(mtx_tab[glyph_index].bbox[0]),
+            (int) get_ttf_funit(mtx_tab[glyph_index].bbox[1]),
+            (int) get_ttf_funit(mtx_tab[glyph_index].bbox[2]),
+            (int) get_ttf_funit(mtx_tab[glyph_index].bbox[3]));
+}
+
+void print_afm(char *date, char *fontname)
+{
+    int ncharmetrics;
+    mtx_entry *pm;
+    short mtx_index[256], *idx;
+    unsigned int index;
+    char **pe;
+    kern_entry *pk, *qk;
+    fputs("StartFontMetrics 2.0\n", outfile);
+    fprintf(outfile,
+            "Comment Converted at %s by ttf2afm from font file `%s'\n", date,
+            fontname);
+    print_str(FontName);
+    print_str(FullName);
+    print_str(FamilyName);
+    print_str(Weight);
+    fprintf(outfile, "ItalicAngle %i", (int) (ItalicAngle / 0x10000));
+    if (ItalicAngle % 0x10000 > 0)
+        fprintf(outfile, ".%i",
+                (int) ((ItalicAngle % 0x10000) * 1000) / 0x10000);
+    fputs("\n", outfile);
+    fprintf(outfile, "IsFixedPitch %s\n", IsFixedPitch ? "true" : "false");
+    fprintf(outfile, "FontBBox %i %i %i %i\n",
+            (int) get_ttf_funit(FontBBox1),
+            (int) get_ttf_funit(FontBBox2),
+            (int) get_ttf_funit(FontBBox3), (int) get_ttf_funit(FontBBox4));
+    print_dimen(UnderlinePosition);
+    print_dimen(UnderlineThickness);
+    print_str(Version);
+    print_str(Notice);
+    fputs("EncodingScheme FontSpecific\n", outfile);
+    print_dimen(CapHeight);
+    print_dimen(XHeight);
+    print_dimen(Ascender);
+    print_dimen(Descender);
+    ncharmetrics = nglyphs;
+    if (use_ext_enc == 0) {     /* external encoding vector not given */
+        fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
+        for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+            pm->found = 1;
+            print_char_metric(outfile, -1, pm - mtx_tab);
+        }
+    } else {                    /* external encoding vector given */
+        for (idx = mtx_index; idx - mtx_index < 256; *idx++ = 0);
+        for (pe = enc_names; pe - enc_names < names_count; pe++) {
+            if (*pe == notdef)
+                continue;
+            /* scan form `uniABCD' */
+            if (sscanf(*pe, GLYPH_PREFIX_UNICODE "%4X", &index) == 1) {
+                if (unicode_map[index] != NOGLYPH_ASSIGNED_YET) {
+                    pm = mtx_tab + unicode_map[index];
+                    mtx_index[pe - enc_names] = pm - mtx_tab;
+                    pm->found = 1;
+                } else
+                    ttf_warn("`unicode %s%.4X' is not mapped to any glyph",
+                             GLYPH_PREFIX_UNICODE, index);
+                continue;
+            }
+            /* scan form `index123' */
+            if (sscanf(*pe, GLYPH_PREFIX_INDEX "%u", &index) == 1) {
+                if (index >= nglyphs)
+                    ttf_fail("`%s' out of valid range [0..%i)", *pe, nglyphs);
+                pm = mtx_tab + index;
+                mtx_index[pe - enc_names] = pm - mtx_tab;
+                pm->found = 1;
+                continue;
+            }
+            for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++)
+                if (pm->name != NULL && strcmp(*pe, pm->name) == 0)
+                    break;
+            if (pm - mtx_tab < nglyphs) {
+                mtx_index[pe - enc_names] = pm - mtx_tab;
+                pm->found = 1;
+                continue;
+            } else
+                ttf_warn("glyph `%s' not found", *pe);
+        }
+        fprintf(outfile, "StartCharMetrics %u\n", ncharmetrics);
+        for (idx = mtx_index; idx - mtx_index < 256; idx++) {
+            if (*idx != 0 && mtx_tab[*idx].found == 1)
+                print_char_metric(outfile, idx - mtx_index, *idx);
+        }
+        for (pm = mtx_tab; pm - mtx_tab < nglyphs; pm++) {
+            if (pm->found == 0)
+                print_char_metric(outfile, -1, pm - mtx_tab);
+        }
+    }
+    fputs("EndCharMetrics\n", outfile);
+    if (nkernpairs == 0)
+        goto end_kerns;
+    fprintf(outfile, "StartKernData\nStartKernPairs %i\n", nkernpairs);
+    for (pk = kern_tab; pk - kern_tab < nglyphs; pk++)
+        for (qk = pk; qk != NULL; qk = qk->next)
+            if (qk->value != 0) {
+                fputs("KPX ", outfile);
+                print_glyph_name(outfile, pk - kern_tab, print_glyph);
+                fputs(" ", outfile);
+                print_glyph_name(outfile, qk->adjacent, print_glyph);
+                fprintf(outfile, " %i\n", get_ttf_funit(qk->value));
+            }
+    fputs("EndKernPairs\nEndKernData\n", outfile);
+  end_kerns:
+    fputs("EndFontMetrics\n", outfile);
+}
+
+void print_encoding(char *fontname)
+{
+    long int i, k, first_code, length;
+    FILE *file;
+    TTF_USHORT format;
+    char *enc_name, *end_enc_name;
+    cmap_entry *e;
+    printing_enc = 1;
+    enc_name = xtalloc(strlen(bname) + 20, char);
+    strcpy(enc_name, bname);
+    end_enc_name = strend(enc_name);
+    for (e = cmap_tab; e - cmap_tab < ncmapsubtabs; e++) {
+        ttf_seek_off("cmap", cmap_offset + e->offset);
+        format = get_ushort();
+        if (format != 0 && format != 4 && format != 6) {
+            ttf_warn("format %i of encoding subtable unsupported",
+                     (int) format);
+            continue;
+        }
+        sprintf(end_enc_name, ".e%i%i",
+                (int) e->platform_id, (int) e->encoding_id);
+        if ((file = xfopen(enc_name, FOPEN_W_MODE)) == NULL)
+            ttf_fail("cannot open file for writing (%s)\n", enc_name);
+        fprintf(file, "%% Encoding table from font file %s\n", fontname);
+        fprintf(file, "%% Platform ID %i", (int) e->platform_id);
+        switch (e->platform_id) {
+        case 0:
+            fprintf(file, " (Apple Unicode)");
+            break;
+        case 1:
+            fprintf(file, " (Macintosh)");
+            break;
+        case 2:
+            fprintf(file, " (ISO)");
+            break;
+        case 3:
+            fprintf(file, " (Microsoft)");
+            break;
+        }
+        fprintf(file, "\n");
+        fprintf(file, "%% Encoding ID %i", (int) e->encoding_id);
+        if (e->platform_id == 1 && e->encoding_id == 0)
+            fprintf(file, " (Roman)");
+        if (e->platform_id == 3)
+            switch (e->encoding_id) {
+            case 0:
+                fprintf(file, " (Symbol)");
+                break;
+            case 1:
+                fprintf(file, " (Unicode)");
+                break;
+            }
+        fprintf(file, "\n");
+        fprintf(file, "%% Format %i", (int) (format));
+        switch (format) {
+        case 0:
+            fprintf(file, " (byte encoding table)");
+            break;
+        case 4:
+            fprintf(file, " (segment mapping to delta values)");
+            break;
+        case 6:
+            fprintf(file, " (trimmed table mapping)");
+            break;
+        }
+        fprintf(file, "\n");
+        fprintf(file, "/Encoding%i [\n", (int) (e - cmap_tab + 1));
+        switch (format) {
+        case 0:
+            (void) get_ushort();        /* skip length */
+            (void) get_ushort();        /* skip version number */
+            for (i = 0; i < 256; i++) {
+                fputs("/", file);
+                print_glyph_name(file, get_byte(), print_glyph);
+                fputs("\n", file);
+            }
+            break;
+        case 4:
+            for (i = 0; i < nglyphs; ++i) {
+                fprintf(file, "%% Glyph %li -> ", i);
+                print_glyph_name(file, i, AS_UNICODE);
+                fputs("\n", file);
+            }
+            break;
+        case 6:
+            (void) get_ushort();        /* skip table length */
+            (void) get_ushort();        /* skip version number */
+            first_code = get_ushort();  /* first character code */
+            for (i = 0; i < first_code; ++i)
+                fprintf(file, "/%s\n", notdef);
+            length = get_ushort();      /* number of character codes */
+            for (i = first_code; i < first_code + length; i++) {
+                k = get_ushort();
+                if (i > 255)
+                    fputs("% ", file);
+                fputs("/", file);
+                print_glyph_name(file, k, print_glyph);
+                fputs("\n", file);
+            }
+            for (i = first_code + length; i < 256; i++)
+                fprintf(file, "/%s\n", notdef);
+            break;
+        default:
+            ttf_warn("format %i of encoding subtable unsupported",
+                     (int) format);
+        }
+        fprintf(file, "] def\n");
+    }
+    xfree(enc_name);
+}
+
+void usage()
+{
+    cur_file_name = NULL;
+    fprintf(stderr,
+            "Usage: ttf2afm [-i|-u|-c|-v] [-e enc] [-o filename] [-m NUM] fontfile\n"
+            "    -i:          force printing glyph names in form 'index123'\n"
+            "    -u:          force printing glyph names in form 'uniABCD'\n"
+            "    -c:          print encoding tables to `basename.e<platformID><encodingID>'\n"
+            "    -v:          print version\n"
+            "    -e enc:      encode the AFM output using encoding vector from `enc'\n"
+            "    -o filename: write output to file `filename' instead of stdout\n"
+            "    -m NUM:      select unicode mapping (default = 1, ie the first)\n"
+            "    fontfile:    the TrueType fontfile\n"
+            "\nPlease send bug reports or feature requests to <pdftex@tug.org>\n");
+    _exit(-1);
+}
+
+int main(int argc, char **argv)
+{
+    char date[128], *s;
+    time_t t = time(&t);
+    int c;
+    kpse_set_progname(argv[0]);
+    kpse_init_prog("ttf2afm", 0, 0, 0);
+    while ((c = getopt(argc, argv, "iucve:o:m:")) != -1)
+        switch (c) {
+        case 'i':
+            print_glyph = AS_INDEX;
+            break;
+        case 'u':
+            print_glyph = AS_UNICODE;
+            break;
+        case 'c':
+            print_cmap = 1;
+            break;
+        case 'e':
+            cur_file_name = optarg;
+            read_encoding(cur_file_name);
+            use_ext_enc = 1;
+            break;
+        case 'o':
+            cur_file_name = optarg;
+            outfile = xfopen(cur_file_name, FOPEN_W_MODE);
+            if (outfile == NULL)
+                ttf_fail("cannot open file for writing");
+            break;
+        case 'm':
+            select_unicode = atoi(optarg);
+            break;
+        case 'v':
+            fprintf(stderr,
+                    "ttf2afm version " VERSION "\n"
+                    "Copyright (C) 1997-2005 Han The Thanh.\n"
+                    "There is NO warranty.  Redistribution of this software is\n"
+                    "covered by the terms of both the pdfTeX copyright and\n"
+                    "the GNU General Public License.\n"
+                    "For more information about these matters, see the files\n"
+                    "named COPYING and the pdfTeX source.\n"
+                    "Primary author of ttf2afm: Han The Thanh.\n");
+            _exit(0);
+        default:
+            usage();
+        }
+    if (argc - optind != 1)
+        usage();
+    sprintf(date, "%s\n", ctime(&t));
+    *(char *) strchr(date, '\n') = 0;
+    cur_file_name = argv[optind];
+    if (print_cmap) {
+        bname = xstrdup(xbasename(cur_file_name));
+        if ((s = strrchr(bname, '.')) != NULL)
+            *s = 0;
+    }
+    if ((fontfile =
+         kpse_open_file(cur_file_name, kpse_truetype_format)) == NULL)
+        ttf_fail("can't open font file for reading");
+    read_font();
+    if (outfile == NULL)
+        outfile = stdout;
+    print_afm(date, cur_file_name);
+    if (print_cmap)
+        print_encoding(cur_file_name);
+    xfree(FontName);
+    xfree(FullName);
+    xfree(FamilyName);
+    xfree(Notice);
+    xfree(Version);
+    xfree(Weight);
+    free_tabs();
+    xfclose(fontfile, cur_file_name);
+    return 0;
+}
diff --git a/Build/source/texk/web2c/luatexdir/ttf2afm.rc b/Build/source/texk/web2c/luatexdir/ttf2afm.rc
new file mode 100644
index 00000000000..a63881df7d1
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/ttf2afm.rc
@@ -0,0 +1,35 @@
+/* ttf2afm.rc: ttf2afm				-*- C++ -*-
+
+   Copyright (C) 1996-2003 Fabrice Popineau <fabrice.popineau@supelec.fr>
+
+   This file 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, or (at your
+   option) any later version.
+
+   This file 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 file; if not, write to the Free Software
+   Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+   USA. */
+
+#include <texlive-version.h>
+
+#define VER_FILEVERSION TEXLIVE_MAJOR_VERSION,TEXLIVE_MINOR_VERSION,TEXLIVE_BETA_NUMBER,TEXLIVE_ALPHA_NUMBER
+#define VER_FILEVERSION_STR TEXLIVE_PRODUCTVERSION_STR " ttf2afm 1.10a"
+
+#define VER_INTERNALNAME_STR "ttf2afm"
+#define VER_ORIGINALFILENAME_STR "ttf2afm.exe"
+
+#define VER_FILEDESCRIPTION_STR "TTF-to-AFM Converter"
+
+#define VER_COMPANYNAME_STR         ""
+#define VER_LEGALCOPYRIGHT_STR      "Copyright (c) 1996-2002 Han The Thanh, <thanh@pdftex.org>"
+
+#include "texlive.version"
+
+/* ttf2afm.rc ends here */
diff --git a/Build/source/texk/web2c/luatexdir/utils.c b/Build/source/texk/web2c/luatexdir/utils.c
new file mode 100644
index 00000000000..707ac7855f9
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/utils.c
@@ -0,0 +1,1798 @@
+/*
+Copyright (c) 1996-2006 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id$
+*/
+
+#include "sys/types.h"
+#ifndef __MINGW32__
+#include "sysexits.h"
+#else
+#define EX_SOFTWARE 70
+#endif
+#include "md5.h"
+#include <kpathsea/c-proto.h>
+#include <kpathsea/c-stat.h>
+#include <kpathsea/c-fopen.h>
+#include <string.h>
+#include <time.h>
+#include <float.h>              /* for DBL_EPSILON */
+#include "zlib.h"
+#include "ptexlib.h"
+
+#include "svnversion.h"
+
+#include "openbsd-compat.h"
+#include "png.h"
+#include "xpdf/config.h"        /* just to get the xpdf version */
+
+#define check_nprintf(size_get, size_want) \
+    if ((unsigned)(size_get) >= (unsigned)(size_want)) \
+        pdftex_fail ("snprintf failed: file %s, line %d", __FILE__, __LINE__);
+
+char *cur_file_name = NULL;
+strnumber last_tex_string;
+static char print_buf[PRINTF_BUF_SIZE];
+static char *jobname_cstr = NULL;
+static char *job_id_string = NULL;
+extern string ptexbanner;       /* from web2c/lib/texmfmp.c */
+extern string versionstring;    /* from web2c/lib/version.c */
+extern KPSEDLL string kpathsea_version_string;  /* from kpathsea/version.c */
+
+size_t last_ptr_index;          /* for use with alloc_array */
+
+/* define fb_ptr, fb_array & fb_limit */
+typedef char fb_entry;
+define_array (fb);
+
+/* define char_ptr, char_array & char_limit */
+typedef char char_entry;
+define_array (char);
+
+integer fb_offset (void)
+{
+    return fb_ptr - fb_array;
+}
+
+void fb_seek (integer offset)
+{
+    fb_ptr = fb_array + offset;
+}
+
+void fb_putchar (eight_bits b)
+{
+    alloc_array (fb, 1, SMALL_ARRAY_SIZE);
+    *fb_ptr++ = b;
+}
+
+void fb_flush (void)
+{
+    fb_entry *p;
+    integer n;
+    for (p = fb_array; p < fb_ptr;) {
+        n = pdf_buf_size - pdf_ptr;
+        if (fb_ptr - p < n)
+            n = fb_ptr - p;
+        memcpy (pdf_buf + pdf_ptr, p, (unsigned) n);
+        pdf_ptr += n;
+        if (pdf_ptr == pdf_buf_size)
+            pdf_flush ();
+        p += n;
+    }
+    fb_ptr = fb_array;
+}
+
+#define SUBSET_TAG_LENGTH 6
+void make_subset_tag(fd_entry * fd)
+{
+    int i, j = 0, a[SUBSET_TAG_LENGTH];
+    md5_state_t pms;
+    char *glyph;
+	glw_entry *glw_glyph;
+    struct avl_traverser t;
+    md5_byte_t digest[16];
+    void **aa;
+    static struct avl_table *st_tree = NULL;
+    if (st_tree == NULL)
+        st_tree = avl_create(comp_string_entry, NULL, &avl_xallocator);
+    assert(fd != NULL);
+    assert(fd->gl_tree != NULL);
+    assert(fd->fontname != NULL);
+    assert(fd->subset_tag == NULL);
+    fd->subset_tag = xtalloc(SUBSET_TAG_LENGTH + 1, char);
+    do {
+        md5_init(&pms);
+        avl_t_init(&t, fd->gl_tree);
+		if (is_cidkeyed(fd->fm)) { /* glw_entry items */
+		  for (glw_glyph = (glw_entry *) avl_t_first(&t, fd->gl_tree); glw_glyph != NULL;
+			   glw_glyph = (glw_entry *) avl_t_next(&t)) {
+			glyph = malloc(12);
+			sprintf(glyph,"%05u%05u ",glw_glyph->id,glw_glyph->wd);
+            md5_append(&pms, (md5_byte_t *) glyph, strlen(glyph));
+			free(glyph);
+		  }
+		} else {
+		  for (glyph = (char *) avl_t_first(&t, fd->gl_tree); glyph != NULL;
+			   glyph = (char *) avl_t_next(&t)) {
+            md5_append(&pms, (md5_byte_t *) glyph, strlen(glyph));
+            md5_append(&pms, (md5_byte_t *) " ", 1);
+		  }
+		}
+        md5_append(&pms, (md5_byte_t *) fd->fontname, strlen(fd->fontname));
+        md5_append(&pms, (md5_byte_t *) & j, sizeof(int));      /* to resolve collision */
+        md5_finish(&pms, digest);
+        for (a[0] = 0, i = 0; i < 13; i++)
+            a[0] += digest[i];
+        for (i = 1; i < SUBSET_TAG_LENGTH; i++)
+            a[i] = a[i - 1] - digest[i - 1] + digest[(i + 12) % 16];
+        for (i = 0; i < SUBSET_TAG_LENGTH; i++)
+            fd->subset_tag[i] = a[i] % 26 + 'A';
+        fd->subset_tag[SUBSET_TAG_LENGTH] = '\0';
+        j++;
+        assert(j < 100);
+    }
+    while ((char *) avl_find(st_tree, fd->subset_tag) != NULL);
+    aa = avl_probe(st_tree, fd->subset_tag);
+    assert(aa != NULL);
+    if (j > 2)
+        pdftex_warn
+            ("\nmake_subset_tag(): subset-tag collision, resolved in round %d.\n",
+             j);
+}
+
+void pdf_puts (const char *s)
+{
+    pdfroom (strlen (s) + 1);
+    while (*s)
+        pdf_buf[pdf_ptr++] = *s++;
+}
+
+__attribute__ ((format (printf, 1, 2))) 
+void pdf_printf (const char *fmt, ...)
+{
+    va_list args;
+    va_start (args, fmt);
+    vsnprintf (print_buf, PRINTF_BUF_SIZE, fmt, args);
+    pdf_puts (print_buf);
+    va_end (args);
+}
+
+strnumber maketexstring (const char *s)
+{
+  if (s == NULL || *s == 0)
+    return get_nullstr ();
+  return maketexlstring(s,strlen(s));
+}
+
+strnumber maketexlstring (const char *s, size_t l) 
+{
+    if (s == NULL || l == 0)
+      return get_nullstr ();
+    check_pool_overflow (pool_ptr + l);
+    while (l-- > 0)
+        str_pool[pool_ptr++] = *s++;
+    last_tex_string = make_string ();
+    return last_tex_string;
+}
+
+
+/* print a C string through TeX */
+void 
+print_string (char *j) {
+  while (*j) {
+    print_char(*j);
+	j++;
+  }
+}
+
+/* append a C string to a TeX string */
+void 
+append_string (char *s) {
+  if (s == NULL || *s == 0)
+	return;
+  check_buf (pool_ptr + strlen(s), pool_size);
+  while (*s)
+	str_pool[pool_ptr++] = *s++;
+  return;
+}
+
+__attribute__ ((format (printf, 1, 2)))
+void tex_printf (const char *fmt, ...) 
+{
+    va_list args;
+    va_start (args, fmt);
+    vsnprintf (print_buf, PRINTF_BUF_SIZE, fmt, args);
+    print_string (print_buf);
+    xfflush (stdout);
+    va_end (args);
+}
+
+/* Helper for pdftex_fail. */
+static void safe_print (const char *str)
+{
+    const char *c;
+    for (c = str; *c; ++c)
+        print (*c);
+}
+
+void remove_pdffile (void)
+{
+    if (!kpathsea_debug && output_file_name && !fixed_pdf_draftmode) {
+        xfclose (pdf_file, makecstring (output_file_name));
+        remove (makecstring (output_file_name));
+    }
+}
+
+/* pdftex_fail may be called when a buffer overflow has happened/is
+   happening, therefore may not call mktexstring.  However, with the
+   current implementation it appears that error messages are misleading,
+   possibly because pool overflows are detected too late. 
+
+   The output format of this fuction must be the same as pdf_error in
+   pdftex.web! */
+
+__attribute__ ((noreturn, format (printf, 1, 2)))
+void pdftex_fail (const char *fmt, ...)
+{
+    va_list args;
+    va_start (args, fmt);
+    print_ln ();
+    safe_print ("!luaTeX error");
+    if (cur_file_name) {
+        safe_print (" (file ");
+        safe_print (cur_file_name);
+        safe_print (")");
+    }
+    safe_print (": ");
+    vsnprintf (print_buf, PRINTF_BUF_SIZE, fmt, args);
+    safe_print (print_buf);
+    va_end (args);
+    print_ln ();
+    remove_pdffile();
+    safe_print (" ==> Fatal error occurred, no output PDF file produced!");
+    print_ln ();
+    if (kpathsea_debug) {
+        abort ();
+    } else {
+        exit (EX_SOFTWARE);
+    }
+}
+
+/* The output format of this fuction must be the same as pdf_warn in
+   pdftex.web! */
+
+__attribute__ ((format (printf, 1, 2)))
+void pdftex_warn (const char *fmt, ...) 
+{
+    va_list args;
+    va_start (args, fmt);
+    print_ln ();
+    tex_printf ("luaTeX warning");
+    if (cur_file_name)
+        tex_printf (" (file %s)", cur_file_name);
+    tex_printf (": ");
+    vsnprintf (print_buf, PRINTF_BUF_SIZE, fmt, args);
+    print_string (print_buf);
+    va_end (args);
+    print_ln ();
+}
+
+
+void tex_error(char *msg, char **hlp) {
+  strnumber aa = 0,bb = 0,cc = 0,dd = 0,ee = 0;
+  int k = 0;
+  while (hlp[k]!=NULL)
+    k++;
+  if (k>0)    aa =maketexstring(hlp[0]);
+  if (k>1)    bb =maketexstring(hlp[1]);
+  if (k>2)    cc =maketexstring(hlp[2]);
+  if (k>3)    dd =maketexstring(hlp[3]);
+  if (k>4)    ee =maketexstring(hlp[4]);
+
+  do_print_err(maketexstring(msg)); 
+  flush_str(last_tex_string);
+
+  switch (k) {
+  case 1:   dohelp1(aa); break;
+  case 2:   dohelp2(aa,bb); break;
+  case 3:   dohelp3(aa,bb,cc); break;
+  case 4:   dohelp4(aa,bb,cc,dd); break;
+  case 5:   dohelp5(aa,bb,cc,dd,ee); break;
+  }
+  error();
+
+  if (ee)    flush_str(ee);
+  if (dd)    flush_str(dd);
+  if (cc)    flush_str(cc);
+  if (bb)    flush_str(bb);
+  if (aa)    flush_str(aa);
+}
+
+
+void garbage_warning (void)
+{
+    pdftex_warn ("dangling objects discarded, no output file produced.");
+    remove_pdffile ();
+}
+
+char *makecstring (integer s) {
+  int l;
+  return makeclstring(s,&l);
+}
+
+
+char *makeclstring (integer s, int *len)
+{
+    static char *cstrbuf = NULL;
+    char *p;
+    static int allocsize;
+    int allocgrow, i, l;
+    if (s >=2097152) {
+      s -= 2097152;
+      l = str_start[s + 1] - str_start[s];
+      *len = l;
+      check_buf (l + 1, MAX_CSTRING_LEN);
+      if (cstrbuf == NULL) {
+	allocsize = l + 1;
+	cstrbuf = xmallocarray (char, allocsize);
+      } else if (l + 1 > allocsize) {
+	allocgrow = allocsize * 0.2;
+        if (l + 1 - allocgrow > allocsize)
+	  allocsize = l + 1;
+        else if (allocsize < MAX_CSTRING_LEN - allocgrow)
+	  allocsize += allocgrow;
+        else
+	  allocsize = MAX_CSTRING_LEN;
+        cstrbuf = xreallocarray (cstrbuf, char, allocsize);
+      }
+      p = cstrbuf;
+      for (i = 0; i < l; i++)
+	*p++ = str_pool[i + str_start[s]];
+      *p = 0;
+    } else {
+      if (cstrbuf == NULL) {
+	allocsize = 5;
+	cstrbuf = xmallocarray (char, allocsize);
+      }
+	  if (s <= 0x7F) {
+		cstrbuf[0] = s;
+		cstrbuf[1] = 0;
+		*len = 1;
+	  } else if (s <= 0x7FF ) {
+		cstrbuf[0] = 0xC0 + (s / 0x40);
+		cstrbuf[1] = 0x80 + (s % 0x40);
+		cstrbuf[2] = 0;
+		*len = 2;
+	  } else if (s <= 0xFFFF ) {
+		cstrbuf[0] = 0xE0 + (s / 0x1000);
+		cstrbuf[1] = 0x80 + ((s % 0x1000) / 0x40);
+		cstrbuf[2] = 0x80 + ((s % 0x1000) % 0x40);
+		cstrbuf[3] = 0;
+		*len = 3;
+	  } else {
+	    if (s >= 0x10FF00) {
+		  cstrbuf[0] = s-0x10FF00;
+		  cstrbuf[1] = 0;
+		  *len = 1;
+		} else {
+		  cstrbuf[0] = 0xF0 + (s / 0x40000);
+		  cstrbuf[1] = 0x80 + ((s % 0x40000) / 0x1000);
+		  cstrbuf[2] = 0x80 + (((s % 0x40000) % 0x1000) / 0x40);
+		  cstrbuf[3] = 0x80 + (((s % 0x40000) % 0x1000) % 0x40);
+		  cstrbuf[4] = 0;
+		  *len = 4;
+		}
+	  }
+    }
+    return cstrbuf;
+}
+
+void set_job_id (int year, int month, int day, int time)
+{
+    char *name_string, *format_string, *s;
+    size_t slen;
+	int i;
+
+    if (job_id_string != NULL)
+        return;
+
+    name_string = xstrdup (makecstring (job_name));
+    format_string = xstrdup (makecstring (format_ident));
+    slen = SMALL_BUF_SIZE +
+        strlen (name_string) +
+        strlen (format_string) +
+        strlen (ptexbanner) +
+        strlen (versionstring) + strlen (kpathsea_version_string);
+    s = xtalloc (slen, char);
+    /* The Web2c version string starts with a space.  */
+    i = snprintf (s, slen,
+             "%.4d/%.2d/%.2d %.2d:%.2d %s %s %s%s %s",
+             year, month, day, time / 60, time % 60,
+             name_string, format_string, ptexbanner,
+             versionstring, kpathsea_version_string);
+	check_nprintf(i,slen);
+    job_id_string = xstrdup (s);
+    xfree (s);
+    xfree (name_string);
+    xfree (format_string);
+}
+
+int get_build_revision (void) {
+  int revision;
+  if(sscanf (BUILD_REVISION,"$Revision: %d $", &revision)) {
+	return revision;
+  }
+  return 0;
+}
+
+void make_pdftex_banner (void)
+{
+    static boolean pdftexbanner_init = false;
+    char *s;
+    size_t slen;
+	int i;
+
+    if (pdftexbanner_init)
+        return;
+
+    slen = SMALL_BUF_SIZE +
+        strlen (ptexbanner) +
+        strlen (versionstring) + strlen (kpathsea_version_string);
+    s = xtalloc (slen, char);
+    /* The Web2c version string starts with a space.  */
+    i = snprintf (s, slen,
+             "%s%s %s", ptexbanner, versionstring, kpathsea_version_string);
+	check_nprintf (i, slen);
+    pdftex_banner = maketexstring (s);
+    xfree (s);
+    pdftexbanner_init = true;
+}
+
+strnumber get_resname_prefix (void)
+{
+/*     static char name_str[] = */
+/* "!\"$&'*+,-.0123456789:;=?@ABCDEFGHIJKLMNOPQRSTUVWXYZ\\" */
+/* "^_`abcdefghijklmnopqrstuvwxyz|~"; */
+    static char name_str[] =
+        "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
+    char prefix[7];             /* make a tag of 6 chars long */
+    unsigned long crc;
+    short i;
+    size_t base = strlen (name_str);
+    crc = crc32 (0L, Z_NULL, 0);
+    crc = crc32 (crc, (Bytef *) job_id_string, strlen (job_id_string));
+    for (i = 0; i < 6; i++) {
+        prefix[i] = name_str[crc % base];
+        crc /= base;
+    }
+    prefix[6] = 0;
+    return maketexstring (prefix);
+}
+
+size_t xfwrite (void *ptr, size_t size, size_t nmemb, FILE * stream)
+{
+    if (fwrite (ptr, size, nmemb, stream) != nmemb)
+        pdftex_fail ("fwrite() failed");
+    return nmemb;
+}
+
+int xfflush (FILE * stream)
+{
+    if (fflush (stream) != 0)
+        pdftex_fail ("fflush() failed");
+    return 0;
+}
+
+int xgetc (FILE * stream)
+{
+    int c = getc (stream);
+    if (c < 0 && c != EOF)
+        pdftex_fail ("getc() failed");
+    return c;
+}
+
+int xputc (int c, FILE * stream)
+{
+    int i = putc (c, stream);
+    if (i < 0)
+        pdftex_fail ("putc() failed");
+    return i;
+}
+
+void write_stream_length (integer length, integer offset)
+{
+    if (jobname_cstr == NULL)
+        jobname_cstr = xstrdup (makecstring (job_name));
+	if (fixed_pdf_draftmode == 0) {
+	xfseek (pdf_file, offset, SEEK_SET, jobname_cstr);
+    fprintf (pdf_file, "%li", (long int) length);
+    xfseek (pdf_file, pdfoffset (), SEEK_SET, jobname_cstr);
+	}
+}
+
+scaled ext_xn_over_d (scaled x, scaled n, scaled d)
+{
+    double r = (((double) x) * ((double) n)) / ((double) d);
+    if (r > DBL_EPSILON)
+        r += 0.5;
+    else
+        r -= 0.5;
+    if (r >= (double) maxinteger || r <= -(double) maxinteger)
+        pdftex_warn ("arithmetic: number too big");
+    return (scaled) r;
+}
+
+void libpdffinish ()
+{
+    xfree (fb_array);
+    xfree (char_array);
+    xfree (job_id_string);
+    fm_free ();
+    t1_free ();
+    enc_free ();
+    epdf_free ();
+    ttf_free ();
+    sfd_free ();
+    glyph_unicode_free ();
+	zip_free ();
+}
+
+/* Converts any string given in in in an allowed PDF string which can be
+ * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
+ * control characters are octal encoded.
+ * This assumes that the string does not contain any already escaped
+ * characters!
+ */
+char *convertStringToPDFString (const char *in, int len)
+{
+    static char pstrbuf[MAX_PSTRING_LEN];
+    char *out = pstrbuf;
+    int i, j, k;
+    char buf[5];
+    j = 0;
+    for (i = 0; i < len; i++) {
+        check_buf (j + sizeof (buf), MAX_PSTRING_LEN);
+        if (((unsigned char) in[i] < '!') || ((unsigned char) in[i] > '~')) {
+            /* convert control characters into oct */
+            k = snprintf (buf, sizeof (buf),
+                     "\\%03o", (unsigned int) (unsigned char) in[i]);
+			check_nprintf (k, sizeof (buf));
+            out[j++] = buf[0];
+            out[j++] = buf[1];
+            out[j++] = buf[2];
+            out[j++] = buf[3];
+        } else if ((in[i] == '(') || (in[i] == ')')) {
+            /* escape paranthesis */
+            out[j++] = '\\';
+            out[j++] = in[i];
+        } else if (in[i] == '\\') {
+            /* escape backslash */
+            out[j++] = '\\';
+            out[j++] = '\\';
+        } else {
+            /* copy char :-) */
+            out[j++] = in[i];
+        }
+    }
+    out[j] = '\0';
+    return pstrbuf;
+}
+
+
+/* Converts any string given in in in an allowed PDF string which can be
+ * handled by printf et.al.: \ is escaped to \\, parenthesis are escaped and
+ * control characters are octal encoded.
+ * This assumes that the string does not contain any already escaped
+ * characters!
+ *
+ * See escapename for parameter description.
+ */
+void escapestring (poolpointer in)
+{
+    const poolpointer out = pool_ptr;
+    unsigned char ch;
+	int i;
+    while (in < out) {
+        if (pool_ptr + 4 >= pool_size) {
+            pool_ptr = pool_size;
+            /* error by str_toks that calls str_room(1) */
+            return;
+        }
+
+        ch = (unsigned char) str_pool[in++];
+
+        if ((ch < '!') || (ch > '~')) {
+            /* convert control characters into oct */
+            i = snprintf ((char *) &str_pool[pool_ptr], 5,
+                     "\\%.3o", (unsigned int) ch);
+			check_nprintf (i, 5);
+            pool_ptr += i;
+            continue;
+        }
+        if ((ch == '(') || (ch == ')') || (ch == '\\')) {
+            /* escape parenthesis and backslash */
+            str_pool[pool_ptr++] = '\\';
+        }
+        /* copy char :-) */
+        str_pool[pool_ptr++] = ch;
+    }
+}
+
+
+/* Convert any given string in a PDF name using escaping mechanism
+   of PDF 1.2. The result does not include the leading slash.
+   
+   PDF specification 1.6, section 3.2.6 "Name Objects" explains:
+   <blockquote>
+    Beginning with PDF 1.2, any character except null (character code 0) may
+    be included in a name by writing its 2-digit hexadecimal code, preceded
+    by the number sign character (#); see implementation notes 3 and 4 in
+    Appendix H. This syntax is required to represent any of the delimiter or
+    white-space characters or the number sign character itself; it is
+    recommended but not required for characters whose codes are outside the
+    range 33 (!) to 126 (~).
+   </blockquote>
+   The following table shows the conversion that are done by this
+   function:
+     code      result   reason
+     -----------------------------------
+     0         ignored  not allowed
+     1..32     escaped  must for white-space:
+                          9 (tab), 10 (lf), 12 (ff), 13 (cr), 32 (space)
+                        recommended for the other control characters
+     35        escaped  escape char "#"
+     37        escaped  delimiter "%"
+     40..41    escaped  delimiters "(" and ")"
+     47        escaped  delimiter "/"
+     60        escaped  delimiter "<"
+     62        escaped  delimiter ">"
+     91        escaped  delimiter "["
+     93        escaped  delimiter "]"
+     123       escaped  delimiter "{"
+     125       escaped  delimiter "}"
+     127..255  escaped  recommended
+     else      copy     regular characters
+     
+   Parameter "in" is a pointer into the string pool where
+   the input string is located. The output string is written
+   as temporary string right after the input string.
+   Thus at the begin of the procedure the global variable
+   "pool_ptr" points to the start of the output string and
+   after the end when the procedure returns.
+*/
+void escapename (poolpointer in)
+{
+    const poolpointer out = pool_ptr;
+    unsigned char ch;
+	int i;
+
+    while (in < out) {
+        if (pool_ptr + 3 >= pool_size) {
+            pool_ptr = pool_size;
+            /* error by str_toks that calls str_room(1) */
+            return;
+        }
+
+        ch = (unsigned char) str_pool[in++];
+
+        if ((ch >= 1 && ch <= 32) || ch >= 127) {
+            /* escape */
+            i = snprintf ((char *) &str_pool[pool_ptr], 4,
+                     "#%.2X", (unsigned int) ch);
+			check_nprintf (i, 4);
+            pool_ptr += i;
+            continue;
+        }
+        switch (ch) {
+        case 0:
+            /* ignore */
+            break;
+        case 35:
+        case 37:
+        case 40:
+        case 41:
+        case 47:
+        case 60:
+        case 62:
+        case 91:
+        case 93:
+        case 123:
+        case 125:
+            /* escape */
+            i = snprintf ((char *) &str_pool[pool_ptr], 4,
+                     "#%.2X", (unsigned int) ch);
+			check_nprintf (i, 4);
+            pool_ptr += i;
+            break;
+        default:
+            /* copy */
+            str_pool[pool_ptr++] = ch;
+        }
+    }
+}
+
+/* Convert any given string in a PDF hexadecimal string. The
+   result does not include the angle brackets.
+   
+   This procedure uses uppercase hexadecimal letters.
+   
+   See escapename for description of parameters.
+*/
+void escapehex (poolpointer in)
+{
+    const poolpointer out = pool_ptr;
+    unsigned char ch;
+	int i;
+	
+    while (in < out) {
+        if (pool_ptr + 2 >= pool_size) {
+            pool_ptr = pool_size;
+            /* error by str_toks that calls str_room(1) */
+            return;
+        }
+
+        ch = (unsigned char) str_pool[in++];
+
+        i = snprintf ((char *) &str_pool[pool_ptr], 3,"%.2X", (unsigned int) ch);
+		check_nprintf (i, 3);
+        pool_ptr += 2;
+    }
+}
+
+/* Unescape any given hexadecimal string.
+
+   Last hex digit can be omitted, it is replaced by zero, see
+   PDF specification.
+   
+   Invalid digits are silently ignored.
+
+   See escapename for description of parameters.
+*/
+void unescapehex (poolpointer in)
+{
+    const poolpointer out = pool_ptr;
+    unsigned char ch;
+    boolean first = true;
+	unsigned char a = 0;        /* to avoid warning about uninitialized use of a */
+    while (in < out) {
+        if (pool_ptr + 1 >= pool_size) {
+            pool_ptr = pool_size;
+            /* error by str_toks that calls str_room(1) */
+            return;
+        }
+
+        ch = (unsigned char) str_pool[in++];
+
+        if ((ch >= '0') && (ch <= '9')) {
+            ch -= '0';
+        } else if ((ch >= 'A') && (ch <= 'F')) {
+            ch -= 'A' - 10;
+        } else if ((ch >= 'a') && (ch <= 'f')) {
+            ch -= 'a' - 10;
+        } else {
+            continue;           /* ignore wrong character */
+        }
+
+        if (first) {
+            a = ch << 4;
+            first = false;
+            continue;
+        }
+
+        str_pool[pool_ptr++] = a + ch;
+        first = true;
+    }
+    if (!first) {               /* last hex digit is omitted */
+        str_pool[pool_ptr++] = ch << 4;
+    }
+}
+
+
+/* Converts any string given in in in an allowed PDF string which is 
+ * hexadecimal encoded;
+ * sizeof(out) should be at least lin*2+1.
+ */
+static void convertStringToHexString (const char *in, char *out, int lin)
+{
+  int i, j, k;
+    char buf[3];
+    j = 0;
+    for (i = 0; i < lin; i++) {
+        k = snprintf (buf, sizeof (buf),
+                 "%02X", (unsigned int) (unsigned char) in[i]);
+		check_nprintf (k, sizeof (buf));
+        out[j++] = buf[0];
+        out[j++] = buf[1];
+    }
+    out[j] = '\0';
+}
+
+/* Compute the ID string as per PDF1.4 9.3:
+  <blockquote>
+    File identifers are defined by the optional ID entry in a PDF file's
+    trailer dictionary (see Section 3.4.4, "File Trailer"; see also
+    implementation note 105 in Appendix H). The value of this entry is an
+    array of two strings. The first string is a permanent identifier based
+    on the contents of the file at the time it was originally created, and
+    does not change when the file is incrementally updated. The second
+    string is a changing identifier based on the file's contents at the
+    time it was last updated. When a file is first written, both
+    identifiers are set to the same value. If both identifiers match when a
+    file reference is resolved, it is very likely that the correct file has
+    been found; if only the first identifier matches, then a different
+    version of the correct file has been found. 
+        To help ensure the uniqueness of file identifiers, it is recommend
+    that they be computed using a message digest algorithm such as MD5
+    (described in Internet RFC 1321, The MD5 Message-Digest Algorithm; see
+    the Bibliography), using the following information (see implementation
+    note 106 in Appendix H): 
+    - The current time 
+    - A string representation of the file's location, usually a pathname 
+    - The size of the file in bytes 
+    - The values of all entries in the file's document information
+      dictionary (see Section 9.2.1,  Document Information Dictionary )
+  </blockquote>
+  This stipulates only that the two IDs must be identical when the file is
+  created and that they should be reasonably unique. Since it's difficult
+  to get the file size at this point in the execution of pdfTeX and
+  scanning the info dict is also difficult, we start with a simpler
+  implementation using just the first two items.
+ */
+void print_ID (strnumber filename)
+{
+    time_t t;
+    size_t size;
+    char time_str[32];
+    md5_state_t state;
+    md5_byte_t digest[16];
+    char id[64];
+    char *file_name;
+    char pwd[4096];
+    /* start md5 */
+    md5_init (&state);
+    /* get the time */
+    t = time (NULL);
+    size =
+        strftime (time_str, sizeof (time_str), "%Y%m%dT%H%M%SZ", gmtime (&t));
+    md5_append (&state, (const md5_byte_t *) time_str, size);
+    /* get the file name */
+    if (getcwd (pwd, sizeof (pwd)) == NULL)
+        pdftex_fail ("getcwd() failed (path too long?)");
+    file_name = makecstring (filename);
+    md5_append (&state, (const md5_byte_t *) pwd, strlen (pwd));
+    md5_append (&state, (const md5_byte_t *) "/", 1);
+    md5_append (&state, (const md5_byte_t *) file_name, strlen (file_name));
+    /* finish md5 */
+    md5_finish (&state, digest);
+    /* write the IDs */
+    convertStringToHexString ((char *) digest, id, 16);
+    pdf_printf ("/ID [<%s> <%s>]", id, id);
+}
+
+/* Print the /CreationDate entry.
+
+  PDF Reference, third edition says about the expected date format:
+  <blockquote>
+    3.8.2 Dates
+
+      PDF defines a standard date format, which closely follows that of
+      the international standard ASN.1 (Abstract Syntax Notation One),
+      defined in ISO/IEC 8824 (see the Bibliography). A date is a string
+      of the form
+
+        (D:YYYYMMDDHHmmSSOHH'mm')
+
+      where
+
+        YYYY is the year
+        MM is the month
+        DD is the day (01-31)
+        HH is the hour (00-23)
+        mm is the minute (00-59)
+        SS is the second (00-59)
+        O is the relationship of local time to Universal Time (UT),
+          denoted by one of the characters +, -, or Z (see below)
+        HH followed by ' is the absolute value of the offset from UT
+          in hours (00-23)
+        mm followed by ' is the absolute value of the offset from UT
+          in minutes (00-59)
+
+      The apostrophe character (') after HH and mm is part of the syntax.
+      All fields after the year are optional. (The prefix D:, although also
+      optional, is strongly recommended.) The default values for MM and DD
+      are both 01; all other numerical fields default to zero values.  A plus
+      sign (+) as the value of the O field signifies that local time is
+      later than UT, a minus sign (-) that local time is earlier than UT,
+      and the letter Z that local time is equal to UT. If no UT information
+      is specified, the relationship of the specified time to UT is
+      considered to be unknown. Whether or not the time zone is known, the
+      rest of the date should be specified in local time.
+
+      For example, December 23, 1998, at 7:52 PM, U.S. Pacific Standard
+      Time, is represented by the string
+
+        D:199812231952-08'00'
+  </blockquote>
+
+  The main difficulty is get the time zone offset. strftime() does this in ISO
+  C99 (e.g. newer glibc) with %z, but we have to work with other systems (e.g.
+  Solaris 2.5). 
+*/
+
+static time_t start_time = 0;
+#define TIME_STR_SIZE 30
+static char start_time_str[TIME_STR_SIZE];
+static char time_str[TIME_STR_SIZE];
+    /* minimum size for time_str is 24: "D:YYYYmmddHHMMSS+HH'MM'" */
+
+static void makepdftime (time_t t, char *time_str)
+{
+
+    struct tm lt, gmt;
+    size_t size;
+    int i, off, off_hours, off_mins;
+
+    /* get the time */
+    lt = *localtime (&t);
+    size = strftime (time_str, TIME_STR_SIZE, "D:%Y%m%d%H%M%S", &lt);
+    /* expected format: "YYYYmmddHHMMSS" */
+    if (size == 0) {
+        /* unexpected, contents of time_str is undefined */
+        time_str[0] = '\0';
+        return;
+    }
+
+    /* correction for seconds: %S can be in range 00..61,
+       the PDF reference expects 00..59,   
+       therefore we map "60" and "61" to "59" */
+    if (time_str[14] == '6') {
+        time_str[14] = '5';
+        time_str[15] = '9';
+        time_str[16] = '\0';    /* for safety */
+    }
+
+    /* get the time zone offset */
+    gmt = *gmtime (&t);
+
+    /* this calculation method was found in exim's tod.c */
+    off = 60 * (lt.tm_hour - gmt.tm_hour) + lt.tm_min - gmt.tm_min;
+    if (lt.tm_year != gmt.tm_year) {
+        off += (lt.tm_year > gmt.tm_year) ? 1440 : -1440;
+    } else if (lt.tm_yday != gmt.tm_yday) {
+        off += (lt.tm_yday > gmt.tm_yday) ? 1440 : -1440;
+    }
+
+    if (off == 0) {
+        time_str[size++] = 'Z';
+        time_str[size] = 0;
+    } else {
+        off_hours = off / 60;
+        off_mins = abs (off - off_hours * 60);
+        i = snprintf (&time_str[size], 9,
+                 "%+03d'%02d'", off_hours, off_mins);
+		check_nprintf (i, 9);
+    }
+}
+
+void init_start_time ()
+{
+    if (start_time == 0) {
+        start_time = time ((time_t *) NULL);
+        makepdftime (start_time, start_time_str);
+    }
+}
+
+void print_creation_date ()
+{
+    init_start_time ();
+    pdf_printf ("/CreationDate (%s)\n", start_time_str);
+}
+
+void print_mod_date ()
+{
+    init_start_time ();
+    pdf_printf ("/ModDate (%s)\n", start_time_str);
+}
+
+void getcreationdate ()
+{
+    /* put creation date on top of string pool and update pool_ptr */
+    size_t len = strlen (start_time_str);
+
+    init_start_time ();
+
+    if ((unsigned)(pool_ptr + len) >= (unsigned)pool_size) {
+        pool_ptr = pool_size;
+        /* error by str_toks that calls str_room(1) */
+        return;
+    }
+
+    memcpy (&str_pool[pool_ptr], start_time_str, len);
+    pool_ptr += len;
+}
+
+/* makecfilename
+  input/ouput same as makecstring:
+    input: string number
+    output: C string with quotes removed.
+    That means, file names that are legal on some operation systems
+    cannot any more be used since pdfTeX version 1.30.4.
+*/
+char *makecfilename (strnumber s)
+{
+    char *name = makecstring (s);
+    char *p = name;
+    char *q = name;
+
+    while (*p) {
+        if (*p != '"')
+            *q++ = *p;
+        p++;
+    }
+    *q = '\0';
+    return name;
+}
+
+/* function strips trailing zeros in string with numbers; */
+/* leading zeros are not stripped (as in real life) */
+char *stripzeros (char *a)
+{
+    enum { NONUM, DOTNONUM, INT, DOT, LEADDOT, FRAC } s = NONUM, t = NONUM;
+    char *p, *q, *r;
+    for (p = q = r = a; *p != '\0';) {
+        switch (s) {
+        case NONUM:
+            if (*p >= '0' && *p <= '9')
+                s = INT;
+            else if (*p == '.')
+                s = LEADDOT;
+            break;
+        case DOTNONUM:
+            if (*p != '.' && (*p < '0' || *p > '9'))
+                s = NONUM;
+            break;
+        case INT:
+            if (*p == '.')
+                s = DOT;
+            else if (*p < '0' || *p > '9')
+                s = NONUM;
+            break;
+        case DOT:
+        case LEADDOT:
+            if (*p >= '0' && *p <= '9')
+                s = FRAC;
+            else if (*p == '.')
+                s = DOTNONUM;
+            else
+                s = NONUM;
+            break;
+        case FRAC:
+            if (*p == '.')
+                s = DOTNONUM;
+            else if (*p < '0' || *p > '9')
+                s = NONUM;
+            break;
+        default:;
+        }
+        switch (s) {
+        case DOT:
+            r = q;
+            break;
+        case LEADDOT:
+            r = q + 1;
+            break;
+        case FRAC:
+            if (*p > '0')
+                r = q + 1;
+            break;
+        case NONUM:
+            if ((t == FRAC || t == DOT) && r != a) {
+                q = r--;
+                if (*r == '.')  /* was a LEADDOT */
+                    *r = '0';
+                r = a;
+            }
+            break;
+        default:;
+        }
+        *q++ = *p++;
+        t = s;
+    }
+	*q = '\0';
+    return a;
+}
+
+void initversionstring(char **versions)
+{
+    (void) asprintf(versions,
+					"This is build %d, created on %dT%06dZ\n"
+                    "Compiled with libpng %s; using libpng %s\n"
+                    "Compiled with zlib %s; using zlib %s\n"
+                    "Compiled with xpdf version %s\n",
+					get_build_revision(), BUILD_DATE, (BUILD_TIME-1000000),
+                    PNG_LIBPNG_VER_STRING, png_libpng_ver,
+                    ZLIB_VERSION, zlib_version, xpdfVersion);
+}
+
+
+/*************************************************/
+/* Color Stack and Matrix Transformation Support */
+/*************************************************/
+
+/*
+    In the following array and especially stack data structures are used.
+    They have the following properties:
+    - They automatically grow dynamically.
+    - The size never decreases.
+    - The variable with name ending in "size" contains the number how many
+      entries the data structure can hold.
+    - The variable with name ending in "used" contains the number of
+      actually used entries.
+    - Memory of strings in stack entries must be allocated and
+      freed if the stack is cleared.
+*/
+
+/* Color Stack */
+
+#define STACK_INCREMENT 8
+#define MAX_COLORSTACKS 32768
+/* The colorstack number is stored in two bytes (info field of the node) */
+/* Condition (newcolorstack): MAX_COLORSTACKS mod STACK_INCREMENT = 0 */
+
+#define COLOR_DEFAULT "0 g 0 G"
+/* literal_modes, see pdftex.web */
+#define SET_ORIGIN 0
+#define DIRECT_PAGE 1
+#define DIRECT_ALWAYS 2
+
+/* remember shipout mode: page/form */
+static boolean page_mode;
+
+typedef struct {
+    char **page_stack;
+    char **form_stack;
+    char *page_current;
+    char *form_current;
+    char *form_init;
+    int page_size;
+    int form_size;
+    int page_used;
+    int form_used;
+    int literal_mode;
+    boolean page_start;
+} colstack_type;
+
+static colstack_type *colstacks = NULL;
+static int colstacks_size = 0;
+static int colstacks_used = 0;
+
+/*
+    Initialization is done, if the color stacks are used,
+    init_colorstacks() is defined as macro to avoid unnecessary
+    procedure calls.
+*/
+#define init_colorstacks() if (colstacks_size == 0) colstacks_first_init();
+void colstacks_first_init()
+{
+    colstacks_size = STACK_INCREMENT;
+    colstacks = xtalloc(colstacks_size, colstack_type);
+    colstacks_used = 1;
+    colstacks[0].page_stack = NULL;
+    colstacks[0].form_stack = NULL;
+    colstacks[0].page_size = 0;
+    colstacks[0].form_size = 0;
+    colstacks[0].page_used = 0;
+    colstacks[0].form_used = 0;
+    colstacks[0].page_current = xstrdup(COLOR_DEFAULT);
+    colstacks[0].form_current = xstrdup(COLOR_DEFAULT);
+    colstacks[0].form_init = xstrdup(COLOR_DEFAULT);
+    colstacks[0].literal_mode = DIRECT_ALWAYS;
+    colstacks[0].page_start = true;
+}
+
+int colorstackused()
+{
+    init_colorstacks();
+    return colstacks_used;
+}
+
+/*
+    newcolorstack()
+    A new color stack is setup with the given parameters.
+    The stack number is returned or -1 in case of error (no room).
+*/
+int newcolorstack(integer s, integer literal_mode, boolean page_start)
+{
+    colstack_type *colstack;
+    int colstack_num;
+    char *str;
+
+    init_colorstacks();
+
+    /* make room */
+    if (colstacks_used == MAX_COLORSTACKS) {
+        return -1;
+    }
+    if (colstacks_used == colstacks_size) {
+        colstacks_size += STACK_INCREMENT;
+        /* If (MAX_COLORSTACKS mod STACK_INCREMENT = 0) then we don't
+           need to check the case that size overruns MAX_COLORSTACKS. */
+        colstacks = xreallocarray(colstacks, colstack_type, colstacks_size);
+    }
+    /* claim new color stack */
+    colstack_num = colstacks_used++;
+    colstack = &colstacks[colstack_num];
+    /* configure the new color stack */
+    colstack->page_stack = NULL;
+    colstack->form_stack = NULL;
+    colstack->page_size = 0;
+    colstack->page_used = 0;
+    colstack->form_size = 0;
+    colstack->form_used = 0;
+    colstack->literal_mode = literal_mode;
+    colstack->page_start = page_start;
+    str = makecstring(s);
+    if (*str == 0) {
+        colstack->page_current = NULL;
+        colstack->form_current = NULL;
+        colstack->form_init = NULL;
+    } else {
+        colstack->page_current = xstrdup(str);
+        colstack->form_current = xstrdup(str);
+        colstack->form_init = xstrdup(str);
+    }
+    return colstack_num;
+}
+
+#define get_colstack(n) (&colstacks[n])
+
+/*
+    Puts a string on top of the string pool and updates pool_ptr.
+*/
+void put_cstring_on_str_pool(poolpointer start, char *str)
+{
+    size_t len;
+
+    if (str == NULL || *str == 0) {
+        return;
+    }
+
+    len = strlen(str);
+    pool_ptr = start + len;
+    if (pool_ptr >= pool_size) {
+        pool_ptr = pool_size;
+        /* error by str_toks that calls str_room(1) */
+        return;
+    }
+    memcpy(&str_pool[start], str, len);
+}
+
+integer colorstackset(int colstack_no, integer s)
+{
+    colstack_type *colstack = get_colstack(colstack_no);
+
+    if (page_mode) {
+        xfree(colstack->page_current);
+        colstack->page_current = xstrdup(makecstring(s));
+    } else {
+        xfree(colstack->form_current);
+        colstack->form_current = xstrdup(makecstring(s));
+    }
+    return colstack->literal_mode;
+}
+
+integer colorstackcurrent(int colstack_no)
+{
+    colstack_type *colstack = get_colstack(colstack_no);
+
+    if (page_mode) {
+        put_cstring_on_str_pool(pool_ptr, colstack->page_current);
+    } else {
+        put_cstring_on_str_pool(pool_ptr, colstack->form_current);
+    }
+    return colstack->literal_mode;
+}
+
+integer colorstackpush(int colstack_no, integer s)
+{
+    colstack_type *colstack = get_colstack(colstack_no);
+    char *str;
+
+    if (page_mode) {
+        if (colstack->page_used == colstack->page_size) {
+            colstack->page_size += STACK_INCREMENT;
+            colstack->page_stack = xretalloc(colstack->page_stack,
+                                             colstack->page_size, char *);
+        }
+        colstack->page_stack[colstack->page_used++] = colstack->page_current;
+        str = makecstring(s);
+        if (*str == 0) {
+            colstack->page_current = NULL;
+        } else {
+            colstack->page_current = xstrdup(str);
+        }
+    } else {
+        if (colstack->form_used == colstack->form_size) {
+            colstack->form_size += STACK_INCREMENT;
+            colstack->form_stack = xretalloc(colstack->form_stack,
+                                             colstack->form_size, char *);
+        }
+        colstack->form_stack[colstack->form_used++] = colstack->form_current;
+        str = makecstring(s);
+        if (*str == 0) {
+            colstack->form_current = NULL;
+        } else {
+            colstack->form_current = xstrdup(str);
+        }
+    }
+    return colstack->literal_mode;
+}
+
+integer colorstackpop(int colstack_no)
+{
+    colstack_type *colstack = get_colstack(colstack_no);
+
+    if (page_mode) {
+        if (colstack->page_used == 0) {
+            pdftex_warn("pop empty color page stack %u",
+                        (unsigned int) colstack_no);
+            return colstack->literal_mode;
+        }
+        xfree(colstack->page_current);
+        colstack->page_current = colstack->page_stack[--colstack->page_used];
+        put_cstring_on_str_pool(pool_ptr, colstack->page_current);
+    } else {
+        if (colstack->form_used == 0) {
+            pdftex_warn("pop empty color form stack %u",
+                        (unsigned int) colstack_no);
+            return colstack->literal_mode;
+        }
+        xfree(colstack->form_current);
+        colstack->form_current = colstack->form_stack[--colstack->form_used];
+        put_cstring_on_str_pool(pool_ptr, colstack->form_current);
+    }
+    return colstack->literal_mode;
+}
+
+void colorstackpagestart()
+{
+    int i, j;
+    colstack_type *colstack;
+
+    if (page_mode) {
+        /* see procedure pdf_out_colorstack_startpage */
+        return;
+    }
+
+    for (i = 0; i < colstacks_used; i++) {
+        colstack = &colstacks[i];
+        for (j = 0; j < colstack->form_used; j++) {
+            xfree(colstack->form_stack[j]);
+        }
+        colstack->form_used = 0;
+        xfree(colstack->form_current);
+        if (colstack->form_init == NULL) {
+            colstack->form_current = NULL;
+        } else {
+            colstack->form_current = xstrdup(colstack->form_init);
+        }
+    }
+}
+
+integer colorstackskippagestart(int colstack_no)
+{
+    colstack_type *colstack = get_colstack(colstack_no);
+
+    if (!colstack->page_start) {
+        return 1;
+    }
+    if (strcmp(COLOR_DEFAULT, colstack->page_current) == 0) {
+        return 2;
+    }
+    return 0;
+}
+
+
+/* stack for \pdfsetmatrix */
+
+typedef struct {
+    double a;
+    double b;
+    double c;
+    double d;
+    double e;
+    double f;
+} matrix_entry;
+static matrix_entry *matrix_stack = 0;
+static int matrix_stack_size = 0;
+static int matrix_stack_used = 0;
+
+boolean matrixused()
+{
+    return matrix_stack_used > 0;
+}
+
+/* stack for positions of \pdfsave */
+typedef struct {
+    int pos_h;
+    int pos_v;
+    int matrix_stack;
+} pos_entry;
+static pos_entry *pos_stack = 0;        /* the stack */
+static int pos_stack_size = 0;  /* initially empty */
+static int pos_stack_used = 0;  /* used entries */
+
+void matrix_stack_room()
+{
+    matrix_entry *new_stack;
+
+    if (matrix_stack_used >= matrix_stack_size) {
+        matrix_stack_size += STACK_INCREMENT;
+        new_stack = xtalloc(matrix_stack_size, matrix_entry);
+        memcpy((void *) new_stack, (void *) matrix_stack,
+               matrix_stack_used * sizeof(matrix_entry));
+        xfree(matrix_stack);
+        matrix_stack = new_stack;
+    }
+}
+
+void checkpdfsave(int cur_h, int cur_v)
+{
+    pos_entry *new_stack;
+
+    if (pos_stack_used >= pos_stack_size) {
+        pos_stack_size += STACK_INCREMENT;
+        new_stack = xtalloc(pos_stack_size, pos_entry);
+        memcpy((void *) new_stack, (void *) pos_stack,
+               pos_stack_used * sizeof(pos_entry));
+        xfree(pos_stack);
+        pos_stack = new_stack;
+    }
+    pos_stack[pos_stack_used].pos_h = cur_h;
+    pos_stack[pos_stack_used].pos_v = cur_v;
+    if (page_mode) {
+        pos_stack[pos_stack_used].matrix_stack = matrix_stack_used;
+    }
+    pos_stack_used++;
+}
+
+void checkpdfrestore(int cur_h, int cur_v)
+{
+    int diff_h, diff_v;
+    if (pos_stack_used == 0) {
+        pdftex_warn("%s", "\\pdfrestore: missing \\pdfsave");
+        return;
+    }
+    pos_stack_used--;
+    diff_h = cur_h - pos_stack[pos_stack_used].pos_h;
+    diff_v = cur_v - pos_stack[pos_stack_used].pos_v;
+    if (diff_h != 0 || diff_v != 0) {
+        pdftex_warn("Misplaced \\pdfrestore by (%usp, %usp)", diff_h, diff_v);
+    }
+    if (page_mode) {
+        matrix_stack_used = pos_stack[pos_stack_used].matrix_stack;
+    }
+}
+
+void pdfshipoutbegin(boolean shipping_page)
+{
+    pos_stack_used = 0;         /* start with empty stack */
+
+    page_mode = shipping_page;
+    if (shipping_page) {
+        colorstackpagestart();
+    }
+}
+
+void pdfshipoutend(boolean shipping_page)
+{
+    if (pos_stack_used > 0) {
+        pdftex_warn("%u unmatched \\pdfsave after %s shipout",
+                    (unsigned int) pos_stack_used,
+                    ((shipping_page) ? "page" : "form"));
+    }
+}
+
+/*
+    \pdfsetmatrix{a b c d}
+    e := cur_h
+    f := cur_v
+    M_top: current active matrix at the top of
+           the matrix stack
+
+    The origin of \pdfsetmatrix is the current point.
+    The annotation coordinate system is the original
+    page coordinate system. When pdfTeX calculates
+    annotation rectangles it does not take into
+    account this transformations, it uses the original
+    coordinate system. To get the corrected values,
+    first we go back to the origin, perform the
+    transformation and go back:
+
+    (  1   0  0 )   ( a b 0 )   ( 1 0 0 )
+    (  0   1  0 ) x ( c d 0 ) x ( 0 1 0 ) x M_top
+    ( -e  -f  1 )   ( 0 0 1 )   ( e f 1 )
+
+    ( 1  0  0 )   (  a  b 0 )
+  = ( 0  1  0 ) x (  c  d 0 ) x M_top
+    ( e  f  1 )   ( -e -f 1 )
+
+    ( a         b         0 )
+  = ( c         d         0 ) x M_top
+    ( e(1-a)-fc f(1-d)-eb 1 )
+
+*/
+
+void pdfsetmatrix(poolpointer in, scaled cur_h, scaled cur_v)
+{
+    /* Argument of \pdfsetmatrix starts with str_pool[in] and ends
+       before str_pool[pool_ptr]. */
+
+    matrix_entry x, *y, *z;
+
+    if (page_mode) {
+        if (sscanf((const char *) &str_pool[in], " %lf %lf %lf %lf ",
+                   &x.a, &x.b, &x.c, &x.d) != 4) {
+            pdftex_warn("Unrecognized format of \\pdfsetmatrix{%s}",
+                        &str_pool[pool_ptr]);
+            return;
+        }
+        /* calculate this transformation matrix */
+        x.e = (double) cur_h *(1.0 - x.a) - (double) cur_v *x.c;
+        x.f = (double) cur_v *(1.0 - x.d) - (double) cur_h *x.b;
+        matrix_stack_room();
+        z = &matrix_stack[matrix_stack_used];
+        if (matrix_stack_used > 0) {
+            y = &matrix_stack[matrix_stack_used - 1];
+            z->a = x.a * y->a + x.b * y->c;
+            z->b = x.a * y->b + x.b * y->d;
+            z->c = x.c * y->a + x.d * y->c;
+            z->d = x.c * y->b + x.d * y->d;
+            z->e = x.e * y->a + x.f * y->c + y->e;
+            z->f = x.e * y->b + x.f * y->d + y->f;
+        } else {
+            z->a = x.a;
+            z->b = x.b;
+            z->c = x.c;
+            z->d = x.d;
+            z->e = x.e;
+            z->f = x.f;
+        }
+        matrix_stack_used++;
+    }
+}
+
+/* Apply matrix to point (x,y)
+
+               ( a b 0 )
+   ( x y 1 ) x ( c d 0 ) = ( xa+yc+e xb+yd+f 1 )
+               ( e f 1 )
+
+   If \pdfsetmatrix wasn't used, then return the value unchanged.
+*/
+
+/* Return valeus for matrix tranform functions */
+static scaled ret_llx;
+static scaled ret_lly;
+static scaled ret_urx;
+static scaled ret_ury;
+
+scaled getllx()
+{
+    return ret_llx;
+}
+
+scaled getlly()
+{
+    return ret_lly;
+}
+
+scaled geturx()
+{
+    return ret_urx;
+}
+
+scaled getury()
+{
+    return ret_ury;
+}
+
+static int last_llx;
+static int last_lly;
+static int last_urx;
+static int last_ury;
+
+#define DO_ROUND(x)  ((x > 0) ? (x + .5) : (x - .5))
+#define DO_MIN(a, b) ((a < b) ? a : b)
+#define DO_MAX(a, b) ((a > b) ? a : b)
+
+void do_matrixtransform(scaled x, scaled y, scaled * retx, scaled * rety)
+{
+    matrix_entry *m = &matrix_stack[matrix_stack_used - 1];
+    double x_old = x;
+    double y_old = y;
+    double x_new = x_old * m->a + y_old * m->c + m->e;
+    double y_new = x_old * m->b + y_old * m->d + m->f;
+    *retx = (scaled) DO_ROUND(x_new);
+    *rety = (scaled) DO_ROUND(y_new);
+}
+
+void matrixtransformrect(scaled llx, scaled lly, scaled urx, scaled ury)
+{
+    scaled x1, x2, x3, x4, y1, y2, y3, y4;
+
+    if (page_mode && matrix_stack_used > 0) {
+        last_llx = llx;
+        last_lly = lly;
+        last_urx = urx;
+        last_ury = ury;
+        do_matrixtransform(llx, lly, &x1, &y1);
+        do_matrixtransform(llx, ury, &x2, &y2);
+        do_matrixtransform(urx, lly, &x3, &y3);
+        do_matrixtransform(urx, ury, &x4, &y4);
+        ret_llx = DO_MIN(DO_MIN(x1, x2), DO_MIN(x3, x4));
+        ret_lly = DO_MIN(DO_MIN(y1, y2), DO_MIN(y3, y4));
+        ret_urx = DO_MAX(DO_MAX(x1, x2), DO_MAX(x3, x4));
+        ret_ury = DO_MAX(DO_MAX(y1, y2), DO_MAX(y3, y4));
+    } else {
+        ret_llx = llx;
+        ret_lly = lly;
+        ret_urx = urx;
+        ret_ury = ury;
+    }
+}
+
+void matrixtransformpoint(scaled x, scaled y)
+{
+    if (page_mode && matrix_stack_used > 0) {
+        do_matrixtransform(x, y, &ret_llx, &ret_lly);
+    } else {
+        ret_llx = x;
+        ret_lly = y;
+    }
+}
+
+void matrixrecalculate(scaled urx)
+{
+    matrixtransformrect(last_llx, last_lly, urx, last_ury);
+}
+
+void 
+check_buffer_overflow (int wsize) {
+  int nsize;
+  if (wsize>buf_size) {
+	nsize = buf_size + buf_size/5+5;
+	if (nsize<wsize) {
+	  nsize = wsize+5;
+	}
+	buffer = (unsigned char *)xreallocarray (buffer, char, nsize);
+	buf_size = nsize;
+  }
+}
+
+#define EXTRA_STRING 500
+
+void 
+check_pool_overflow (int wsize) {
+  int nsize ;
+  if ((wsize-1)>pool_size) {
+	nsize = pool_size + pool_size/5+EXTRA_STRING;
+	if (nsize<wsize) {
+	  nsize = wsize+EXTRA_STRING;
+	}
+	str_pool = (unsigned char *)xreallocarray (str_pool, char, nsize);	
+	pool_size = nsize;
+  }
+}
+
+#define max_integer 0x7FFFFFFF
+
+/* the return value is a decimal number with the point |dd| places from the back, 
+   |scaled_out| is the number of scaled points corresponding to that.
+*/
+
+scaled divide_scaled (scaled s, scaled m, integer dd) {
+  register scaled q;
+  register scaled r;
+  int i;
+  int sign = 1;
+  if (s < 0) {
+    sign = -sign;
+    s = -s;
+  }
+  if (m < 0) {
+    sign = -sign;
+    m = -m;
+  }
+  if (m == 0) {
+    pdf_error(maketexstring("arithmetic"), maketexstring("divided by zero"));
+  } else if (m >= (max_integer / 10)) {
+    pdf_error(maketexstring("arithmetic"), maketexstring("number too big"));
+  }
+  q = s / m;
+  r = s % m;
+  for (i = 1;i<=(int)dd;i++) {
+	q = 10*q + (10*r) / m;
+	r = (10*r) % m;
+  }
+  /* rounding */
+  if (2*r >= m) {
+    q++;
+    r -= m;
+  }
+  /* set up the value of q, in scaled points */
+  switch(dd) {
+  case 0: scaled_out = sign*(s - r); break;
+  case 1: scaled_out = sign*(s - (r/10)); break;
+  case 2: scaled_out = sign*(s - (r/100)); break;
+  case 3: scaled_out = sign*(s - (r/1000)); break;
+  case 4: scaled_out = sign*(s - (r/10000)); break;
+  case 5: scaled_out = sign*(s - (r/100000)); break;
+  case 6: scaled_out = sign*(s - (r/1000000)); break;
+  case 7: scaled_out = sign*(s - (r/10000000)); break;
+  case 8: scaled_out = sign*(s - (r/100000000)); break;
+  case 9: scaled_out = sign*(s - (r/1000000000)); break;
+  }
+  return sign*q;
+}
+
+
+/* Sometimes there is one sp of difference in |scaled_out|
+ * compared to the 'perfect' answer given above, but this
+ * routine is only used by the pdf backend, not for typesetting.
+ */
+
+scaled 
+divide_scaled_n (double sd, double md, double n) {
+  int d = (int)(sd/md*n+0.5);
+  scaled_out = (int)(d/n*md);
+  return d;
+}
+
+
+/* C print interface */
+
+void tprint (char *s) {
+  while (*s) 
+    print_char(*s++); 
+}
+
+void tprint_nl (char *s) {
+  print_nlp();
+  tprint(s);
+}
+
+#define escape_char_code 45 /* escape character for token output */
+#define int_par(a) zeqtb[static_int_base+(a)].cint /* an integer parameter */
+#define escape_char int_par(escape_char_code)
+
+void tprint_esc(char *s) { /* prints escape character, then |s| */
+  int c=-1; /* the escape character code */
+  if (zeqtb!=NULL) {
+    c=escape_char;
+    if (c>=0)
+      print_char(c);
+  }
+  tprint(s);
+}
+
+void tconfusion(char *s) {
+  confusion(maketexstring(s));
+}
+
diff --git a/Build/source/texk/web2c/luatexdir/writezip.c b/Build/source/texk/web2c/luatexdir/writezip.c
new file mode 100644
index 00000000000..b915413ccfe
--- /dev/null
+++ b/Build/source/texk/web2c/luatexdir/writezip.c
@@ -0,0 +1,98 @@
+/*
+Copyright (c) 1996-2007 Han The Thanh, <thanh@pdftex.org>
+
+This file is part of pdfTeX.
+
+pdfTeX 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.
+
+pdfTeX 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 pdfTeX; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+$Id $
+*/
+
+#include "ptexlib.h"
+#include "zlib.h"
+#include <assert.h>
+
+#define ZIP_BUF_SIZE  32768
+
+#define check_err(f, fn)						\
+  if (f != Z_OK)								\
+    pdftex_fail("zlib: %s() failed (error code %d)", fn, f)
+
+static char *zipbuf = NULL;
+static z_stream c_stream;       /* compression stream */
+
+void write_zip(boolean finish)
+{
+    int err;
+    static int level_old = 0;
+    int level = get_pdf_compress_level();
+    assert(level > 0);
+    cur_file_name = NULL;
+    if (pdf_stream_length == 0) {
+        if (zipbuf == NULL) {
+            zipbuf = xtalloc(ZIP_BUF_SIZE, char);
+            c_stream.zalloc = (alloc_func) 0;
+            c_stream.zfree = (free_func) 0;
+            c_stream.opaque = (voidpf) 0;
+            check_err(deflateInit(&c_stream, level), "deflateInit");
+        } else {
+            if (level != level_old) {   /* \pdfcompresslevel change in mid document */
+                check_err(deflateEnd(&c_stream), "deflateEnd");
+                c_stream.zalloc = (alloc_func) 0;       /* these 3 lines no need, just to be safe */
+                c_stream.zfree = (free_func) 0;
+                c_stream.opaque = (voidpf) 0;
+                check_err(deflateInit(&c_stream, level), "deflateInit");
+            } else
+                check_err(deflateReset(&c_stream), "deflateReset");
+        }
+        level_old = level;
+        c_stream.next_out = (Bytef *) zipbuf;
+        c_stream.avail_out = ZIP_BUF_SIZE;
+    }
+    assert(zipbuf != NULL);
+    c_stream.next_in = pdf_buf;
+    c_stream.avail_in = pdf_ptr;
+    for (;;) {
+        if (c_stream.avail_out == 0) {
+            pdf_gone += xfwrite(zipbuf, 1, ZIP_BUF_SIZE, pdf_file);
+            pdf_last_byte = zipbuf[ZIP_BUF_SIZE - 1];     /* not needed */
+            c_stream.next_out = (Bytef *) zipbuf;
+            c_stream.avail_out = ZIP_BUF_SIZE;
+        }
+        err = deflate(&c_stream, finish ? Z_FINISH : Z_NO_FLUSH);
+        if (finish && err == Z_STREAM_END)
+            break;
+        check_err(err, "deflate");
+        if (!finish && c_stream.avail_in == 0)
+            break;
+    }
+    if (finish) {
+        if (c_stream.avail_out < ZIP_BUF_SIZE) {        /* at least one byte has been output */
+            pdf_gone +=
+                xfwrite(zipbuf, 1, ZIP_BUF_SIZE - c_stream.avail_out, pdf_file);
+            pdf_last_byte = zipbuf[ZIP_BUF_SIZE - c_stream.avail_out - 1];
+        }
+        xfflush(pdf_file);
+    }
+    pdf_stream_length = c_stream.total_out;
+}
+
+void zip_free(void)
+{
+    if (zipbuf != NULL) {
+        check_err(deflateEnd(&c_stream), "deflateEnd");
+        free(zipbuf);
+    }
+}
diff --git a/Build/source/texk/web2c/web2c/coerce.h b/Build/source/texk/web2c/web2c/coerce.h
index 204fce17767..7f5bfa2cd79 100644
--- a/Build/source/texk/web2c/web2c/coerce.h
+++ b/Build/source/texk/web2c/web2c/coerce.h
@@ -1,5 +1,6 @@
 /* Some definitions that get appended to the `coerce.h' file that web2c
    outputs.  */
+/* $Id$ */
 
 /* The C compiler ignores most unnecessary casts (i.e., casts of
    something to its own type).  However, for structures, it doesn't.
@@ -49,6 +50,10 @@ extern poolpointer makesrcspecial P2H(strnumber, int);
 extern void remembersourceinfo P2H(strnumber, int);
 #endif
 
+#ifdef luaTeX
+#include <luatexdir/luatex.h>
+#endif /* luaTeX */
+
 #ifdef pdfTeX
 #include <pdftexdir/pdftex.h>
 #endif /* pdfTeX */
diff --git a/Build/source/texk/web2c/web2c/splitup.c b/Build/source/texk/web2c/web2c/splitup.c
index bb3c471efac..f92933c52ba 100644
--- a/Build/source/texk/web2c/web2c/splitup.c
+++ b/Build/source/texk/web2c/web2c/splitup.c
@@ -2,6 +2,8 @@
    and it produces several .c and .h files in the current directory
    as its output.
 
+   $Id$
+
    Tim Morgan  September 19, 1987.  */
 
 #include "config.h"
@@ -110,6 +112,9 @@ main P2C(int, argc, string *, argv)
   } else if (STREQ (output_name, "pdftex")) {
     fputs ("#define INITEX\n#define TeX\n#define pdfTeX\n", out);
     coerce = "pdftexcoerce.h";
+  } else if (STREQ (output_name, "luatex")) {
+    fputs ("#define INITEX\n#define TeX\n#define luaTeX\n", out);
+    coerce = "luatexcoerce.h";
   } else if (STREQ (output_name, "pdfetex")) {
     fputs ("#define INITEX\n#define TeX\n#define pdfeTeX\n", out);
     coerce = "pdfetexcoerce.h";
@@ -120,7 +125,7 @@ main P2C(int, argc, string *, argv)
     fputs ("#define INIMP\n#define MP\n", out);
     coerce = "mpcoerce.h";
   } else
-    FATAL1 ("Can only split mf, mp, tex, etex, omega, eomega, aleph, pdf[e]tex, or xetex,\n not %s", output_name);
+    FATAL1 ("Can only split mf, mp, tex, etex, omega, eomega, aleph, luatex, pdf[e]tex, or xetex,\n not %s", output_name);
   
   coerce_len = strlen (coerce);