summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/xetexdir
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2021-02-25 19:22:25 +0000
committerKarl Berry <karl@freefriends.org>2021-02-25 19:22:25 +0000
commitad547a6b5986815fda458221149728d9d9ab1d87 (patch)
tree16296910eb3eca724371474ea9aea3994dc69614 /Build/source/texk/web2c/xetexdir
parent947b43de3dd21d58ccc2ffadefc4441ea1c2a813 (diff)
restore Build,TODO from r57911
git-svn-id: svn://tug.org/texlive/trunk@57915 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/xetexdir')
-rw-r--r--Build/source/texk/web2c/xetexdir/COPYING37
-rw-r--r--Build/source/texk/web2c/xetexdir/ChangeLog921
-rw-r--r--Build/source/texk/web2c/xetexdir/NEWS298
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontInst.cpp516
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontInst.h129
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.cpp96
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.h63
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr.cpp661
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr.h204
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.cpp362
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.h65
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.h73
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.mm257
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.cpp1029
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.h171
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXOTMath.cpp516
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXOTMath.h67
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeX_ext.c2940
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeX_ext.h319
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeX_mac.c747
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeX_pic.c153
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeX_web.h64
-rw-r--r--Build/source/texk/web2c/xetexdir/XeTeXswap.h84
-rw-r--r--Build/source/texk/web2c/xetexdir/am/xetex.am219
-rw-r--r--Build/source/texk/web2c/xetexdir/char-warning-xetex.ch84
-rw-r--r--Build/source/texk/web2c/xetexdir/etex_version.h1
-rw-r--r--Build/source/texk/web2c/xetexdir/hz.cpp77
-rw-r--r--Build/source/texk/web2c/xetexdir/image/README1
-rw-r--r--Build/source/texk/web2c/xetexdir/image/bmpimage.c211
-rw-r--r--Build/source/texk/web2c/xetexdir/image/bmpimage.h67
-rw-r--r--Build/source/texk/web2c/xetexdir/image/jpegimage.c504
-rw-r--r--Build/source/texk/web2c/xetexdir/image/jpegimage.h168
-rw-r--r--Build/source/texk/web2c/xetexdir/image/mfileio.c128
-rw-r--r--Build/source/texk/web2c/xetexdir/image/mfileio.h59
-rw-r--r--Build/source/texk/web2c/xetexdir/image/numbers.c47
-rw-r--r--Build/source/texk/web2c/xetexdir/image/numbers.h59
-rw-r--r--Build/source/texk/web2c/xetexdir/image/pngimage.c164
-rw-r--r--Build/source/texk/web2c/xetexdir/image/pngimage.h67
-rw-r--r--Build/source/texk/web2c/xetexdir/pdfimage.cpp161
-rw-r--r--Build/source/texk/web2c/xetexdir/pdfimage.h50
-rw-r--r--Build/source/texk/web2c/xetexdir/tests/bug73.log7
-rw-r--r--Build/source/texk/web2c/xetexdir/tests/bug73.tex16
-rw-r--r--Build/source/texk/web2c/xetexdir/tests/filedump.log5
-rw-r--r--Build/source/texk/web2c/xetexdir/tests/filedump.tex5
-rw-r--r--Build/source/texk/web2c/xetexdir/tex.ch037
-rw-r--r--Build/source/texk/web2c/xetexdir/trans.c93
-rw-r--r--Build/source/texk/web2c/xetexdir/trans.h91
-rw-r--r--Build/source/texk/web2c/xetexdir/unicode-char-prep.pl321
-rwxr-xr-xBuild/source/texk/web2c/xetexdir/xetex-bug73.test25
-rwxr-xr-xBuild/source/texk/web2c/xetexdir/xetex-filedump.test22
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.ch957
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.defines186
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.h131
-rwxr-xr-xBuild/source/texk/web2c/xetexdir/xetex.test9
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.web34345
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex_version.h1
-rw-r--r--Build/source/texk/web2c/xetexdir/xetexextra.c12
-rw-r--r--Build/source/texk/web2c/xetexdir/xetexextra.h70
-rw-r--r--Build/source/texk/web2c/xetexdir/xewebmac.tex106
59 files changed, 48278 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/xetexdir/COPYING b/Build/source/texk/web2c/xetexdir/COPYING
new file mode 100644
index 00000000000..09ead83bc8e
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/COPYING
@@ -0,0 +1,37 @@
+ The XeTeX typesetting system
+ (an extended version of Donald Knuth's TeX)
+
+ The XeTeX changes/additions are
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2012 by Jonathan Kew
+ Copyright (c) 2010-2012 by Han The Thanh
+ Copyright (c) 2012-2015 by Khaled Hosny
+ Copyright (c) 2012-2013 by Jiang Jiang
+
+
+For full copyright notices consult the individual files in the package.
+
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
diff --git a/Build/source/texk/web2c/xetexdir/ChangeLog b/Build/source/texk/web2c/xetexdir/ChangeLog
new file mode 100644
index 00000000000..897785441af
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/ChangeLog
@@ -0,0 +1,921 @@
+2021-02-22 Phelype Oleinik <phe.h.o1@gmail.com>
+
+ * xetex.web: avoid "expansion depth" overflow with \numexpr.
+
+2021-02-17 Karl Berry <karl@tug.org>
+
+ * NEWS,
+ * xetex_version.h,
+ * xetex.web (xetex_revision, xetex_version_string):
+ version 0.999993 for TL21.
+
+ * char-warning-xetex.ch: doc tweak.
+
+2021-02-06 Akira Kakuto <kakuto@w32tex.org>
+
+ * xetex.web: sync \tracingparagraphs fix from tex.web.
+
+2020-10-13 Akira Kakuto <kakuto@w32tex.org>
+
+ * xetexextra.c: Sync with W32 sources.
+
+2020-08-31 Marcel Fabian Krueger <tex@2krueger.de>
+
+ * xetex.web (Scan the argument for command |c|) <expanded_code>:
+ free_avail(def_ref) to avoid memory exhaustion with many \expanded.
+
+2020-08-19 Andreas Scherer <https://ascherer.github.io>
+
+ * xetex.web: Fix math operator in Pascal comment.
+
+2020-07-20 Andreas Scherer <https://ascherer.github.io>
+
+ * char-warning-xetex.ch: WEBify variable in comment.
+ * xetex.ch: Place Web2c changes together.
+
+2020-07-19 Karl Berry <karl@freefriends.org>
+
+ * char-warning-xetex.ch: new file; see ../pdftexdir/ChangeLog.
+ Also define new procedure print_ucs_code to print U+nnnn
+ for system fonts.
+ * am/xetex.am: add it.
+
+2020-07-17 Andreas Scherer <https://ascherer.github.io>
+
+ * am/xetex.am: Avoid changefile ambiguity.
+
+2020-07-04 Clerk Ma <maqiyuan130324@vip.qq.com>
+
+ * xetex.web: Tweak indentation, etc.
+
+2020-07-03 Andreas Scherer <https://ascherer.github.io>
+
+ * xetex.web: Fix |code| snippets in {comments}.
+
+2020-07-03 David Jones <dmj@ams.org>
+
+ * XeTeXOTMath.cpp: New implementation of get_ot_math_kern().
+ https://sourceforge.net/p/xetex/bugs/175/
+
+ * xetex.web: Fix bugs in
+ @<Attach subscript OpenType math kerning@>
+ @<Attach superscript OpenType math kerning@>
+ (https://sourceforge.net/p/xetex/bugs/173/
+
+2020-05-04 Andreas Scherer <https://ascherer.github.io>
+
+ * xetex.ch,
+ * xetex.web: Restore section numbering from xetex.web.
+ XeTeX can format itself, both stand-alone and as TL variant
+ (only \beginR and \endR are problematic).
+
+2020-04-26 Karl Berry <karl@freefriends.org>
+
+ * am/xetex.am (xetex_cppflags, xetex_ldadd, xetex_dependencies):
+ use pplib instead of poppler.
+
+2020-04-26 Akira Kakuto <kakuto@w32tex.org>
+
+ * XeTeX_ext.c,
+ * pdfimage.cpp: use pplib instead of poppler.
+
+2020-03-27 Karl Berry <karl@tug.org>
+
+ * TeX Live 2020.
+
+2020-02-25 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
+
+ * xetex.web: Allow fetching value from a token defined by
+ \Umathchardef, to be compatible with LuaTeX. Fixes #109.
+
+2020-02-23 Clerk Ma <maqiyuan130324@vip.qq.com>
+
+ * xetex.web: Fix a potential bug in the primitive
+ \XeTeXinterchartoks.
+
+2020-02-22 Clerk Ma <maqiyuan130324@vip.qq.com>
+
+ * xetex.web: Fix a bug in the primitive \pdfsavepos.
+
+2020-02-10 Akira Kakuto <kakuto@w32tex.org>
+
+ * xetex.ch: Sync with tex.ch for changes by Phelype Oleinik
+ to support \input {...}.
+
+2019-12-31 Akira Kakuto <kakuto@w32tex.org>
+
+ * XeTeX_ext.c: Support system poppler version 0.84.0.
+
+2019-12-10 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
+
+ * xetex.defines (gzFile): move to ../web2c/common.defines.
+
+2019-06-30 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
+
+ * xetex-filedump.test, filedump.tex, filedump.log: New tests.
+ * am/xetex.am: Adjusted for new test.
+
+2019-05-30 Khaled Hosny <dr.khaled.hosny@gmail.com>
+
+ * XeTeXLayoutInterface.cpp: Do not use hb-icu if HarfBuzz
+ version is 2.5.0 or newer.
+
+2019-01-03 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * NEWS, xetex_version.h, xetex.web: Sync with the upstream.
+ XeTeX version is 0.999991.
+
+2018-12-25 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * pdfimage.cpp: Simplify the support of Rotate.
+
+2018-12-24 Stefan Br\"uns <stefan.bruens@rwth-aachen.de>
+
+ * pdfimage.cpp: Avoid modification of internal poppler object,
+ fix compilation with poppler 0.70.0 and newer ones.
+ Improve the change on 2018-10-22.
+
+2018-11-17 Joseph Wright <joseph.wright@morningstar2.co.uk>
+
+ * xetex.web, xetex.defines: Support some primitives from
+ pdfTeX in XeTeX. Add \expanded and extend \Uchar a bit.
+
+2018-10-22 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * pdfimage.cpp: Support poppler 0.70.0.
+
+2018-09-09 Karl Berry <karl@tug.org>
+
+ * xetex-bug73.test: LC_ALL=LANGUAGE=C.
+
+2018-05-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_pic.c: Allow non-ascii image names (W32 only).
+
+2018-03-24 Hironobu Yamashita <h.y.acetaminophen@gmail.com>
+ Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
+
+ * xetex.ch: Recover the right \lastnodetype initialization
+ value ignored by tex.ch.
+
+2018-02-26 Jonathan Kew <jfkthame@gmail.com>
+
+ * xetex.web: Fix the code to skip discretionaries when looking
+ for a |native_word|.
+
+2018-02-04 Jonathan Kew <jfkthame@gmail.com>
+
+ * NEWS: Update for 0.99999.
+
+2018-02-03 Jonathan Kew <jfkthame@gmail.com>
+
+ * Bump version number to 0.99999, aiming for the TL'18 release.
+ Fix issues reported on https://sourceforge.net/p/xetex/bugs
+ * xetex.web, xetex.ch: Patch from Hironori Kitagawa to
+ integrate prim_eqtb into eqtb. Fixes issue where
+ \primitive\vrule\q incorrectly swallows the \q instead of
+ giving an error. Fixes #143.
+ * xetex.web: Patch from Hironobu Yamashita for \strcmp and
+ \mdfivesum errors. Fixes #144.
+ * xetex.web: Patch from Hironobu Yamashita for \uchyph with
+ native fonts. Fixes #145.
+ * XeTeX_ext.[ch]: Patch from Hironobu Yamashita to properly
+ close input pipes. Fixes 147.
+ * xetex.web: Leave text as UTF-16 in trick_buf for better
+ error context printing. (Mostly) fixes #146.
+ It's still possible that error context could include half of
+ a supplementary-plane character (i.e. an unpaired surrogate).
+ Should be a lot less likely, and less troublesome than broken
+ UTF-8, however.
+ * XeTeXFontMgr.cpp, XeTeXFontMgr.h: Convert optical size info
+ in OpenType 'size' feature from PostScript to TeX points.
+ Note that this will change behavior for existing documents
+ that use OpenType fonts from optically-sized families, and
+ depend on XeTeX choosing the appropriate face for a given
+ size: the boundaries at which face selection changes will be
+ slightly shifted (corrected) from how earlier versions behaved.
+ * xetex.web: Avoid prematurely merging following text with the
+ no-break text of a \discretionary. We don't want to combine
+ text after \discretionary{A}{B}{C} into the same node as the
+ (trailing node of the) no-break parameter {C}, because this
+ would result in following text being lost in the case where
+ the discretionary break is taken. When this happens, its
+ no-break text (recorded as a count of nodes) is supposed
+ to be skipped over, but if we've combined following characters
+ with the trailing node, they will also be (incorrectly)
+ skipped. Fixes #137.
+
+2018-01-17 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * am/xetex.am (OBJCXXFLAGS) [XETEX_MACOSX]: add -std=c++11.
+
+2017-12-22 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * image/jpegimage.c: If j_info->xdpi and j_info->ydpi are not
+ determined in some JPEG format, they are assumed to be 72.0
+ in order to avoid division by zero.
+
+2017-11-07 Jonathan Kew <jfkthame@gmail.com>
+
+ * XeTeX_ext.c: Guard against out-of-range result from UTF-8
+ decoding, and return U+FFFD Replacement Character instead
+ to avoid a crash for invalid inputs (from A. Kakuto).
+
+2017-09-24 Hironori Kitagawa <h_kitagawa2001@yahoo.co.jp>
+
+ * xetex.web: Avoid overwriting prim_* entries by primitive().
+
+2017-09-05 Karl Berry <karl@tug.org>
+ and Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetexdir/XeTeX_ext.c (IS_SPC_OR_EOL): new macro.
+ (input_line): use it, instead of ISBLANK.
+ See also analogous change in lib/texmfmp.c.
+ Original bug report from Evan Aad,
+ http://tug.org/pipermail/tex-k/2017-August/002801.html
+
+2017-08-06 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * pdfimage.cpp: Support /Rotate in PDF image inclusion with
+ the new xdvipdfmx-20170806.
+
+2017-07-17 Jonathan Kew <jfkthame@gmail.com>
+
+ * xetex.ch: Set a non-zero exit code if the pipe
+ to the output driver closes with a non-zero code.
+
+2017-04-27 Karl Berry <karl@tug.org>
+
+ * am/xetex.am (xetex_ldadd): add $(ICU_LIBS_EXTRA).
+
+2017-04-22 Jonathan Kew <jfkthame@gmail.com>
+
+ * xetex.web, xetex_version.h, NEWS: Fixed long-standing bug that made
+ \ifcat\span...\fi (and similar constructions with \cr, \crcr) behave
+ incorrectly. Also fixed initialization of \delcode values for
+ supplementary-plane characters. version 0.99998.
+
+2017-03-17 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * Sync with the upstream (version 0.99997).
+
+2017-03-12 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * Sync with the upstream.
+
+2016-10-03 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeXOTMath.cpp: Sync with the upstream.
+
+2016-09-25 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * MathTable.h, XeTeXOTMath.cpp: Sync with the upstream.
+
+2016-09-24 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web: Sync with the upstream.
+
+2016-02-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Revert the change on 2015-11-06.
+ That is, recover the original *outputdriver = "xdvipdfmx -q -E",
+ because asynchronous outputs of XeTeX and xdvipdfmx are messy.
+
+2016-02-07 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web, NEWS: sync with the upstream.
+
+2015-11-06 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Change const char *outputdriver = "xdvipdfmx -q -E";
+ as const char *outputdriver = "xdvipdfmx -E"; by removing the quiet
+ option, in order to show useful messages for users.
+
+2015-08-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * image/bmpimage.c, image/pngimage.c: Drop set but unused vars.
+ * image/mfileio.c: ANSI C function definition.
+
+2015-08-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (libxetex_a_CFLAGS): Enable gcc warnings.
+
+ * XeTeX_ext.[ch], XeTeXFontInst{cpp,h}, XeTeXFontMgr.cpp,
+ XeTeXLayoutInterface.{cpp,h}, XeTeX_pic.c:
+ ANSI C prototypes, unconstify, drop (set but) unused variable,
+ remove useless or misleading casts.
+
+2015-08-25 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeXFontInst.cpp: Support pair kerning for native type1 fonts.
+ Thanks Werner Lemberg and Jiang Jiang.
+
+2015-08-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (xetex_CFLAGS): Enable compiler warnings.
+ * xetex.web: Drop unused label 'done'.
+
+2015-07-24 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web, xetex.h: Support pagebox=artbox etc. as in pdfTeX
+ in PDF inclusion. It works with a new xetex.def and xdvipdfmx.
+ Nothing changes if the present xetex.def is used.
+
+2015-07-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web: Change \pdfmdfivesum to \mdfivesum, to be consistent
+ with \strcmp and \shellescape.
+
+2015-07-10 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Dependencies for 'make check'.
+
+2015-07-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web: Added \pdfmdfivesum, version 0.99993.
+ * xetex.defines: Added getmd5sum().
+ * am/xetex.am: Added libmd5.
+
+2015-06-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Use $(tie_c).
+
+2015-05-07 Jonathan Kew <jfkthame@gmail.com>
+
+ * xetex.web: Merged UTF-16 surrogate-handling fixes from github.
+ * xetex.web: New \Uchar and \Ucharcat primitives.
+
+2015-05-05 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c: Can not use non-locking getc() for MinGW.
+
+2015-05-03 Jonathan Kew <jfkthame@gmail.com>
+
+ * XeTeX_ext.c: use non-locking getc() for faster file reading.
+
+2015-03-27 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * image/mfileio.[ch]: Use mfgets() parameters as for fgets().
+
+2015-03-26 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * image/jpegimage.c: Drop redundant #include directives.
+ * image/{mfileio,numbers}.c: First '#include <w2c/config.h>'.
+ * image/mfileio.h, image/numbers.[ch]: Drop unused types and
+ functions.
+
+2015-03-22 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: The SELFAUTOLOC issue has been considered on W32
+ independently.
+
+2015-03-17 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex-bug73.test: The equivalent of 'tail -n+2' is 'sed 1d'.
+
+2015-03-16 Karl Berry <karl@tug.org>
+
+ * xetex-bug73.test: sed 1,2d instead of tail -n+2, which
+ is not supported on Solaris 10. tlbuild mail from Mojca,
+ 16 Mar 2015 17:03:25.
+
+2015-03-12 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * image/jpegimage.c: Fix a bug introduced by me on 2015-02-15.
+
+2015-02-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_pic.c and image/jpegimage.c: Revert. The changes in 2015-02-09
+ are discarded. The picture sizes obtained by the previous XeTeX are
+ correct. Problems may be in xdvipdfmx or maybe cmyk colors are not
+ supported.
+
+2015-02-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_pic.c and image/jpegimage.c: Fix a bug to include jpeg images
+ correctly (borrowed from dvipdfm-x).
+
+2014-08-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * image/pngimage.c: Avoid PNG warnings.
+
+2014-07-22 Khaled Hosny <khaledhosny@eglug.org>
+
+ * xetex.web, xetex.ch, tex.ch0: Switch right-to-left support from
+ e-TeX's TeX--XeT to Knuth's original TeX-XeT code (with some fixes and
+ slight modification to the DVI opcode) to fix TeX--XeT paired specials
+ issue.
+
+2014-07-15 Khaled Hosny <khaledhosny@eglug.org>
+ Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex-bug73.test: Shell script for a new test.
+ * tests/bug73.{log,tex} (new): Test input and expected output.
+ * am/xetex.am: Adjusted.
+
+2014-07-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex_version.h: 0.99992
+
+2014-07-04 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.web: Remove unused variables k,and l in function
+ get_strings_started, and q, and r in procedure set_math_char().
+ * image/mfileio.c: Change type of a variable i in mfgets() in order to
+ suppress warnings.
+ * image/bmpimage.c: Remove an unused variable i in bmp_scan_file().
+ * image/jpegimage.c: Remove an unused variable rational_value in
+ read_APP1_Exif().
+ * image/pngimage.c: Remove unused variables stream_data_ptr,
+ trans_type, and rowbytes in png_scan_file().
+ * XeTeXFontMgr_FC.cpp: Remove an unused label restart.
+
+2014-05-10 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * image/bmpimage.c: Error exit instead of crashing for unsupported
+ bmp in bmp_scan_file().
+
+2014-04-28 TANAKA Takuji <KXD02663@nifty.ne.jp>
+
+ * XeTeX_ext.c: Accept Ctrl+Z as EOF in console (keyboard).
+ (Windows only)
+
+2014-03-17 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXFontInst.cpp, XeTeXFontInst_Mac.cpp, XeTeXFontMgr.cpp,
+ XeTeXFontMgr_FC.cpp, XeTeXLayoutInterface.cpp, XeTeXOTMath.cpp,
+ hz.cpp, pdfimage.cpp: <w2c/config.h> is now C++ safe.
+
+ * XeTeXFontMgr.cpp, XeTeXLayoutInterface.cpp, XeTeXOTMath.cpp,
+ hz.cpp: Move extern declarations from the Pascal/WEB side ...
+ * XeTeX_web.h (new): ... to here.
+ * am/xetex.am: Add the new file.
+
+2014-02-08 TANAKA Takuji <KXD02663@nifty.ne.jp>
+
+ * XeTeX_ext.h: Display output of Unicode characters
+ on console. (Windows only)
+
+2014-01-20 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ TeX tuneup of 2014.
+ * xetex.web: Adapt to TeX Version 3.14159265.
+
+2014-01-17 TANAKA Takuji <KXD02663@nifty.ne.jp>
+
+ * XeTeX_ext.c, xetex.h: Accept Unicode characters from STDIN
+ on console. (Windows only)
+
+2013-12-06 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Remove unused variables.
+ 'i' in read_tag_with_param(const char* cp, int* param), and
+ 'x', 'y' in a block if (fontarea[f] == OTGR_FONT_FLAG) {
+ in measure_native_node(void* pNode, int use_glyph_metrics).
+
+2013-12-05 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Rewrite command line for popen(). Windows only.
+
+2013-09-25 Karl Berry <karl@tug.org>
+
+ * xetexextra.h (BANNER),
+ * am/xetex.am (xetex_cppflags): remove XETEX_BUILD_DATE,
+ so we have reproducible binaries again. (Change already made
+ upstream.)
+
+2013-07-02 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Undefine timezone before reading time.h for MSVC.
+
+2013-07-02 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXFontInst.cpp, XeTeXFontInst_Mac.cpp, XeTeXFontMgr.cpp,
+ XeTeXFontMgr_FC.cpp, XeTeXFontMgr_Mac.mm,
+ XeTeXLayoutInterface.cpp, XeTeXOTMath.cpp, XeTeX_ext.c,
+ hz.cpp, pdfimage.cpp: Always first include <w2c/config.h>.
+ * XeTeX_ext.h: Do not include <w2c/config.h>.
+ * image/bmpimage.[ch], image/jpegimage.[ch]: First include
+ <w2c/config.h> in C files and not in headers.
+
+2013-06-28 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXFontInst.h: Include "XeTeXFontMgr.h" before <stdio.h>.
+ * XeTeX_ext.h: Include <w2c/c-auto.h> before <unicode/utypes.h>.
+ * pdfimage.cpp: Include "XeTeX_ext.h" before "pdfimage.h".
+
+2013-05-30 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pdfimage.cpp [MINGW]: Include kpathsea/mingw32.h (via
+ XeTeX_ext.h) before PDFDoc.h etc to avoid conflicting typedef of
+ boolean from rpcndr.h.
+
+2013-03-27 Khaled Hosny <khaledhosny@eglug.org>
+
+ XeTeX 0.9999.2
+
+2013-03-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (EXTRA_DIST): Add NEWS and image/README.
+
+2013-03-22 Khaled Hosny <khaledhosny@eglug.org>
+
+ XeTeX 0.9999.1
+
+2013-03-12 Khaled Hosny <khaledhosny@eglug.org>
+
+ * xetex.web: Fix \XeTeXrevision.
+
+2013-03-11 Khaled Hosny <khaledhosny@eglug.org>
+
+ XeTeX 0.9999.0
+
+2013-03-07 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeXFontInst.cpp: Fix a typo.
+
+2013-03-06 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.web: Typo.
+
+2013-03-04 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Better rules for {e,xe}tex_version.h.
+
+2013-02-28 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.web: Adapt to e-TeX 2.5.
+
+2013-02-23 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * etex_version.h: New file extracted from xetex.web.
+ * am/xetex.am, xetexextra.h: Adjust.
+
+2013-02-03 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: (W32) change to match the simplified win32_popen.
+
+2013-01-11 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.h: Add #ifndef __cplusplus ... #endif for
+ #define bool boolean to avoid compile error in cplusplus files.
+
+2013-01-06 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: Move u_getVersion(icuVersion) etc. below variable
+ definitions, because Visual Studio 2005 does not know c99.
+
+2013-01-05 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c: If necessary define or declare strndup().
+
+ * XeTeXFontMgr.cpp, XeTeXLayoutInterface.cpp: Drop definition
+ of M_PI here ...
+ * trans.h: ... and '#define M_PI' here immediately after
+ '#include <math.h>'.
+
+ * XeTeX_ext.c: Print the Graphite2 version (from Akira).
+
+2013-01-04 Khaled Hosny <khaledhosny@eglug.org>
+
+ Merge changes from XeTeX repository.
+
+2013-01-04 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c: Use xcalloc() and strncpy() instead of strndup()
+ because there are systems without it, e.g., MinGW.
+ * xetex.h: Include "XeTeXOTMath.h" (protos for xetex.web).
+ * am/xetex.am: Drop obsolete files from XeTeX change file merge.
+
+2013-01-03 Khaled Hosny <khaledhosny@eglug.org>
+
+ Merge changes from XeTeX repository.
+
+2012-12-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (xetex_version.h): Enable silent rules.
+
+2012-11-11 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ Merge the XeTeX change files.
+ * xetex.ch: Moved most from here ...
+ * xetex-hz.ch (removed): ... and all from here ...
+ * xetex-latex3.ch (removed): ... and here ...
+ * xetex.web: ... and the results of merging ../tex.web with
+ ../etexdir/etex.ch into this new file.
+ * tex.ch0 (new): Glue between xetex.web and ../tex.ch.
+ * am/xetex.am: Adapted to the new layout.
+
+2012-10-22 Khaled Hosny <khaledhosny@eglug.org>
+
+ * XeTeXFontInst.cpp, XeTeXOTMath.cpp, XeTeXOTMath.h, XeTeX_ext.c,
+ XeTeX_ext.h, xetex.ch, xetex.h: Merge changes from XeTeX repository.
+
+2012-09-15 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c (open_dvi_output): sync with W32TeX. On Windows,
+ use $SELFAUTOLOC/xdvipdfmx.exe as a driver for security reason.
+ Otherwise a malicious xdvipdfmx.bat in the current directory can
+ be called.
+
+2012-08-29 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Use Automake generated rule for ObjC++ file,
+ it is no longer necessary to build a separate libxetexmm.a.
+ * XeTeXFontMgr_Mac.cpp (removed): Obsolete.
+
+2012-08-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXswap.h [WIN32]: Do not '#define inline __inline';
+ if needed this comes via c-auto.h or ../../kpathsea/config.h.
+
+2012-08-10 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXFontMgr.cpp, XeTeXLayoutInterface.cpp: Always put
+ '#define M_PI' immediately after '#include <math.h>'.
+ * numbers.h: Drop unused definition of M_PI.
+
+2012-08-10 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: use rewind(f) instead of fseek(f, 0, SEEK_SET)
+ in u_open_in() in order to work also on W32.
+
+2012-08-09 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeXFontMgr.cpp: Add 'extern "C" {' to avoid link error in MSVC.
+ * XeTeX_ext.c: Change order of inlusion of headers to be able to
+ compile by using MSVC.
+ * XeTeX_ext.h: Add 'extern "C" {' to avoid link error in MSVC.
+
+2012-08-02 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Clarify *tex_version.h dependencies.
+
+2012-07-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Distribute xetex_version.h.
+ * xetexextra.h: Use ../etexdir/etex_version.h.
+
+2012-06-25 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * xetex.ch: XeTeX uses 256 math font families.
+
+2012-05-07 Khaled Hosny <khaledhosny@eglug.org>
+
+ * am/xetex.am (xetex_web_srcs): Drop enctex.ch.
+ * xetex.ch, xetex-latex3.ch: Adjusted.
+
+2012-05-06 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (EXTRA_DIST): Drop pool2c.pl (is removed).
+
+2012-05-05 Khaled Hosny <khaledhosny@eglug.org>
+
+ * xetex.ch, xetex.defines, XeTeX_ext.h, am/xetex.am: Use makecpool
+ instead of out pool2c.pl.
+ * pool2c.pl: Removed.
+
+2012-04-24 Khaled Hosny <khaledhosny@eglug.org>
+
+ * xetex.ch: Merge changes from XeTeX repository.
+
+2012-04-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex-hz.ch: Added copyright statement.
+ Removed useless blank lines at end of change sets.
+
+2012-04-18 Khaled Hosny <khaledhosny@eglug.org>
+
+ * xetex-hz.ch, xetex.ch: Merge changes from XeTeX repository.
+
+2012-03-25 Khaled Hosny <khaledhosny@eglug.org>
+
+ * XeTeX_ext.h, xetex.ch: Merge changes from XeTeX repository.
+
+2012-03-17 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c, xetex.h (Byte): Remove temporary #define to my_Byte
+ and subsequent #undef. The typedef conflict between TECkit_Common.h
+ and zlib is now handled differently (by zlib and TECkit).
+
+2012-03-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXGrLayout.h: Declare XeTeXGrTextSource::featureVariations()
+ required for graphite-2.4.
+
+2012-02-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch: Remove test for end-of-file after undump.
+ * xetex.defines: Remove weof().
+
+2012-02-11 Jonathan Kew <jfkthame@gmail.com>
+
+ * XeTeX_ext.c (makefontdef): pass font pathname to xdvipdfmx
+ whenever possible, to avoid fontconfig search mismatches
+
+ * xetex.ch (XeTeX_version_string): bump to .6.
+
+2012-02-11 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch: Adapt to zlib-1.2.6 (problem found by Akira).
+ From zlib-1.2.6/ChangeLog: Fix gzeof() to behave just like
+ feof() when read is not past end of file
+
+2011-09-01 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.h: Do not #include "XeTeXOTMath.h".
+
+2011-08-12 Akira Kakuto <kakuto@fuk.kindai.ac.jp>
+
+ * XeTeX_ext.c: fix to allow font definition like
+ \font\x="[msmincho.ttc:1]"
+
+2011-07-08 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch: Fix an off-by-one bug initializing mubyte_cswrite.
+ From Roderich Schupp <roderich.schupp@googlemail.com>,
+ Debian Bug#633011, tex-k mail Fri, 8 Jul 2011 15:56:23.
+
+2011-07-06 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c, pdfimage.cpp, am/xetex.am: Always use poppler
+ instead of xpdf.
+
+2011-04-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ Avoid 'differ in signedness' warnings.
+ * xetex.ch (pack_buffered_name): Adapt to modified ../tex.ch.
+ (read_font_info): Cast print_c_string() arg to string.
+
+2011-04-11 Karl Berry <karl@tug.org>
+
+ * xetex.ch (XeTeX_version_string): bump to .5.
+
+2011-04-07 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch: Reformulate to not depend on eTeX_version_string.
+
+2011-02-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXFontInst.h: Fix prototype for xmalloc().
+
+ * XeTeXFontMgr_FC.cpp, XeTeX_ext.c: Move (nested) extern
+ declaration of gFreeTypeLibrary from here ...
+ * XeTeX_ext.h: ... to here.
+
+2011-02-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXOTLayoutEngine.{cpp,h}: Drop support for ICU < 4.2.
+
+2011-01-17 Karl Berry <karl@tug.org>
+
+ * XeTeX_ext.h: #include <w2c/c-auto.h> for SIZEOF_LONG and
+ NO_DUMP_SHARE, else segfaults/stretchy math problems on
+ x86_64-linux, at least sometimes. Contributed by Paul Vojta,
+ confirmed by Thanh.
+ https://sourceforge.net/tracker/index.php?func=detail&aid=3053287&group_id=194926&atid=951385
+
+2011-01-08 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (xetex_web_srcs): Added enctex.ch.
+
+2011-01-01 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetexextra.in: Renamed ...
+ * xetexextra.h: ... into this; #include {e,xe}tex_version.h
+ for {E,XE}TEX_VERSION.
+
+ * xetexextra.c (new): #include <xetexd.h> and <lib/texmfmp.c>.
+
+ * am/xetex.am: xetexextra.[ch] are now distributed;
+ create {e,xe}tex_version.h instead of {e,xe}tex.version.
+
+2010-09-28 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.test (new): Just testing 'xetex -version'.
+ * am/xetex.am: Adjusted.
+
+2010-06-10 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (xetex_cppflags): Add $(AM_CPPFLAGS).
+
+2010-06-10 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ Reorganize web2c headers.
+ * bmpimage.h, pngimage.[ch]: #include <w2c/config.h> instead
+ of "config.h".
+
+2010-05-18 Karl Berry <karl@tug.org>
+
+ * xetex.ch (XeTeX_version_string): incr to 0.9995.3.
+
+2010-04-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.h: Move extern declarations of papersize and
+ outputdriver from ../lib/texmfmp.c to here; use 'const char *',
+ 'const_string' is not defined in this file.
+ * XeTeX_ext.c (papersize, outputdriver): Use 'const char *'.
+
+2010-03-30 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXLayoutInterface.cpp: #include "unicode/platform.h" first,
+ required with ICU 4.4 for MinGW32.
+
+2010-02-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c [MINGW32]: First #include <kpathsea/config.h> to
+ avoid conflicting eof() declarations.
+
+2010-02-22 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * pngimage.c (check_for_png): Replace png_check_sig() by
+ png_sig_cmp() for libpng-1.4.
+ From Hanno Boeck <hanno@hboeck,de>.
+
+2009-12-12 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Replace the obsolete $(mkdir_p) by $(MKDIR_P).
+
+2009-12-04 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c: Remove extern declaration of gettexstring(),
+ now in ../web2c/coerce.h.
+
+2009-11-19 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c, XeTeX_mac.c: #include <teckit/TECkit_Engine.h>
+ instead of "TECkit_Engine.h".
+ * xetex.h: #include <teckit/TECkit_Common.h> instead of
+ "TECkit_Common.h".
+
+2009-10-25 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXOTLayoutEngine,{cpp,h}: Adjust to ICU-4.2.1.
+
+2009-10-24 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch: Use kpse_{in,out}_name_ok(), now in Kpathsea,
+ instead of open_{in,out}_name_ok().
+
+2009-10-12 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeXOTLayoutEngine.h: Drop #include "layout/HanLayoutEngine.h".
+ Move #include "layout/{Arabic,Indic,Tibetan}LayoutEngine.h" and
+ declaration of class XeTeXHanLayoutEngine from here ...
+ * XeTeXOTLayoutEngine.cpp: ... to here.
+
+2009-10-09 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * FontTableCache.{cpp,h}, MathTable.h, XeTeXFontInst.{cpp,h},
+ XeTeXFontMgr.cpp, XeTeXLayoutInterface.cpp,
+ XeTeXOTLayoutEngine.{cpp,h}, XeTeXOTMath.{cpp,h}, cmaps.{cpp,h},
+ sfnt.h: Include, e.g., "layout/LETypes.h" instead of "LETypes.h"
+ for consistency with installed (system) headers.
+
+2009-10-04 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * xetex.ch (do_extension): Recover variables unused by TeX.
+
+2009-09-04 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Prepare compiler warnings.
+
+2009-08-18 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: SyncTeX now integrated into ../texmfmp.h.
+
+2009-08-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Adapt to tangle-sh and web2c-sh.
+
+2009-08-13 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am (xetex_c_h): avoid to split the C code.
+
+2009-07-16 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Put ICU_INCLUDES first to avoid an installed
+ version.
+
+2009-05-13 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: Put FREETYPE2_INCLUDES as early as possible to
+ avoid freetype1/freetype2 problems when both are installed under
+ the same prefix.
+
+2009-05-06 Karl Berry <karl@tug.org>
+
+ * jpegimage.c: #include <stdlib.h> and <string.h>
+ instead of <memory.h>.
+
+2009-05-05 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * am/xetex.am: in CPPFLAGS define U_STATIC_IMPLEMENTATION
+ instead of DLE_USE_CMEMORY, required for Cygwin but also works for
+ others.
+
+2009-05-05 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * XeTeX_ext.c, image/pdfimage.cpp: adapt for poppler.
+
+ patches from Norbert Preinig <preining@logic.at>
diff --git a/Build/source/texk/web2c/xetexdir/NEWS b/Build/source/texk/web2c/xetexdir/NEWS
new file mode 100644
index 00000000000..5bb34f51c63
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/NEWS
@@ -0,0 +1,298 @@
+==============================================================
+XeTeX 0.999993 (February 2021)
+
+* Fix several bugs in Unicode math kerning implementation.
+
+==============================================================
+XeTeX 0.999992 (January 2020)
+
+* Merged various minor fixes from TeX Live svn sources
+ - includes new \filedump primitive
+* Merged new feature:
+ - new \input{...} group-delimited syntax (cross-engine).
+
+==============================================================
+XeTeX 0.999991 (January 2019)
+
+* Merged various minor fixes from TeX Live svn sources
+* Merged new features implemented by Joseph Wright, see:
+ - https://sourceforge.net/p/xetex/code/merge-requests/1/
+ Reorder lines (internal rearrangement, no functional change)
+ - https://sourceforge.net/p/xetex/code/merge-requests/2/
+ Round out pdfTeX-derived utilities: adds pdfTeX-based primitives
+ for RNG, timer, file data, \filedump
+ - https://sourceforge.net/p/xetex/code/merge-requests/3/
+ Add \expanded to XeTeX
+ - https://sourceforge.net/p/xetex/code/merge-requests/4/
+ Extend \Ucharcat to produce \active chars
+* Fix \lastnodetype initialization bug (patch from Hironobu Yamashita)
+* Fix logic typo in discretionary-skipping (reported by Peter Williams)
+ https://sourceforge.net/p/xetex/bugs/149/
+
+==============================================================
+XeTeX 0.99999 (February 2018, for TeX Live 2018)
+
+* Fix bug that could cause text after a \discretionary{...}{...}{...}
+ line-break to be dropped.
+* Avoid risk of generating broken UTF-8 in error context messages.
+* Interpret optical size info in OpenType 'size' feature as "big
+ points" units, rather than TeX points.
+* Set a non-zero exit code if the pipe to the output driver returns
+ an error.
+* Correction for longstanding input_ln bug (stripping trailing tabs).
+ (Karl Berry)
+* Guard against out-of-range result from UTF-8 decoding, and return
+ U+FFFD Replacement Character instead. (Akira Kakuto)
+* Fix bugs involving \strcmp and \mdfivesum primitives. (Hironobu
+ Yamashita)
+* Fixes issue where \primitive\vrule\q incorrectly swallows the \q
+ instead of giving an error. (Hironori Kitagawa)
+* Properly close input pipes used in \input or \openin. (Hironobu
+ Yamashita)
+* Make \uchyph work with native fonts. (Hironobu Yamashita)
+* Fixed bug in \ifprimitive. (Hironori Kitagawa)
+* Support /Rotate in PDF image inclusion. (Akira Kakuto)
+* If DPI info is missing in JPEG files, assume 72.0 to avoid
+ division by zero. (Akira Kakuto)
+
+==============================================================
+XeTeX 0.99998 (April 22, 2016)
+
+* Fixed long-standing bug that made \ifcat\span...\fi (and similar
+ constructions with \cr, \crcr) behave incorrectly.
+* Also fixed initialization of \delcode values for supplementary-
+ plane characters.
+
+==============================================================
+XeTeX 0.99997 (March 2016, for TeX Live 2017)
+
+* Unicode/OpenType math implementation now based on HarfBuzz's MATH
+ table support, for easier ongoing maintenance.
+* Minor bug fixes (revision history available at xetex.sf.net).
+
+==============================================================
+XeTeX 0.99996 (March 2016, for TeX Live 2016)
+
+* Added \XeTeXhyphenatablelength primitive that sets the maximum
+ length of word that XeTeX will attempt to hyphenate (default: 63).
+
+==============================================================
+XeTeX 0.99995 (targeting TeX Live 2016)
+
+* Added \XeTeXgenerateactualtext primitive to record original Unicode
+ text in /ActualText annotations.
+* Bumped the DVI id byte to 7, as this uses a new opcode that requires
+ support in the driver.
+
+==============================================================
+XeTeX 0.99994 (unreleased experimental version)
+
+* Increased character class limit to 4096.
+* Added \XeTeXinterwordspaceshaping primitive, for contextual
+ measurement (when set to 1) or full glyph shaping (when set to 2) of
+ interword space with smart-enough fonts.
+
+==============================================================
+XeTeX 0.99993 (July 2015)
+
+* Added \mdfivesum primitive
+* Removed -q from the default xdvipdfmx output-driver command line
+ (reverted 20160209, r39630 in TeX Live).
+
+==============================================================
+XeTeX 0.99992 was released 20150507 (in TeX Live 2015)
+
+* New \Uchar and \Ucharcat primitives
+* Fix various issues with UTF-16 and characters >= U+10000.
+* Various image handling fixes by Akira Kakuto.
+* Fix off-by-one error in display of \every... token registers, thanks to Bruno
+ Le Floch.
+* The XDV opcodes have been simplified slightly. The DVI id have been bumped to
+ 6 to reflect this.
+* XeTeX now looks for the xdvipdfmx binary installed next to it and no longer
+ requires that it is installed in the system PATH (this was previously done
+ only on Windows).
+
+==============================================================
+XeTeX 0.99991 was released 20140614
+
+* Drop build date from “--version” output.
+* Drop Mac-specific image loading code, as it makes little sense after we
+ dropped xdv2pdf. Supported image formats are the same on all platforms now.
+* Fix OpenType math cut-ins support which was not always working properly.
+* Avoid Unicode compatibility decomposition fallback for characters not
+ supported by the font as it often result in loss of essential characteristics
+ (like using regular Latin characters in place of missing math fraktur ones).
+ Non compatibility decomposition and composition fallback is still supported.
+* For hybrid OpenType/Graphite fonts, we now prefer using OpenType for
+ compatibility with pre-0.9999 XeTeX.
+* Fix many memory leaks when using AAT fonts on Mac.
+* The “language” font option when loading Graphite fonts in now treated as a
+ BCP 47 language tag not and OpenType one.
+* Various Unicode fixes for Windows console (thanks to TANAKA Takuji).
+* Respect vertical glyph positioning with AAT fonts (fixes, for example,
+ rendering of the new Arabic fonts in Mac OS X 10.9).
+
+==============================================================
+XeTeX 0.9999.3 was released 20130528
+
+* Fix bug with extensible accents resulting in invalid glyph id some times.
+* Fix alternate index in multiple alternates features to be start from zero
+ like pre-0.9999 XeTeX.
+* Document multiple alternates syntax in the reference documentation.
+
+==============================================================
+XeTeX 0.9999.2 was released 20130406
+
+* Fix regression in \XeTeXOT* primitives with fonts where the number of
+ languages in a given script is not the same in both GSUB and GPOS tables.
+
+* Add a workaround for a bug in clang headers to allow building with it on Mac.
+
+* Fix regression in loading PNG files on Mac.
+
+* Fix multiple regression with vertical text layout.
+
+* Update to HarfBuzz 0.9.15 fixing a couple of regressions with Arabic non
+ spacing marks and Hangul jamo.
+
+* Various build fixes for third party libraries.
+
+* XeTeX reference is now included in the release tarball.
+
+xdvipdfmx:
+* Speed up inclusion of eps figures by Tsuchimura Nobuyuki.
+
+==============================================================
+XeTeX 0.9999.1 was released 20130322
+
+* Fix loading font files on PPC Mac OS 10.5 (and potentially other versions of
+ Mac).
+
+* Fix handling of ‘script’ and ‘language’ font options to be treated again as
+ OpenType not ISO tags, so that passing version 2 Indic script tags works
+ (though this is generally not needed as HarfBuzz will always use version 2
+ shaping if the font has it, regardless of the tag used).
+
+* Fix loading JPEG images that do not specify a resolution.
+
+* When printing multi-byte characters to log or terminal avoid inserting new
+ lines in the middle of the characters, and count the characters not the bytes
+ when calculating line length.
+
+* Update to HarfBuzz 0.9.14, a couple of Indic and Hangul shaping bugs.
+
+xdvipdfmx:
+* Speed up calculating glyph widths in native font.
+
+* Don’t crash when /tmp is full.
+
+==============================================================
+XeTeX 0.9999.0 was released 20130311
+
+* Port OpenType layout from ICU LayoutEngine to HarfBuzz.
+ HarfBuzz is actively maintained and generally have much wider support for
+ OpenType spec, the switch fixes a number of OpenType bugs:
+ - Support version 2 OpenType Indic specs.
+ - Many other Indic OpenType bugs, and support for the latest additions to
+ OpenType spec.
+ - Incorrect application of contextual features.
+ - Incorrect kerning in fonts that has both old “kern” table and new GPOS
+ “kern” feature.
+ - Allow suppressing Latin ligatures with ZWNJ.
+ - Support for variation selectors.
+ - Support for user-specified features with complex scripts.
+
+* Port Graphite layout to from SilGraphite to HarfBuzz and Graphite2. Which
+ provides a more robust Graphite support and also fixes a number of Graphite
+ bugs.
+
+* Port AAT font layout and font searching on Mac from the deprecated ATS/ATSUI
+ to Core Text, and image support on Mac from QuickTime to ImageIO framework.
+ XeTeX can be finally built on 64-bit Mac! Work contributed by Jiang Jiang.
+
+* Add “/OT” font variant, similar to “/ICU” which is now deprecated.
+
+* Add a “shaper” font option to specify HarfBuzz shapers (for testing).
+
+* Guess script from input string if no one is given in the font definition,
+ instead of defaulting to Latin.
+
+* Support 4-letter tags for Graphite features.
+
+* Fix applying negative delta glyph advance to the last glyph in the run, fixes
+ issues with “halt” and “vhal” features.
+
+* Use \U prefix for extended math primitives, allowing XeTeX and LuaTeX to use
+ the same names for Unicode math primitives supported by both engines. The old
+ \XeTeX* primitives have been deprecated and will be removed in the future.
+
+* Support OpenType math cut ins.
+
+* Fix “\show” and “\meaning” of “\Umathchar” to a print a form that is legal
+ input.
+
+* Fix italic correction to not depend on space factor being zero for OpenType
+ fonts.
+
+* Fix sporadic shifting of extensible accents.
+
+* Fix typesetting XeTeX’s WEB code, in addition to various slight improvements.
+
+* Prefer TrueType/OpenType over Type1 fonts with the same font name.
+
+* Support input pipes, in line with other engines.
+
+* Drop support for using “()” as font names quotes since it was causing file
+ names with parenthesis not to be found.
+
+* Fix “\show” with characters outside BMP.
+
+* Print the actual character instead of hex code for characters outside BMP
+ with “\show”, “\meaning”, “\showlists” and missing char log messages.
+
+* Fix letterspacing if zero width glyphs.
+
+* Try to get cap and x height from OS/2 table first.
+
+* Reject bitmap only fonts.
+
+* Include build date in “--version” output.
+
+==============================================================
+XeTeX 0.9998 was released 20120708
+
+* Fix mismatch between fonts loaded by XeTeX and xdvipdfmx when multiple
+ versions of the font exist.
+
+* Fix “\the\textfont” with families > 15
+
+* Extend “\fam” to accept family number up to 255.
+
+* Fix build on Mac OS 10.7
+
+OpenType math:
+
+* Fix displacement of big operator's limits when “DisplayOperatorMinHeight” is
+ higher than the size of the big operator.
+
+* Fix too wide accents over accentees that has sub/superscript.
+
+* Support extensible accents for “\overbrace” etc.
+
+* Always take math constants from current font, fixes multiple math discrepancies.
+
+* Honor relevant math constants when positioning sub/superscripts.
+
+* Honor “AccentBaseHeight” when placing accents.
+
+* Support “fixed” and “bottom” keywords in “\XeTeXmathaccent” for non growing
+ and bottom accents, respectively.
+
+* Fix horizontal placement of of accents over single letters to honor their top
+ accent position value.
+
+* Fix vertical placement of sub/superscripts of single letters to not be
+ treated as non-single letters.
+
+* Support proper positioning of nested accents.
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontInst.cpp b/Build/source/texk/web2c/xetexdir/XeTeXFontInst.cpp
new file mode 100644
index 00000000000..1778858e5b9
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontInst.cpp
@@ -0,0 +1,516 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+ * file name: XeTeXFontInst.cpp
+ *
+ * created on: 2005-10-22
+ * created by: Jonathan Kew
+ *
+ * originally based on PortableFontInstance.cpp from ICU
+ */
+
+#include <w2c/config.h>
+#include <kpathsea/kpathsea.h>
+
+#include "XeTeXFontInst.h"
+#include "XeTeXLayoutInterface.h"
+#include "XeTeX_ext.h"
+
+#include <string.h>
+#include FT_GLYPH_H
+#include FT_ADVANCES_H
+
+FT_Library gFreeTypeLibrary = 0;
+
+static hb_font_funcs_t* hbFontFuncs = NULL;
+
+XeTeXFontInst::XeTeXFontInst(const char* pathname, int index, float pointSize, int &status)
+ : m_unitsPerEM(0)
+ , m_pointSize(pointSize)
+ , m_ascent(0)
+ , m_descent(0)
+ , m_capHeight(0)
+ , m_xHeight(0)
+ , m_italicAngle(0)
+ , m_vertical(false)
+ , m_filename(NULL)
+ , m_index(0)
+ , m_ftFace(0)
+ , m_hbFont(NULL)
+{
+ if (pathname != NULL)
+ initialize(pathname, index, status);
+}
+
+XeTeXFontInst::~XeTeXFontInst()
+{
+ if (m_ftFace != 0) {
+ FT_Done_Face(m_ftFace);
+ m_ftFace = 0;
+ }
+ hb_font_destroy(m_hbFont);
+ delete[] m_filename;
+}
+
+/* HarfBuzz font functions */
+
+static hb_bool_t
+_get_glyph(hb_font_t*, void *font_data, hb_codepoint_t ch, hb_codepoint_t vs, hb_codepoint_t *gid, void*)
+{
+ FT_Face face = (FT_Face) font_data;
+ *gid = 0;
+
+ if (vs)
+ *gid = FT_Face_GetCharVariantIndex (face, ch, vs);
+
+ if (*gid == 0)
+ *gid = FT_Get_Char_Index (face, ch);
+
+ return *gid != 0;
+}
+
+static FT_Fixed
+_get_glyph_advance(FT_Face face, FT_UInt gid, bool vertical)
+{
+ FT_Error error;
+ FT_Fixed advance;
+ int flags = FT_LOAD_NO_SCALE;
+
+ if (vertical)
+ flags |= FT_LOAD_VERTICAL_LAYOUT;
+
+ error = FT_Get_Advance(face, gid, flags, &advance);
+ if (error)
+ advance = 0;
+ else
+ advance = advance;
+
+ /* FreeType's vertical metrics grows downward */
+ if (vertical)
+ advance = -advance;
+
+ return advance;
+}
+
+static hb_position_t
+_get_glyph_h_advance(hb_font_t*, void *font_data, hb_codepoint_t gid, void*)
+{
+ return _get_glyph_advance((FT_Face) font_data, gid, false);
+}
+
+static hb_position_t
+_get_glyph_v_advance(hb_font_t*, void *font_data, hb_codepoint_t gid, void*)
+{
+ return _get_glyph_advance((FT_Face) font_data, gid, true);
+}
+
+static hb_bool_t
+_get_glyph_h_origin(hb_font_t*, void *font_data, hb_codepoint_t gid, hb_position_t *x, hb_position_t *y, void*)
+{
+ // horizontal origin is (0, 0)
+ return true;
+}
+
+static hb_bool_t
+_get_glyph_v_origin(hb_font_t*, void *font_data, hb_codepoint_t gid, hb_position_t *x, hb_position_t *y, void*)
+{
+ // vertical origin is (0, 0) for now
+ return true;
+
+ // TODO
+ // Keep the code below for reference, for now we want to keep vertical
+ // origin at (0, 0) for compatibility with pre-0.9999.
+ // Reconsider this (e.g. using BASE table) when we get around overhauling
+ // the text directionality model and implementing real vertical typesetting.
+
+ FT_Face face = (FT_Face) font_data;
+ FT_Error error;
+
+ error = FT_Load_Glyph (face, gid, FT_LOAD_NO_SCALE);
+ if (!error) {
+ *x = face->glyph->metrics.horiBearingX - face->glyph->metrics.vertBearingX;
+ *y = face->glyph->metrics.horiBearingY - (-face->glyph->metrics.vertBearingY);
+ }
+
+ return !error;
+}
+
+static hb_position_t
+_get_glyph_h_kerning(hb_font_t*, void *font_data, hb_codepoint_t gid1, hb_codepoint_t gid2, void*)
+{
+ FT_Face face = (FT_Face) font_data;
+ FT_Error error;
+ FT_Vector kerning;
+ hb_position_t ret;
+
+ error = FT_Get_Kerning (face, gid1, gid2, FT_KERNING_UNSCALED, &kerning);
+ if (error)
+ ret = 0;
+ else
+ ret = kerning.x;
+ return ret;
+}
+
+static hb_position_t
+_get_glyph_v_kerning(hb_font_t*, void *font_data, hb_codepoint_t gid1, hb_codepoint_t gid2, void*)
+{
+ /* FreeType does not support vertical kerning */
+ return 0;
+}
+
+static hb_bool_t
+_get_glyph_extents(hb_font_t*, void *font_data, hb_codepoint_t gid, hb_glyph_extents_t *extents, void*)
+{
+ FT_Face face = (FT_Face) font_data;
+ FT_Error error;
+
+ error = FT_Load_Glyph (face, gid, FT_LOAD_NO_SCALE);
+ if (!error) {
+ extents->x_bearing = face->glyph->metrics.horiBearingX;
+ extents->y_bearing = face->glyph->metrics.horiBearingY;
+ extents->width = face->glyph->metrics.width;
+ extents->height = -face->glyph->metrics.height;
+ }
+
+ return !error;
+}
+
+static hb_bool_t
+_get_glyph_contour_point(hb_font_t*, void *font_data, hb_codepoint_t gid, unsigned int point_index, hb_position_t *x, hb_position_t *y, void*)
+{
+ FT_Face face = (FT_Face) font_data;
+ FT_Error error;
+ bool ret = false;
+
+ error = FT_Load_Glyph (face, gid, FT_LOAD_NO_SCALE);
+ if (!error) {
+ if (face->glyph->format == FT_GLYPH_FORMAT_OUTLINE) {
+ if (point_index < (unsigned int) face->glyph->outline.n_points) {
+ *x = face->glyph->outline.points[point_index].x;
+ *y = face->glyph->outline.points[point_index].y;
+ ret = true;
+ }
+ }
+ }
+
+ return ret;
+}
+
+static hb_bool_t
+_get_glyph_name(hb_font_t *, void *font_data, hb_codepoint_t gid, char *name, unsigned int size, void *)
+{
+ FT_Face face = (FT_Face) font_data;
+ bool ret = false;
+
+ ret = !FT_Get_Glyph_Name (face, gid, name, size);
+ if (ret && (size && !*name))
+ ret = false;
+
+ return ret;
+}
+
+static hb_font_funcs_t *
+_get_font_funcs(void)
+{
+ static hb_font_funcs_t* funcs = hb_font_funcs_create();
+
+ hb_font_funcs_set_glyph_func (funcs, _get_glyph, NULL, NULL);
+ hb_font_funcs_set_glyph_h_advance_func (funcs, _get_glyph_h_advance, NULL, NULL);
+ hb_font_funcs_set_glyph_v_advance_func (funcs, _get_glyph_v_advance, NULL, NULL);
+ hb_font_funcs_set_glyph_h_origin_func (funcs, _get_glyph_h_origin, NULL, NULL);
+ hb_font_funcs_set_glyph_v_origin_func (funcs, _get_glyph_v_origin, NULL, NULL);
+ hb_font_funcs_set_glyph_h_kerning_func (funcs, _get_glyph_h_kerning, NULL, NULL);
+ hb_font_funcs_set_glyph_v_kerning_func (funcs, _get_glyph_v_kerning, NULL, NULL);
+ hb_font_funcs_set_glyph_extents_func (funcs, _get_glyph_extents, NULL, NULL);
+ hb_font_funcs_set_glyph_contour_point_func (funcs, _get_glyph_contour_point, NULL, NULL);
+ hb_font_funcs_set_glyph_name_func (funcs, _get_glyph_name, NULL, NULL);
+
+ return funcs;
+}
+
+static hb_blob_t *
+_get_table(hb_face_t *, hb_tag_t tag, void *user_data)
+{
+ FT_Face face = (FT_Face) user_data;
+ FT_ULong length = 0;
+ FT_Byte *table;
+ FT_Error error;
+ hb_blob_t* blob = NULL;
+
+ error = FT_Load_Sfnt_Table(face, tag, 0, NULL, &length);
+ if (!error) {
+ table = (FT_Byte *) xmalloc(length * sizeof(char));
+ if (table != NULL) {
+ error = FT_Load_Sfnt_Table(face, tag, 0, (FT_Byte*)table, &length);
+ if (!error) {
+ blob = hb_blob_create((const char*) table, length, HB_MEMORY_MODE_WRITABLE, table, free);
+ } else {
+ free(table);
+ }
+ }
+ }
+
+ return blob;
+}
+
+void
+XeTeXFontInst::initialize(const char* pathname, int index, int &status)
+{
+ TT_Postscript *postTable;
+ TT_OS2* os2Table;
+ FT_Error error;
+ hb_face_t *hbFace;
+
+ if (!gFreeTypeLibrary) {
+ error = FT_Init_FreeType(&gFreeTypeLibrary);
+ if (error) {
+ fprintf(stderr, "FreeType initialization failed! (%d)\n", error);
+ exit(1);
+ }
+ }
+
+ error = FT_New_Face(gFreeTypeLibrary, pathname, index, &m_ftFace);
+ if (error) {
+ status = 1;
+ return;
+ }
+
+ if (!FT_IS_SCALABLE(m_ftFace)) {
+ status = 1;
+ return;
+ }
+
+ /* for non-sfnt-packaged fonts (presumably Type 1), see if there is an AFM file we can attach */
+ if (index == 0 && !FT_IS_SFNT(m_ftFace)) {
+ char* afm = xstrdup (xbasename (pathname));
+ char* p = strrchr (afm, '.');
+ if (p != NULL && strlen(p) == 4 && tolower(*(p+1)) == 'p' &&
+ tolower(*(p+2)) == 'f')
+ strcpy(p, ".afm");
+ char *fullafm = kpse_find_file (afm, kpse_afm_format, 0);
+ free (afm);
+ if (fullafm) {
+ FT_Attach_File(m_ftFace, fullafm);
+ free (fullafm);
+ }
+ }
+
+ m_filename = xstrdup(pathname);
+ m_index = index;
+ m_unitsPerEM = m_ftFace->units_per_EM;
+ m_ascent = unitsToPoints(m_ftFace->ascender);
+ m_descent = unitsToPoints(m_ftFace->descender);
+
+ postTable = (TT_Postscript *) getFontTable(ft_sfnt_post);
+ if (postTable != NULL) {
+ m_italicAngle = Fix2D(postTable->italicAngle);
+ }
+
+ os2Table = (TT_OS2*) getFontTable(ft_sfnt_os2);
+ if (os2Table) {
+ m_capHeight = unitsToPoints(os2Table->sCapHeight);
+ m_xHeight = unitsToPoints(os2Table->sxHeight);
+ }
+
+ // Set up HarfBuzz font
+ hbFace = hb_face_create_for_tables(_get_table, m_ftFace, NULL);
+ hb_face_set_index(hbFace, index);
+ hb_face_set_upem(hbFace, m_unitsPerEM);
+ m_hbFont = hb_font_create(hbFace);
+ hb_face_destroy(hbFace);
+
+ if (hbFontFuncs == NULL)
+ hbFontFuncs = _get_font_funcs();
+
+ hb_font_set_funcs(m_hbFont, hbFontFuncs, m_ftFace, NULL);
+ hb_font_set_scale(m_hbFont, m_unitsPerEM, m_unitsPerEM);
+ // We don’t want device tables adjustments
+ hb_font_set_ppem(m_hbFont, 0, 0);
+
+ return;
+}
+
+void
+XeTeXFontInst::setLayoutDirVertical(bool vertical)
+{
+ m_vertical = vertical;
+}
+
+void *
+XeTeXFontInst::getFontTable(OTTag tag) const
+{
+ FT_ULong tmpLength = 0;
+ FT_Error error = FT_Load_Sfnt_Table(m_ftFace, tag, 0, NULL, &tmpLength);
+ if (error)
+ return NULL;
+
+ void* table = xmalloc(tmpLength * sizeof(char));
+ if (table != NULL) {
+ error = FT_Load_Sfnt_Table(m_ftFace, tag, 0, (FT_Byte*)table, &tmpLength);
+ if (error) {
+ free((void *) table);
+ return NULL;
+ }
+ }
+
+ return table;
+}
+
+void *
+XeTeXFontInst::getFontTable(FT_Sfnt_Tag tag) const
+{
+ return FT_Get_Sfnt_Table(m_ftFace, tag);
+}
+
+void
+XeTeXFontInst::getGlyphBounds(GlyphID gid, GlyphBBox* bbox)
+{
+ bbox->xMin = bbox->yMin = bbox->xMax = bbox->yMax = 0.0;
+
+ FT_Error error = FT_Load_Glyph(m_ftFace, gid, FT_LOAD_NO_SCALE);
+ if (error)
+ return;
+
+ FT_Glyph glyph;
+ error = FT_Get_Glyph(m_ftFace->glyph, &glyph);
+ if (error == 0) {
+ FT_BBox ft_bbox;
+ FT_Glyph_Get_CBox(glyph, FT_GLYPH_BBOX_UNSCALED, &ft_bbox);
+ bbox->xMin = unitsToPoints(ft_bbox.xMin);
+ bbox->yMin = unitsToPoints(ft_bbox.yMin);
+ bbox->xMax = unitsToPoints(ft_bbox.xMax);
+ bbox->yMax = unitsToPoints(ft_bbox.yMax);
+ FT_Done_Glyph(glyph);
+ }
+}
+
+GlyphID
+XeTeXFontInst::mapCharToGlyph(UChar32 ch) const
+{
+ return FT_Get_Char_Index(m_ftFace, ch);
+}
+
+uint16_t
+XeTeXFontInst::getNumGlyphs() const
+{
+ return m_ftFace->num_glyphs;
+}
+
+float
+XeTeXFontInst::getGlyphWidth(GlyphID gid)
+{
+ return unitsToPoints(_get_glyph_advance(m_ftFace, gid, false));
+}
+
+void
+XeTeXFontInst::getGlyphHeightDepth(GlyphID gid, float* ht, float* dp)
+{
+ GlyphBBox bbox;
+ getGlyphBounds(gid, &bbox);
+
+ if (ht)
+ *ht = bbox.yMax;
+ if (dp)
+ *dp = -bbox.yMin;
+}
+
+void
+XeTeXFontInst::getGlyphSidebearings(GlyphID gid, float* lsb, float* rsb)
+{
+ float width = getGlyphWidth(gid);
+
+ GlyphBBox bbox;
+ getGlyphBounds(gid, &bbox);
+
+ if (lsb)
+ *lsb = bbox.xMin;
+ if (rsb)
+ *rsb = width - bbox.xMax;
+}
+
+float
+XeTeXFontInst::getGlyphItalCorr(GlyphID gid)
+{
+ float rval = 0.0;
+
+ float width = getGlyphWidth(gid);
+
+ GlyphBBox bbox;
+ getGlyphBounds(gid, &bbox);
+
+ if (bbox.xMax > width)
+ rval = bbox.xMax - width;
+
+ return rval;
+}
+
+GlyphID
+XeTeXFontInst::mapGlyphToIndex(const char* glyphName) const
+{
+ return FT_Get_Name_Index(m_ftFace, const_cast<char*>(glyphName));
+}
+
+const char*
+XeTeXFontInst::getGlyphName(GlyphID gid, int& nameLen)
+{
+ if (FT_HAS_GLYPH_NAMES(m_ftFace)) {
+ static char buffer[256];
+ FT_Get_Glyph_Name(m_ftFace, gid, buffer, 256);
+ nameLen = strlen(buffer);
+ return &buffer[0];
+ }
+ else {
+ nameLen = 0;
+ return NULL;
+ }
+}
+
+UChar32
+XeTeXFontInst::getFirstCharCode()
+{
+ FT_UInt gindex;
+ return FT_Get_First_Char(m_ftFace, &gindex);
+}
+
+UChar32
+XeTeXFontInst::getLastCharCode()
+{
+ FT_UInt gindex;
+ UChar32 ch = FT_Get_First_Char(m_ftFace, &gindex);
+ UChar32 prev = ch;
+ while (gindex != 0) {
+ prev = ch;
+ ch = FT_Get_Next_Char(m_ftFace, ch, &gindex);
+ }
+ return prev;
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontInst.h b/Build/source/texk/web2c/xetexdir/XeTeXFontInst.h
new file mode 100644
index 00000000000..e666fa60bdc
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontInst.h
@@ -0,0 +1,129 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009, 2011 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+ * file name: XeTeXFontInst.h
+ *
+ * created on: 2005-10-22
+ * created by: Jonathan Kew
+ *
+ * originally based on PortableFontInstance.h from ICU
+ */
+
+
+#ifndef __XeTeXFontInst_H
+#define __XeTeXFontInst_H
+
+#include "XeTeXFontMgr.h"
+
+#include <stdio.h>
+#include <ft2build.h>
+#include FT_FREETYPE_H
+#include FT_TRUETYPE_TABLES_H
+
+// create specific subclasses for each supported platform
+
+class XeTeXFontInst
+{
+protected:
+ unsigned short m_unitsPerEM;
+ float m_pointSize;
+ float m_ascent;
+ float m_descent;
+ float m_capHeight;
+ float m_xHeight;
+ float m_italicAngle;
+
+ bool m_vertical; // false = horizontal, true = vertical
+
+ char *m_filename; // font filename
+ uint32_t m_index; // face index
+
+ FT_Face m_ftFace;
+ hb_font_t* m_hbFont;
+
+public:
+ XeTeXFontInst(float pointSize, int &status);
+ XeTeXFontInst(const char* filename, int index, float pointSize, int &status);
+
+ virtual ~XeTeXFontInst();
+
+ void initialize(const char* pathname, int index, int &status);
+
+ void *getFontTable(OTTag tableTag) const;
+ void *getFontTable(FT_Sfnt_Tag tableTag) const;
+
+ const char *getFilename(uint32_t* index) const
+ {
+ *index = m_index;
+ return m_filename;
+ }
+ hb_font_t *getHbFont() const { return m_hbFont; }
+ void setLayoutDirVertical(bool vertical);
+ bool getLayoutDirVertical() const { return m_vertical; };
+
+ float getPointSize() const { return m_pointSize; };
+ float getAscent() const { return m_ascent; }
+ float getDescent() const { return m_descent; }
+ float getCapHeight() const { return m_capHeight; }
+ float getXHeight() const { return m_xHeight; }
+ float getItalicAngle() const { return m_italicAngle; }
+
+ GlyphID mapCharToGlyph(UChar32 ch) const;
+ GlyphID mapGlyphToIndex(const char* glyphName) const;
+
+ uint16_t getNumGlyphs() const;
+
+ void getGlyphBounds(GlyphID glyph, GlyphBBox* bbox);
+
+ float getGlyphWidth(GlyphID glyph);
+ void getGlyphHeightDepth(GlyphID glyph, float *ht, float* dp);
+ void getGlyphSidebearings(GlyphID glyph, float* lsb, float* rsb);
+ float getGlyphItalCorr(GlyphID glyph);
+
+ const char* getGlyphName(GlyphID gid, int& nameLen);
+
+ UChar32 getFirstCharCode();
+ UChar32 getLastCharCode();
+
+ float unitsToPoints(float units) const
+ {
+ return (units * m_pointSize) / (float) m_unitsPerEM;
+ }
+
+ float pointsToUnits(float points) const
+ {
+ return (points * (float) m_unitsPerEM) / m_pointSize;
+ }
+};
+
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.cpp b/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.cpp
new file mode 100644
index 00000000000..787635c95de
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.cpp
@@ -0,0 +1,96 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+ Copyright (c) 2012-2015 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+ * file name: XeTeXFontInst_Mac.cpp
+ *
+ * created on: 2005-10-22
+ * created by: Jonathan Kew
+ */
+
+#include <w2c/config.h>
+
+#include "XeTeXFontInst_Mac.h"
+#include "XeTeX_ext.h"
+
+XeTeXFontInst_Mac::XeTeXFontInst_Mac(CTFontDescriptorRef descriptor, float pointSize, int &status)
+ : XeTeXFontInst(NULL, 0, pointSize, status)
+ , m_descriptor(descriptor)
+ , m_fontRef(0)
+{
+ initialize(status);
+}
+
+XeTeXFontInst_Mac::~XeTeXFontInst_Mac()
+{
+ if (m_descriptor != 0)
+ CFRelease(m_descriptor);
+ if (m_fontRef != 0)
+ CFRelease(m_fontRef);
+}
+
+void
+XeTeXFontInst_Mac::initialize(int &status)
+{
+ if (m_descriptor == 0) {
+ status = 1;
+ return;
+ }
+
+ if (status != 0)
+ m_descriptor = 0;
+
+ // Create a copy of original font descriptor with font cascading (fallback) disabled
+ CFArrayRef emptyCascadeList = CFArrayCreate(NULL, NULL, 0, &kCFTypeArrayCallBacks);
+ const void* values[] = { emptyCascadeList };
+ static const void* attributeKeys[] = { kCTFontCascadeListAttribute };
+ CFDictionaryRef attributes = CFDictionaryCreate(NULL, attributeKeys, values, 1,
+ &kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks);
+ CFRelease(emptyCascadeList);
+
+ m_descriptor = CTFontDescriptorCreateCopyWithAttributes(m_descriptor, attributes);
+ CFRelease(attributes);
+ m_fontRef = CTFontCreateWithFontDescriptor(m_descriptor, m_pointSize * 72.0 / 72.27, NULL);
+ if (m_fontRef) {
+ char *pathname;
+ uint32_t index;
+ pathname = getFileNameFromCTFont(m_fontRef, &index);
+
+ XeTeXFontInst::initialize(pathname, index, status);
+ } else {
+ status = 1;
+ CFRelease(m_descriptor);
+ m_descriptor = 0;
+ }
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.h b/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.h
new file mode 100644
index 00000000000..45009faf83b
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontInst_Mac.h
@@ -0,0 +1,63 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+ * file name: XeTeXFontInst_Mac.h
+ *
+ * created on: 2005-10-22
+ * created by: Jonathan Kew
+ */
+
+
+#ifndef __XeTeXFontInst_Mac_H
+#define __XeTeXFontInst_Mac_H
+
+#include "XeTeXFontInst.h"
+
+#include <ApplicationServices/ApplicationServices.h>
+
+class XeTeXFontInst_Mac : public XeTeXFontInst
+{
+protected:
+ CTFontDescriptorRef m_descriptor;
+ CTFontRef m_fontRef;
+
+public:
+ XeTeXFontInst_Mac(CTFontDescriptorRef descriptor, float pointSize, int &status);
+
+ virtual ~XeTeXFontInst_Mac();
+
+ virtual void initialize(int &status);
+};
+
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.cpp b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.cpp
new file mode 100644
index 00000000000..11094b10b47
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.cpp
@@ -0,0 +1,661 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2014 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include "XeTeX_web.h"
+
+#ifdef XETEX_MAC
+#include "XeTeXFontMgr_Mac.h"
+#else
+#include "XeTeXFontMgr_FC.h"
+#endif
+#include "XeTeXFontInst.h"
+
+#include <hb-ot.h>
+
+// see cpascal.h
+#define printcstring(STR) \
+ do { \
+ const char* ch_ptr = (STR); \
+ while (*ch_ptr) \
+ zprintchar(*(ch_ptr++)); \
+ } while (0)
+
+XeTeXFontMgr* XeTeXFontMgr::sFontManager = NULL;
+char XeTeXFontMgr::sReqEngine = 0;
+
+/* use our own fmax function because it seems to be missing on certain platforms
+ (solaris2.9, at least) */
+static inline double
+my_fmax(double x, double y)
+{
+ return (x > y) ? x : y;
+}
+
+XeTeXFontMgr*
+XeTeXFontMgr::GetFontManager()
+{
+ if (sFontManager == NULL) {
+#ifdef XETEX_MAC
+ sFontManager = new XeTeXFontMgr_Mac;
+#else
+ sFontManager = new XeTeXFontMgr_FC;
+#endif
+ sFontManager->initialize();
+ }
+
+ return sFontManager;
+}
+
+void
+XeTeXFontMgr::Terminate()
+{
+ if (sFontManager != NULL) {
+ sFontManager->terminate();
+ // we don't actually deallocate the manager, just ask it to clean up
+ // any auxiliary data such as the cocoa pool or freetype/fontconfig stuff
+ // as we still need to access font names after this is called
+ }
+}
+
+PlatformFontRef
+XeTeXFontMgr::findFont(const char* name, char* variant, double ptSize)
+ // ptSize is in TeX points, or negative for 'scaled' factor
+ // "variant" string will be shortened (in-place) by removal of /B and /I if present
+{
+ std::string nameStr(name);
+ Font* font = NULL;
+ double dsize = 10.0;
+ loadedfontdesignsize = 655360L;
+
+ for (int pass = 0; pass < 2; ++pass) {
+ // try full name as given
+ std::map<std::string,Font*>::iterator i = m_nameToFont.find(nameStr);
+ if (i != m_nameToFont.end()) {
+ font = i->second;
+ if (font->opSizeInfo.designSize != 0.0)
+ dsize = font->opSizeInfo.designSize;
+ break;
+ }
+
+ // if there's a hyphen, split there and try Family-Style
+ int hyph = nameStr.find('-');
+ if (hyph > 0 && hyph < nameStr.length() - 1) {
+ std::string family(nameStr.begin(), nameStr.begin() + hyph);
+ std::map<std::string,Family*>::iterator f = m_nameToFamily.find(family);
+ if (f != m_nameToFamily.end()) {
+ std::string style(nameStr.begin() + hyph + 1, nameStr.end());
+ i = f->second->styles->find(style);
+ if (i != f->second->styles->end()) {
+ font = i->second;
+ if (font->opSizeInfo.designSize != 0.0)
+ dsize = font->opSizeInfo.designSize;
+ break;
+ }
+ }
+ }
+
+ // try as PostScript name
+ i = m_psNameToFont.find(nameStr);
+ if (i != m_psNameToFont.end()) {
+ font = i->second;
+ if (font->opSizeInfo.designSize != 0.0)
+ dsize = font->opSizeInfo.designSize;
+ break;
+ }
+
+ // try for the name as a family name
+ std::map<std::string,Family*>::iterator f = m_nameToFamily.find(nameStr);
+
+ if (f != m_nameToFamily.end()) {
+ // look for a family member with the "regular" bit set in OS/2
+ int regFonts = 0;
+ for (i = f->second->styles->begin(); i != f->second->styles->end(); ++i)
+ if (i->second->isReg) {
+ if (regFonts == 0)
+ font = i->second;
+ ++regFonts;
+ }
+
+ // families with Ornament or similar fonts may flag those as Regular,
+ // which confuses the search above... so try some known names
+ if (font == NULL || regFonts > 1) {
+ // try for style "Regular", "Plain", "Normal", "Roman"
+ i = f->second->styles->find("Regular");
+ if (i != f->second->styles->end())
+ font = i->second;
+ else {
+ i = f->second->styles->find("Plain");
+ if (i != f->second->styles->end())
+ font = i->second;
+ else {
+ i = f->second->styles->find("Normal");
+ if (i != f->second->styles->end())
+ font = i->second;
+ else {
+ i = f->second->styles->find("Roman");
+ if (i != f->second->styles->end())
+ font = i->second;
+ }
+ }
+ }
+ }
+
+ if (font == NULL) {
+ // look through the family for the (weight, width, slant) nearest to (80, 100, 0)
+ font = bestMatchFromFamily(f->second, 80, 100, 0);
+ }
+
+ if (font != NULL)
+ break;
+ }
+
+ if (pass == 0) {
+ // didn't find it in our caches, so do a platform search (may be relatively expensive);
+ // this will update the caches with any fonts that seem to match the name given,
+ // so that the second pass might find it
+ searchForHostPlatformFonts(nameStr);
+ }
+ }
+
+ if (font == NULL)
+ return 0;
+
+ Family* parent = font->parent;
+
+ // if there are variant requests, try to apply them
+ // and delete B, I, and S=... codes from the string, just retain /engine option
+ sReqEngine = 0;
+ bool reqBold = false;
+ bool reqItal = false;
+ if (variant != NULL) {
+ std::string varString;
+ char* cp = variant;
+ while (*cp) {
+ if (strncmp(cp, "AAT", 3) == 0) {
+ sReqEngine = 'A';
+ cp += 3;
+ if (varString.length() > 0 && *(varString.end() - 1) != '/')
+ varString.append("/");
+ varString.append("AAT");
+ goto skip_to_slash;
+ }
+ if (strncmp(cp, "ICU", 3) == 0) { // for backword compatability
+ sReqEngine = 'O';
+ cp += 3;
+ if (varString.length() > 0 && *(varString.end() - 1) != '/')
+ varString.append("/");
+ varString.append("OT");
+ goto skip_to_slash;
+ }
+ if (strncmp(cp, "OT", 2) == 0) {
+ sReqEngine = 'O';
+ cp += 2;
+ if (varString.length() > 0 && *(varString.end() - 1) != '/')
+ varString.append("/");
+ varString.append("OT");
+ goto skip_to_slash;
+ }
+ if (strncmp(cp, "GR", 2) == 0) {
+ sReqEngine = 'G';
+ cp += 2;
+ if (varString.length() > 0 && *(varString.end() - 1) != '/')
+ varString.append("/");
+ varString.append("GR");
+ goto skip_to_slash;
+ }
+ if (*cp == 'S') {
+ ++cp;
+ if (*cp == '=')
+ ++cp;
+ ptSize = 0.0;
+ while (*cp >= '0' && *cp <= '9') {
+ ptSize = ptSize * 10 + *cp - '0';
+ ++cp;
+ }
+ if (*cp == '.') {
+ double dec = 1.0;
+ ++cp;
+ while (*cp >= '0' && *cp <= '9') {
+ dec = dec * 10.0;
+ ptSize = ptSize + (*cp - '0') / dec;
+ ++cp;
+ }
+ }
+ goto skip_to_slash;
+ }
+
+ /* if the code is "B" or "I", we skip putting it in varString */
+ while (1) {
+ if (*cp == 'B') {
+ reqBold = true;
+ ++cp;
+ continue;
+ }
+ if (*cp == 'I') {
+ reqItal = true;
+ ++cp;
+ continue;
+ }
+ break;
+ }
+
+ skip_to_slash:
+ while (*cp && *cp != '/')
+ ++cp;
+ if (*cp == '/')
+ ++cp;
+ }
+ strcpy(variant, varString.c_str());
+
+ std::map<std::string,Font*>::iterator i;
+ if (reqItal) {
+ Font* bestMatch = font;
+ if (font->slant < parent->maxSlant)
+ // try for a face with more slant
+ bestMatch = bestMatchFromFamily(parent, font->weight, font->width, parent->maxSlant);
+
+ if (bestMatch == font && font->slant > parent->minSlant)
+ // maybe the slant is negated, or maybe this was something like "Times-Italic/I"
+ bestMatch = bestMatchFromFamily(parent, font->weight, font->width, parent->minSlant);
+
+ if (parent->minWeight == parent->maxWeight && bestMatch->isBold != font->isBold) {
+ // try again using the bold flag, as we can't trust weight values
+ Font* newBest = NULL;
+ for (i = parent->styles->begin(); i != parent->styles->end(); ++i) {
+ if (i->second->isBold == font->isBold) {
+ if (newBest == NULL && i->second->isItalic != font->isItalic) {
+ newBest = i->second;
+ break;
+ }
+ }
+ }
+ if (newBest != NULL)
+ bestMatch = newBest;
+ }
+
+ if (bestMatch == font) {
+ // maybe slant values weren't present; try the style bits as a fallback
+ bestMatch = NULL;
+ for (i = parent->styles->begin(); i != parent->styles->end(); ++i) {
+ if (i->second->isItalic == !font->isItalic) {
+ if (parent->minWeight != parent->maxWeight) {
+ // weight info was available, so try to match that
+ if (bestMatch == NULL || weightAndWidthDiff(i->second, font) < weightAndWidthDiff(bestMatch, font))
+ bestMatch = i->second;
+ } else {
+ // no weight info, so try matching style bits
+ if (bestMatch == NULL && i->second->isBold == font->isBold) {
+ bestMatch = i->second;
+ break; // found a match, no need to look further as we can't distinguish!
+ }
+ }
+ }
+ }
+ }
+ if (bestMatch != NULL)
+ font = bestMatch;
+ }
+
+ if (reqBold) {
+ // try for more boldness, with the same width and slant
+ Font* bestMatch = font;
+ if (font->weight < parent->maxWeight) {
+ // try to increase weight by 1/2 x (max - min), rounding up
+ bestMatch = bestMatchFromFamily(parent,
+ font->weight + (parent->maxWeight - parent->minWeight) / 2 + 1,
+ font->width, font->slant);
+ if (parent->minSlant == parent->maxSlant) {
+ // double-check the italic flag, as we can't trust slant values
+ Font* newBest = NULL;
+ for (i = parent->styles->begin(); i != parent->styles->end(); ++i) {
+ if (i->second->isItalic == font->isItalic) {
+ if (newBest == NULL || weightAndWidthDiff(i->second, bestMatch) < weightAndWidthDiff(newBest, bestMatch))
+ newBest = i->second;
+ }
+ }
+ if (newBest != NULL)
+ bestMatch = newBest;
+ }
+ }
+ if (bestMatch == font && !font->isBold) {
+ for (i = parent->styles->begin(); i != parent->styles->end(); ++i) {
+ if (i->second->isItalic == font->isItalic && i->second->isBold) {
+ bestMatch = i->second;
+ break;
+ }
+ }
+ }
+ font = bestMatch;
+ }
+ }
+
+ // if there's optical size info, try to apply it
+ if (ptSize < 0.0)
+ ptSize = dsize;
+ if (font != NULL && font->opSizeInfo.subFamilyID != 0 && ptSize > 0.0) {
+ double bestMismatch = my_fmax(font->opSizeInfo.minSize - ptSize, ptSize - font->opSizeInfo.maxSize);
+ if (bestMismatch > 0.0) {
+ Font* bestMatch = font;
+ for (std::map<std::string,Font*>::iterator i = parent->styles->begin(); i != parent->styles->end(); ++i) {
+ if (i->second->opSizeInfo.subFamilyID != font->opSizeInfo.subFamilyID)
+ continue;
+ double mismatch = my_fmax(i->second->opSizeInfo.minSize - ptSize, ptSize - i->second->opSizeInfo.maxSize);
+ if (mismatch < bestMismatch) {
+ bestMatch = i->second;
+ bestMismatch = mismatch;
+ }
+ if (bestMismatch <= 0.0)
+ break;
+ }
+ font = bestMatch;
+ }
+ }
+
+ if (font != NULL && font->opSizeInfo.designSize != 0.0)
+ loadedfontdesignsize = unsigned(font->opSizeInfo.designSize * 65536.0 + 0.5);
+
+ if (gettracingfontsstate() > 0) {
+ begindiagnostic();
+ zprintnl(' ');
+ printcstring("-> ");
+ printcstring(getPlatformFontDesc(font->fontRef).c_str());
+ zenddiagnostic(0);
+ }
+
+ return font->fontRef;
+}
+
+const char*
+XeTeXFontMgr::getFullName(PlatformFontRef font) const
+{
+ std::map<PlatformFontRef,Font*>::const_iterator i = m_platformRefToFont.find(font);
+ if (i == m_platformRefToFont.end())
+ die("internal error %d in XeTeXFontMgr", 2);
+ if (i->second->m_fullName != NULL)
+ return i->second->m_fullName->c_str();
+ else
+ return i->second->m_psName->c_str();
+}
+
+int
+XeTeXFontMgr::weightAndWidthDiff(const Font* a, const Font* b) const
+{
+ if (a->weight == 0 && a->width == 0) {
+ // assume there was no OS/2 info
+ if (a->isBold == b->isBold)
+ return 0;
+ else
+ return 10000;
+ }
+
+ int widDiff = labs(a->width - b->width);
+ if (widDiff < 10)
+ widDiff *= 50;
+
+ return labs(a->weight - b->weight) + widDiff;
+}
+
+int
+XeTeXFontMgr::styleDiff(const Font* a, int wt, int wd, int slant) const
+{
+ int widDiff = labs(a->width - wd);
+ if (widDiff < 10)
+ widDiff *= 200;
+
+ return labs(labs(a->slant) - labs(slant)) * 2 + labs(a->weight - wt) + widDiff;
+}
+
+XeTeXFontMgr::Font*
+XeTeXFontMgr::bestMatchFromFamily(const Family* fam, int wt, int wd, int slant) const
+{
+ Font* bestMatch = NULL;
+ for (std::map<std::string,Font*>::iterator s = fam->styles->begin(); s != fam->styles->end(); ++s)
+ if (bestMatch == NULL || styleDiff(s->second, wt, wd, slant) < styleDiff(bestMatch, wt, wd, slant))
+ bestMatch = s->second;
+ return bestMatch;
+}
+
+const XeTeXFontMgr::OpSizeRec*
+XeTeXFontMgr::getOpSize(XeTeXFont font)
+{
+ hb_font_t* hbFont = ((XeTeXFontInst*)font)->getHbFont();
+ if (hbFont != NULL) {
+ hb_face_t* face = hb_font_get_face(hbFont);
+ OpSizeRec* pSizeRec = (OpSizeRec*) xmalloc(sizeof(OpSizeRec));
+
+ unsigned int designSize, minSize, maxSize;
+ bool ok = hb_ot_layout_get_size_params(face,
+ &designSize,
+ &pSizeRec->subFamilyID,
+ &pSizeRec->nameCode,
+ &minSize,
+ &maxSize);
+
+ if (ok) {
+ // Convert sizes from PostScript deci-points to TeX points
+ pSizeRec->designSize = designSize * 72.27 / 72.0 / 10.0;
+ pSizeRec->minSize = minSize * 72.27 / 72.0 / 10.0;
+ pSizeRec->maxSize = maxSize * 72.27 / 72.0 / 10.0;
+ return pSizeRec;
+ }
+
+ free(pSizeRec);
+ return NULL;
+ }
+
+ return NULL;
+}
+
+double
+XeTeXFontMgr::getDesignSize(XeTeXFont font)
+{
+ const OpSizeRec* pSizeRec = getOpSize(font);
+ if (pSizeRec != NULL)
+ return pSizeRec->designSize;
+ else
+ return 10.0;
+}
+
+void
+XeTeXFontMgr::getOpSizeRecAndStyleFlags(Font* theFont)
+{
+ XeTeXFont font = createFont(theFont->fontRef, 655360);
+ XeTeXFontInst* fontInst = (XeTeXFontInst*) font;
+ if (font != 0) {
+ const OpSizeRec* pSizeRec = getOpSize(font);
+ if (pSizeRec != NULL) {
+ theFont->opSizeInfo.designSize = pSizeRec->designSize;
+ if (pSizeRec->subFamilyID == 0
+ && pSizeRec->nameCode == 0
+ && pSizeRec->minSize == 0.0
+ && pSizeRec->maxSize == 0.0)
+ goto done_size; // feature is valid, but no 'size' range
+ theFont->opSizeInfo.subFamilyID = pSizeRec->subFamilyID;
+ theFont->opSizeInfo.nameCode = pSizeRec->nameCode;
+ theFont->opSizeInfo.minSize = pSizeRec->minSize;
+ theFont->opSizeInfo.maxSize = pSizeRec->maxSize;
+ }
+ done_size:
+
+ const TT_OS2* os2Table = (TT_OS2*) fontInst->getFontTable(ft_sfnt_os2);
+ if (os2Table != NULL) {
+ theFont->weight = os2Table->usWeightClass;
+ theFont->width = os2Table->usWidthClass;
+ uint16_t sel = os2Table->fsSelection;
+ theFont->isReg = (sel & (1 << 6)) != 0;
+ theFont->isBold = (sel & (1 << 5)) != 0;
+ theFont->isItalic = (sel & (1 << 0)) != 0;
+ }
+
+ const TT_Header* headTable = (TT_Header*) fontInst->getFontTable(ft_sfnt_head);
+ if (headTable != NULL) {
+ uint16_t ms = headTable->Mac_Style;
+ if ((ms & (1 << 0)) != 0)
+ theFont->isBold = true;
+ if ((ms & (1 << 1)) != 0)
+ theFont->isItalic = true;
+ }
+
+ const TT_Postscript* postTable = (const TT_Postscript*) fontInst->getFontTable(ft_sfnt_post);
+ if (postTable != NULL) {
+ theFont->slant = (int)(1000 * (tan(Fix2D(-postTable->italicAngle) * M_PI / 180.0)));
+ }
+ deleteFont(font);
+ }
+}
+
+// append a name but only if it's not already in the list
+void
+XeTeXFontMgr::appendToList(std::list<std::string>* list, const char* str)
+{
+ for (std::list<std::string>::const_iterator i = list->begin(); i != list->end(); ++i)
+ if (*i == str)
+ return;
+ list->push_back(str);
+}
+
+// prepend a name, removing it from later in the list if present
+void
+XeTeXFontMgr::prependToList(std::list<std::string>* list, const char* str)
+{
+ for (std::list<std::string>::iterator i = list->begin(); i != list->end(); ++i)
+ if (*i == str) {
+ list->erase(i);
+ break;
+ }
+ list->push_front(str);
+}
+
+void
+XeTeXFontMgr::addToMaps(PlatformFontRef platformFont, const NameCollection* names)
+{
+ if (m_platformRefToFont.find(platformFont) != m_platformRefToFont.end())
+ return; // this font has already been cached
+
+ if (names->m_psName.length() == 0)
+ return; // can't use a font that lacks a PostScript name
+
+ if (m_psNameToFont.find(names->m_psName) != m_psNameToFont.end())
+ return; // duplicates an earlier PS name, so skip
+
+ Font* thisFont = new Font(platformFont);
+ thisFont->m_psName = new std::string(names->m_psName);
+ getOpSizeRecAndStyleFlags(thisFont);
+
+ m_psNameToFont[names->m_psName] = thisFont;
+ m_platformRefToFont[platformFont] = thisFont;
+
+ if (names->m_fullNames.size() > 0)
+ thisFont->m_fullName = new std::string(*(names->m_fullNames.begin()));
+
+ if (names->m_familyNames.size() > 0)
+ thisFont->m_familyName = new std::string(*(names->m_familyNames.begin()));
+ else
+ thisFont->m_familyName = new std::string(names->m_psName);
+
+ if (names->m_styleNames.size() > 0)
+ thisFont->m_styleName = new std::string(*(names->m_styleNames.begin()));
+ else
+ thisFont->m_styleName = new std::string;
+
+ std::list<std::string>::const_iterator i;
+ for (i = names->m_familyNames.begin(); i != names->m_familyNames.end(); ++i) {
+ std::map<std::string,Family*>::iterator iFam = m_nameToFamily.find(*i);
+ Family* family;
+ if (iFam == m_nameToFamily.end()) {
+ family = new Family;
+ m_nameToFamily[*i] = family;
+ family->minWeight = thisFont->weight;
+ family->maxWeight = thisFont->weight;
+ family->minWidth = thisFont->width;
+ family->maxWidth = thisFont->width;
+ family->minSlant = thisFont->slant;
+ family->maxSlant = thisFont->slant;
+ } else {
+ family = iFam->second;
+ if (thisFont->weight < family->minWeight)
+ family->minWeight = thisFont->weight;
+ if (thisFont->weight > family->maxWeight)
+ family->maxWeight = thisFont->weight;
+ if (thisFont->width < family->minWidth)
+ family->minWidth = thisFont->width;
+ if (thisFont->width > family->maxWidth)
+ family->maxWidth = thisFont->width;
+ if (thisFont->slant < family->minSlant)
+ family->minSlant = thisFont->slant;
+ if (thisFont->slant > family->maxSlant)
+ family->maxSlant = thisFont->slant;
+ }
+
+ if (thisFont->parent == NULL)
+ thisFont->parent = family;
+
+ // ensure all style names in the family point to thisFont
+ for (std::list<std::string>::const_iterator j = names->m_styleNames.begin(); j != names->m_styleNames.end(); ++j) {
+ std::map<std::string,Font*>::iterator iFont = family->styles->find(*j);
+ if (iFont == family->styles->end())
+ (*family->styles)[*j] = thisFont;
+/*
+ else if (iFont->second != thisFont)
+ fprintf(stderr, "# Font name warning: ambiguous Style \"%s\" in Family \"%s\" (PSNames \"%s\" and \"%s\")\n",
+ j->c_str(), i->c_str(), iFont->second->m_psName->c_str(), thisFont->m_psName->c_str());
+*/
+ }
+ }
+
+ for (i = names->m_fullNames.begin(); i != names->m_fullNames.end(); ++i) {
+ std::map<std::string,Font*>::iterator iFont = m_nameToFont.find(*i);
+ if (iFont == m_nameToFont.end())
+ m_nameToFont[*i] = thisFont;
+/*
+ else if (iFont->second != thisFont)
+ fprintf(stderr, "# Font name warning: ambiguous FullName \"%s\" (PSNames \"%s\" and \"%s\")\n",
+ i->c_str(), iFont->second->m_psName->c_str(), thisFont->m_psName->c_str());
+*/
+ }
+}
+
+void
+XeTeXFontMgr::die(const char*s, int i) const
+{
+ fprintf(stderr, s, i);
+ fprintf(stderr, " - exiting\n");
+ exit(3);
+}
+
+void
+XeTeXFontMgr::terminate()
+{
+}
+
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.h b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.h
new file mode 100644
index 00000000000..52a2701a205
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr.h
@@ -0,0 +1,204 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEX_FONT_MANAGER_H
+#define __XETEX_FONT_MANAGER_H
+
+#ifdef XETEX_MAC
+#include <ApplicationServices/ApplicationServices.h>
+typedef CTFontDescriptorRef PlatformFontRef;
+#else
+#include <fontconfig/fontconfig.h>
+#include <ft2build.h>
+#include FT_FREETYPE_H
+typedef FcPattern* PlatformFontRef;
+#endif
+
+#include "XeTeX_ext.h"
+
+#include "XeTeXLayoutInterface.h"
+
+#ifdef __cplusplus /* allow inclusion in plain C files just to get the typedefs above */
+
+#include <string>
+#include <map>
+#include <list>
+#include <vector>
+
+class XeTeXFontMgr
+{
+public:
+ static XeTeXFontMgr* GetFontManager();
+ // returns the global fontmanager (creating it if necessary)
+ static void Terminate();
+ // clean up (may be required if using the cocoa implementation)
+
+ PlatformFontRef findFont(const char* name, char* variant, double ptSize);
+ // 1st arg is name as specified by user (C string, UTF-8)
+ // 2nd is /B/I/AAT/OT/ICU/GR/S=## qualifiers
+ // 1. try name given as "full name"
+ // 2. if there's a hyphen, split and try "family-style"
+ // 3. try as PostScript name
+ // 4. try name as family with "Regular/Plain/Normal" style
+ // apply style qualifiers and optical sizing if present
+
+ // SIDE EFFECT: sets sReqEngine to 'A' or 'O' or 'G' if appropriate,
+ // else clears it to 0
+
+ // SIDE EFFECT: updates TeX variables /nameoffile/ and /namelength/,
+ // to match the actual font found
+
+ // SIDE EFFECT: edits /variant/ string in-place removing /B or /I
+
+ const char* getFullName(PlatformFontRef font) const;
+ // return the full name of the font, suitable for use in XeTeX source
+ // without requiring style qualifiers
+
+ double getDesignSize(XeTeXFont font);
+
+ char getReqEngine() const { return sReqEngine; };
+ // return the requested rendering technology for the most recent findFont
+ // or 0 if no specific technology was requested
+
+ void setReqEngine(char reqEngine) const { sReqEngine = reqEngine; };
+
+protected:
+ static XeTeXFontMgr* sFontManager;
+ static char sReqEngine;
+
+ XeTeXFontMgr()
+ { }
+ virtual ~XeTeXFontMgr()
+ { }
+
+ virtual void initialize() = 0;
+ virtual void terminate();
+
+ virtual std::string getPlatformFontDesc(PlatformFontRef font) const = 0;
+
+ class Font;
+ class Family;
+
+ struct OpSizeRec {
+ double designSize;
+ double minSize;
+ double maxSize;
+ unsigned int subFamilyID;
+ unsigned int nameCode;
+ };
+
+ class Font {
+ public:
+ Font(PlatformFontRef ref)
+ : m_fullName(NULL), m_psName(NULL), m_familyName(NULL), m_styleName(NULL)
+ , parent(NULL)
+ , fontRef(ref), weight(0), width(0), slant(0)
+ , isReg(false), isBold(false), isItalic(false)
+ { opSizeInfo.subFamilyID = 0;
+ opSizeInfo.designSize = 10.0; } /* default to 10.0pt */
+ ~Font()
+ { delete m_fullName; delete m_psName; }
+
+ std::string* m_fullName;
+ std::string* m_psName;
+ std::string* m_familyName; // default family and style names that should locate this font
+ std::string* m_styleName;
+ Family* parent;
+ PlatformFontRef fontRef;
+ OpSizeRec opSizeInfo;
+ uint16_t weight;
+ uint16_t width;
+ int16_t slant;
+ bool isReg;
+ bool isBold;
+ bool isItalic;
+ };
+
+ class Family {
+ public:
+ Family()
+ : minWeight(0), maxWeight(0)
+ , minWidth(0), maxWidth(0)
+ , minSlant(0), maxSlant(0)
+ {
+ styles = new std::map<std::string,Font*>;
+ }
+ ~Family()
+ {
+ delete styles;
+ }
+
+ std::map<std::string,Font*>* styles;
+ uint16_t minWeight;
+ uint16_t maxWeight;
+ uint16_t minWidth;
+ uint16_t maxWidth;
+ int16_t minSlant;
+ int16_t maxSlant;
+ };
+
+ class NameCollection {
+ public:
+ std::list<std::string> m_familyNames;
+ std::list<std::string> m_styleNames;
+ std::list<std::string> m_fullNames;
+ std::string m_psName;
+ std::string m_subFamily;
+ };
+
+ std::map<std::string,Font*> m_nameToFont; // maps full name (as used in TeX source) to font record
+ std::map<std::string,Family*> m_nameToFamily;
+ std::map<PlatformFontRef,Font*> m_platformRefToFont;
+ std::map<std::string,Font*> m_psNameToFont; // maps PS name (as used in .xdv) to font record
+
+ int weightAndWidthDiff(const Font* a, const Font* b) const;
+ int styleDiff(const Font* a, int wt, int wd, int slant) const;
+ Font* bestMatchFromFamily(const Family* fam, int wt, int wd, int slant) const;
+ void appendToList(std::list<std::string>* list, const char* str);
+ void prependToList(std::list<std::string>* list, const char* str);
+ void addToMaps(PlatformFontRef platformFont, const NameCollection* names);
+
+ const OpSizeRec* getOpSize(XeTeXFont font);
+
+ virtual void getOpSizeRecAndStyleFlags(Font* theFont);
+ virtual void searchForHostPlatformFonts(const std::string& name) = 0;
+
+ virtual NameCollection* readNames(PlatformFontRef fontRef) = 0;
+
+ void die(const char*s, int i) const; /* for fatal internal errors! */
+};
+
+#endif /* __cplusplus */
+
+
+#endif /* __XETEX_FONT_MANAGER_H */
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.cpp b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.cpp
new file mode 100644
index 00000000000..448e4fbdfb4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.cpp
@@ -0,0 +1,362 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009, 2011 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include "XeTeXFontMgr_FC.h"
+
+/* allow compilation with old Fontconfig header */
+#ifndef FC_FULLNAME
+#define FC_FULLNAME "fullname"
+#endif
+
+#include FT_SFNT_NAMES_H
+#include FT_TRUETYPE_IDS_H
+
+#include <unicode/ucnv.h>
+
+#define kFontFamilyName 1
+#define kFontStyleName 2
+#define kFontFullName 4
+#define kPreferredFamilyName 16
+#define kPreferredSubfamilyName 17
+
+static UConverter* macRomanConv = NULL;
+static UConverter* utf16beConv = NULL;
+static UConverter* utf8Conv = NULL;
+
+static char*
+convertToUtf8(UConverter* conv, const unsigned char* name, int len)
+{
+ char* buffer1 = NULL;
+ char* buffer2 = NULL;
+ int bufSize = -1;
+
+ if (2 * (len + 1) > bufSize) {
+ if (buffer1 != NULL) {
+ delete[] buffer1;
+ delete[] buffer2;
+ }
+ bufSize = 2 * len + 100;
+ buffer1 = new char[bufSize];
+ buffer2 = new char[bufSize];
+ }
+
+ UErrorCode status = U_ZERO_ERROR;
+ len = ucnv_toUChars(conv, (UChar*)buffer1, bufSize, (const char*)name, len, &status);
+ len = ucnv_fromUChars(utf8Conv, buffer2, bufSize, (UChar*)buffer1, len, &status);
+ buffer2[len] = 0;
+
+ delete[] buffer1;
+ return buffer2;
+}
+
+XeTeXFontMgr::NameCollection*
+XeTeXFontMgr_FC::readNames(FcPattern* pat)
+{
+ NameCollection* names = new NameCollection;
+
+ char* pathname;
+ if (FcPatternGetString(pat, FC_FILE, 0, (FcChar8**)&pathname) != FcResultMatch)
+ return names;
+ int index;
+ if (FcPatternGetInteger(pat, FC_INDEX, 0, &index) != FcResultMatch)
+ return names;
+
+ FT_Face face;
+ if (FT_New_Face(gFreeTypeLibrary, pathname, index, &face) != 0)
+ return names;
+
+ const char* name = FT_Get_Postscript_Name(face);
+ if (name == NULL)
+ return names;
+ names->m_psName = name;
+
+ // for sfnt containers, we'll read the name table ourselves, not rely on Fontconfig
+ if (FT_IS_SFNT(face)) {
+ std::list<std::string> familyNames;
+ std::list<std::string> subFamilyNames;
+ FT_SfntName nameRec;
+ for (index = 0; index < FT_Get_Sfnt_Name_Count(face); ++index) {
+ char* utf8name = NULL;
+ if (FT_Get_Sfnt_Name(face, index, &nameRec) != 0)
+ continue;
+ switch (nameRec.name_id) {
+ case kFontFullName:
+ case kFontFamilyName:
+ case kFontStyleName:
+ case kPreferredFamilyName:
+ case kPreferredSubfamilyName:
+ {
+ bool preferredName = false;
+ if (nameRec.platform_id == TT_PLATFORM_MACINTOSH
+ && nameRec.encoding_id == TT_MAC_ID_ROMAN && nameRec.language_id == 0) {
+ utf8name = convertToUtf8(macRomanConv, nameRec.string, nameRec.string_len);
+ preferredName = true;
+ }
+ else if ((nameRec.platform_id == TT_PLATFORM_APPLE_UNICODE)
+ || (nameRec.platform_id == TT_PLATFORM_MICROSOFT))
+ utf8name = convertToUtf8(utf16beConv, nameRec.string, nameRec.string_len);
+
+ if (utf8name != NULL) {
+ std::list<std::string>* nameList = NULL;
+ switch (nameRec.name_id) {
+ case kFontFullName:
+ nameList = &names->m_fullNames;
+ break;
+ case kFontFamilyName:
+ nameList = &names->m_familyNames;
+ break;
+ case kFontStyleName:
+ nameList = &names->m_styleNames;
+ break;
+ case kPreferredFamilyName:
+ nameList = &familyNames;
+ break;
+ case kPreferredSubfamilyName:
+ nameList = &subFamilyNames;
+ break;
+ }
+ if (preferredName)
+ prependToList(nameList, utf8name);
+ else
+ appendToList(nameList, utf8name);
+ delete[] utf8name;
+ }
+ }
+ break;
+ }
+ }
+ if (familyNames.size() > 0)
+ names->m_familyNames = familyNames;
+ if (subFamilyNames.size() > 0)
+ names->m_styleNames = subFamilyNames;
+ } else {
+ index = 0;
+ while (FcPatternGetString(pat, FC_FULLNAME, index++, (FcChar8**)&name) == FcResultMatch)
+ appendToList(&names->m_fullNames, name);
+ index = 0;
+ while (FcPatternGetString(pat, FC_FAMILY, index++, (FcChar8**)&name) == FcResultMatch)
+ appendToList(&names->m_familyNames, name);
+ index = 0;
+ while (FcPatternGetString(pat, FC_STYLE, index++, (FcChar8**)&name) == FcResultMatch)
+ appendToList(&names->m_styleNames, name);
+
+ if (names->m_fullNames.size() == 0) {
+ std::string fullName(names->m_familyNames.front());
+ if (names->m_styleNames.size() > 0) {
+ fullName += " ";
+ fullName += names->m_styleNames.front();
+ }
+ names->m_fullNames.push_back(fullName);
+ }
+ }
+
+ FT_Done_Face(face);
+
+ return names;
+}
+
+void
+XeTeXFontMgr_FC::getOpSizeRecAndStyleFlags(Font* theFont)
+{
+ XeTeXFontMgr::getOpSizeRecAndStyleFlags(theFont);
+
+ if (theFont->weight == 0 && theFont->width == 0) {
+ // try to get values from FontConfig, as it apparently wasn't an sfnt
+ FcPattern* pat = theFont->fontRef;
+ int value;
+ if (FcPatternGetInteger(pat, FC_WEIGHT, 0, &value) == FcResultMatch)
+ theFont->weight = value;
+ if (FcPatternGetInteger(pat, FC_WIDTH, 0, &value) == FcResultMatch)
+ theFont->width = value;
+ if (FcPatternGetInteger(pat, FC_SLANT, 0, &value) == FcResultMatch)
+ theFont->slant = value;
+ }
+}
+
+void
+XeTeXFontMgr_FC::cacheFamilyMembers(const std::list<std::string>& familyNames)
+{
+ if (familyNames.size() == 0)
+ return;
+ for (int f = 0; f < allFonts->nfont; ++f) {
+ FcPattern* pat = allFonts->fonts[f];
+ if (m_platformRefToFont.find(pat) != m_platformRefToFont.end())
+ continue;
+ char* s;
+ for (int i = 0; FcPatternGetString(pat, FC_FAMILY, i, (FcChar8**)&s) == FcResultMatch; ++i) {
+ for (std::list<std::string>::const_iterator j = familyNames.begin(); j != familyNames.end(); ++j) {
+ if (*j == s) {
+ NameCollection* names = readNames(pat);
+ addToMaps(pat, names);
+ delete names;
+ goto cached;
+ }
+ }
+ }
+ cached:
+ ;
+ }
+}
+
+void
+XeTeXFontMgr_FC::searchForHostPlatformFonts(const std::string& name)
+{
+ if (cachedAll) // we've already loaded everything on an earlier search
+ return;
+
+ std::string famName;
+ int hyph = name.find('-');
+ if (hyph > 0 && hyph < name.length() - 1)
+ famName.assign(name.begin(), name.begin() + hyph);
+ else
+ hyph = 0;
+
+ bool found = false;
+ while (1) {
+ for (int f = 0; f < allFonts->nfont; ++f) {
+ FcPattern* pat = allFonts->fonts[f];
+ if (m_platformRefToFont.find(pat) != m_platformRefToFont.end())
+ continue;
+
+ if (cachedAll) {
+ // failed to find it via FC; add everything to our maps (potentially slow) as a last resort
+ NameCollection* names = readNames(pat);
+ addToMaps(pat, names);
+ delete names;
+ continue;
+ }
+
+ char* s;
+ int i;
+ for (i = 0; FcPatternGetString(pat, FC_FULLNAME, i, (FcChar8**)&s) == FcResultMatch; ++i) {
+ if (name == s) {
+ NameCollection* names = readNames(pat);
+ addToMaps(pat, names);
+ cacheFamilyMembers(names->m_familyNames);
+ delete names;
+ found = true;
+ goto next_font;
+ }
+ }
+
+ for (i = 0; FcPatternGetString(pat, FC_FAMILY, i, (FcChar8**)&s) == FcResultMatch; ++i) {
+ if (name == s || (hyph && famName == s)) {
+ NameCollection* names = readNames(pat);
+ addToMaps(pat, names);
+ cacheFamilyMembers(names->m_familyNames);
+ delete names;
+ found = true;
+ goto next_font;
+ }
+ char* t;
+ for (int j = 0; FcPatternGetString(pat, FC_STYLE, j, (FcChar8**)&t) == FcResultMatch; ++j) {
+ std::string full(s);
+ full += " ";
+ full += t;
+ if (name == full) {
+ NameCollection* names = readNames(pat);
+ addToMaps(pat, names);
+ cacheFamilyMembers(names->m_familyNames);
+ delete names;
+ found = true;
+ goto next_font;
+ }
+ }
+ }
+
+ next_font:
+ ;
+ }
+
+ if (found || cachedAll)
+ break;
+ cachedAll = true;
+ }
+}
+
+void
+XeTeXFontMgr_FC::initialize()
+{
+ if (FcInit() == FcFalse) {
+ fprintf(stderr, "fontconfig initialization failed!\n");
+ exit(9);
+ }
+
+ if (gFreeTypeLibrary == 0 && FT_Init_FreeType(&gFreeTypeLibrary) != 0) {
+ fprintf(stderr, "FreeType initialization failed!\n");
+ exit(9);
+ }
+
+ UErrorCode err = U_ZERO_ERROR;
+ macRomanConv = ucnv_open("macintosh", &err);
+ utf16beConv = ucnv_open("UTF16BE", &err);
+ utf8Conv = ucnv_open("UTF8", &err);
+ if (err != 0) {
+ fprintf(stderr, "internal error; cannot read font names\n");
+ exit(3);
+ }
+
+ FcPattern* pat = FcNameParse((const FcChar8*)":outline=true");
+ FcObjectSet* os = FcObjectSetBuild(FC_FAMILY, FC_STYLE, FC_FILE, FC_INDEX,
+ FC_FULLNAME, FC_WEIGHT, FC_WIDTH, FC_SLANT, FC_FONTFORMAT, NULL);
+ allFonts = FcFontList(FcConfigGetCurrent(), pat, os);
+ FcObjectSetDestroy(os);
+ FcPatternDestroy(pat);
+
+ cachedAll = false;
+}
+
+void
+XeTeXFontMgr_FC::terminate()
+{
+ if (macRomanConv != NULL)
+ ucnv_close(macRomanConv);
+ if (utf16beConv != NULL)
+ ucnv_close(utf16beConv);
+ if (utf8Conv != NULL)
+ ucnv_close(utf8Conv);
+}
+
+std::string
+XeTeXFontMgr_FC::getPlatformFontDesc(PlatformFontRef font) const
+{
+ std::string path;
+ FcChar8* s;
+ if (FcPatternGetString(font, FC_FILE, 0, (FcChar8**)&s) == FcResultMatch)
+ path = (char*)s;
+ else
+ path = "[unknown]";
+ return path;
+}
+
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.h b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.h
new file mode 100644
index 00000000000..72889b3c971
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_FC.h
@@ -0,0 +1,65 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEX_FONT_MGR_FC_H
+#define __XETEX_FONT_MGR_FC_H
+
+#include "XeTeXFontMgr.h"
+
+class XeTeXFontMgr_FC
+ : public XeTeXFontMgr
+{
+public:
+ XeTeXFontMgr_FC()
+ { }
+ virtual ~XeTeXFontMgr_FC()
+ { }
+
+protected:
+
+ virtual void initialize();
+ virtual void terminate();
+
+ virtual void getOpSizeRecAndStyleFlags(Font* theFont);
+ virtual void searchForHostPlatformFonts(const std::string& name);
+
+ virtual NameCollection* readNames(FcPattern* pat);
+
+ std::string getPlatformFontDesc(PlatformFontRef font) const;
+
+ void cacheFamilyMembers(const std::list<std::string>& familyNames);
+
+ FcFontSet* allFonts;
+ bool cachedAll;
+};
+
+#endif /* __XETEX_FONT_MGR_FC_H */
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.h b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.h
new file mode 100644
index 00000000000..f6f8a824a7d
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.h
@@ -0,0 +1,73 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEX_FONT_MGR_MAC_H
+#define __XETEX_FONT_MGR_MAC_H
+
+#include "XeTeXFontMgr.h"
+
+#include <CoreFoundation/CoreFoundation.h>
+
+class XeTeXFontMgr_Mac
+ : public XeTeXFontMgr
+{
+public:
+ XeTeXFontMgr_Mac()
+ { }
+ virtual ~XeTeXFontMgr_Mac()
+ { }
+
+protected:
+
+ virtual void initialize();
+ virtual void terminate();
+
+ virtual void searchForHostPlatformFonts(const std::string& name);
+
+ virtual NameCollection* readNames(CTFontDescriptorRef fontRef);
+
+ virtual std::string getPlatformFontDesc(PlatformFontRef font) const;
+
+private:
+ void addFontsToCaches(CFArrayRef fonts);
+
+ void addFamilyToCaches(CTFontDescriptorRef familyRef);
+
+ void addFontAndSiblingsToCaches(CTFontDescriptorRef fontRef);
+
+ void appendNameToList(CTFontRef font,
+ std::list<std::string>* nameList,
+ CFStringRef nameKey);
+};
+
+#endif /* __XETEX_FONT_MGR_MAC_H */
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.mm b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.mm
new file mode 100644
index 00000000000..74bb7cb6862
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXFontMgr_Mac.mm
@@ -0,0 +1,257 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include <w2c/config.h>
+#ifdef __cplusplus
+}
+#endif
+
+#include "XeTeXFontMgr_Mac.h"
+
+#include <Cocoa/Cocoa.h>
+
+CTFontDescriptorRef findFontWithName(CFStringRef name, CFStringRef key)
+{
+ CFStringRef keys[] = { key };
+ CFTypeRef values[] = { name };
+ CFDictionaryRef attributes = CFDictionaryCreate(NULL, (const void **) &keys, (const void **) &values, 1,
+ &kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks);
+ CTFontDescriptorRef descriptor = CTFontDescriptorCreateWithAttributes(attributes);
+ CFRelease(attributes);
+
+ CFSetRef mandatoryAttributes = CFSetCreate(NULL, (const void **) &keys, 1, &kCFTypeSetCallBacks);
+ CFArrayRef matches = CTFontDescriptorCreateMatchingFontDescriptors(descriptor, mandatoryAttributes);
+ CFRelease(mandatoryAttributes);
+ CFRelease(descriptor);
+
+ CTFontDescriptorRef matched = NULL;
+ if (matches) {
+ if (CFArrayGetCount(matches)) {
+ matched = (CTFontDescriptorRef) CFArrayGetValueAtIndex(matches, 0);
+ CFRetain(matched);
+ }
+ CFRelease(matches);
+ }
+ return matched;
+}
+
+void
+XeTeXFontMgr_Mac::appendNameToList(CTFontRef font,
+ std::list<std::string>* nameList,
+ CFStringRef nameKey)
+{
+ CFStringRef name = CTFontCopyName(font, nameKey);
+ if (name) {
+ appendToList(nameList, [(NSString *) name UTF8String]);
+ CFRelease(name);
+ }
+ CFStringRef language;
+ name = CTFontCopyLocalizedName(font, nameKey, &language);
+ if (name) {
+ appendToList(nameList, [(NSString *) name UTF8String]);
+ CFRelease(name);
+ }
+}
+
+XeTeXFontMgr::NameCollection*
+XeTeXFontMgr_Mac::readNames(CTFontDescriptorRef fontRef)
+{
+ NameCollection* names = new NameCollection;
+
+ CFStringRef psName = (CFStringRef) CTFontDescriptorCopyAttribute(fontRef, kCTFontNameAttribute);
+ if (!psName)
+ return names;
+
+ NSAutoreleasePool *pool = [NSAutoreleasePool new];
+
+ names->m_psName = [(NSString *) psName UTF8String];
+ CFRelease(psName);
+
+ CTFontRef font = CTFontCreateWithFontDescriptor(fontRef, 0.0, 0);
+ appendNameToList(font, &names->m_fullNames, kCTFontFullNameKey);
+ appendNameToList(font, &names->m_familyNames, kCTFontFamilyNameKey);
+ appendNameToList(font, &names->m_styleNames, kCTFontStyleNameKey);
+ CFRelease(font);
+
+ [pool release];
+
+ return names;
+}
+
+void
+XeTeXFontMgr_Mac::addFontsToCaches(CFArrayRef fonts)
+{
+ NSEnumerator* enumerator = [(NSArray*)fonts objectEnumerator];
+ while (id aFont = [enumerator nextObject]) {
+ CTFontDescriptorRef fontRef = findFontWithName((CFStringRef)[aFont objectAtIndex: 0], kCTFontNameAttribute);
+ NameCollection* names = readNames(fontRef);
+ addToMaps(fontRef, names);
+ delete names;
+ }
+}
+
+void
+XeTeXFontMgr_Mac::addFamilyToCaches(CTFontDescriptorRef familyRef)
+{
+ CFStringRef nameStr = (CFStringRef) CTFontDescriptorCopyAttribute(familyRef, kCTFontFamilyNameAttribute);
+ if (nameStr) {
+ NSArray* members = [[NSFontManager sharedFontManager]
+ availableMembersOfFontFamily: (NSString*)nameStr];
+ CFRelease(nameStr);
+ addFontsToCaches((CFArrayRef)members);
+ }
+}
+
+void
+XeTeXFontMgr_Mac::addFontAndSiblingsToCaches(CTFontDescriptorRef fontRef)
+{
+ CFStringRef name = (CFStringRef) CTFontDescriptorCopyAttribute(fontRef, kCTFontNameAttribute);
+ if (name) {
+ NSFont* font = [NSFont fontWithName:(NSString*)name size:10.0];
+ CFRelease(name);
+ NSArray* members = [[NSFontManager sharedFontManager]
+ availableMembersOfFontFamily: [font familyName]];
+ addFontsToCaches((CFArrayRef)members);
+ }
+}
+
+void
+XeTeXFontMgr_Mac::searchForHostPlatformFonts(const std::string& name)
+{
+ // the name might be:
+ // FullName
+ // Family-Style (if there's a hyphen)
+ // PSName
+ // Family
+ // ...so we need to try it as each of these
+
+ CFStringRef nameStr = CFStringCreateWithCString(kCFAllocatorDefault, name.c_str(), kCFStringEncodingUTF8);
+ CTFontDescriptorRef matched = findFontWithName(nameStr, kCTFontDisplayNameAttribute);
+ if (matched) {
+ // found it, so locate the family, and add all members to the caches
+ addFontAndSiblingsToCaches(matched);
+ CFRelease(matched);
+ return;
+ }
+
+ int hyph = name.find('-');
+ if (hyph > 0 && hyph < name.length() - 1) {
+ std::string family(name.begin(), name.begin() + hyph);
+ CFStringRef familyStr = CFStringCreateWithCString(kCFAllocatorDefault, family.c_str(), kCFStringEncodingUTF8);
+
+ NSArray* familyMembers = [[NSFontManager sharedFontManager]
+ availableMembersOfFontFamily: (NSString*)familyStr];
+ if ([familyMembers count] > 0) {
+ addFontsToCaches((CFArrayRef)familyMembers);
+ return;
+ }
+
+ matched = findFontWithName(familyStr, kCTFontFamilyNameAttribute);
+ if (matched) {
+ addFamilyToCaches(matched);
+ CFRelease(matched);
+ return;
+ }
+ }
+
+ matched = findFontWithName(nameStr, kCTFontNameAttribute);
+ if (matched) {
+ addFontAndSiblingsToCaches(matched);
+ CFRelease(matched);
+ return;
+ }
+
+ NSArray* familyMembers = [[NSFontManager sharedFontManager]
+ availableMembersOfFontFamily: (NSString*)nameStr];
+ if ([familyMembers count] > 0) {
+ addFontsToCaches((CFArrayRef)familyMembers);
+ return;
+ }
+
+ matched = findFontWithName(nameStr, kCTFontFamilyNameAttribute);
+ if (matched) {
+ addFamilyToCaches(matched);
+ CFRelease(matched);
+ return;
+ }
+}
+
+NSAutoreleasePool* pool = NULL;
+
+void
+XeTeXFontMgr_Mac::initialize()
+{
+ pool = [[NSAutoreleasePool alloc] init];
+}
+
+void
+XeTeXFontMgr_Mac::terminate()
+{
+ if (pool != NULL) {
+ [pool release];
+ }
+}
+
+std::string
+XeTeXFontMgr_Mac::getPlatformFontDesc(PlatformFontRef descriptor) const
+{
+ std::string path;
+ CTFontRef ctFont = CTFontCreateWithFontDescriptor(descriptor, 0.0, 0);
+ if (ctFont) {
+ CFURLRef url = NULL;
+#if !defined(MAC_OS_X_VERSION_10_6) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_6
+ /* kCTFontURLAttribute was not avialable before 10.6 */
+ FSRef fsref;
+ ATSFontRef atsFont = CTFontGetPlatformFont(ctFont, NULL);
+ OSStatus status = ATSFontGetFileReference(atsFont, &fsref);
+ if (status == noErr)
+ url = CFURLCreateFromFSRef(NULL, &fsref);
+#else
+ url = (CFURLRef) CTFontCopyAttribute(ctFont, kCTFontURLAttribute);
+#endif
+ if (url) {
+ UInt8 posixPath[PATH_MAX];
+ if (CFURLGetFileSystemRepresentation(url, true, posixPath, PATH_MAX)) {
+ path = (char*)posixPath;
+ }
+ CFRelease(url);
+ }
+ CFRelease(ctFont);
+ }
+ if (path.length() == 0)
+ path = "[unknown]";
+ return path;
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.cpp b/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.cpp
new file mode 100644
index 00000000000..9ca0aca41e4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.cpp
@@ -0,0 +1,1029 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2012 by Jonathan Kew
+ Copyright (c) 2012-2019 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include <unicode/platform.h> // We need this first
+#include <unicode/ubidi.h>
+#include <unicode/utext.h>
+
+#include <graphite2/Font.h>
+#include <graphite2/Segment.h>
+#include <hb.h>
+#include <hb-graphite2.h>
+#if !HB_VERSION_ATLEAST(2,5,0)
+#include <hb-icu.h>
+#endif
+#include <hb-ot.h>
+
+#include "XeTeX_web.h"
+
+#include "XeTeXLayoutInterface.h"
+#include "XeTeXFontInst.h"
+#ifdef XETEX_MAC
+#include "XeTeXFontInst_Mac.h"
+#endif
+#include "XeTeXFontMgr.h"
+
+struct XeTeXLayoutEngine_rec
+{
+ XeTeXFontInst* font;
+ PlatformFontRef fontRef;
+ hb_tag_t script;
+ hb_language_t language;
+ hb_feature_t* features;
+ char** ShaperList; // the requested shapers
+ char* shaper; // the actually used shaper
+ int nFeatures;
+ uint32_t rgbValue;
+ float extend;
+ float slant;
+ float embolden;
+ hb_buffer_t* hbBuffer;
+};
+
+/*******************************************************************/
+/* Glyph bounding box cache to speed up \XeTeXuseglyphmetrics mode */
+/*******************************************************************/
+#include <map>
+
+// key is combined value representing (font_id << 16) + glyph
+// value is glyph bounding box in TeX points
+static std::map<uint32_t,GlyphBBox> sGlyphBoxes;
+
+int
+getCachedGlyphBBox(uint16_t fontID, uint16_t glyphID, GlyphBBox* bbox)
+{
+ uint32_t key = ((uint32_t)fontID << 16) + glyphID;
+ std::map<uint32_t,GlyphBBox>::const_iterator i = sGlyphBoxes.find(key);
+ if (i == sGlyphBoxes.end()) {
+ return 0;
+ }
+ *bbox = i->second;
+ return 1;
+}
+
+void
+cacheGlyphBBox(uint16_t fontID, uint16_t glyphID, const GlyphBBox* bbox)
+{
+ uint32_t key = ((uint32_t)fontID << 16) + glyphID;
+ sGlyphBoxes[key] = *bbox;
+}
+/*******************************************************************/
+
+void
+terminatefontmanager()
+{
+ XeTeXFontMgr::Terminate();
+}
+
+XeTeXFont
+createFont(PlatformFontRef fontRef, Fixed pointSize)
+{
+ int status = 0;
+#ifdef XETEX_MAC
+ XeTeXFontInst* font = new XeTeXFontInst_Mac(fontRef, Fix2D(pointSize), status);
+#else
+ FcChar8* pathname = 0;
+ FcPatternGetString(fontRef, FC_FILE, 0, &pathname);
+ int index;
+ FcPatternGetInteger(fontRef, FC_INDEX, 0, &index);
+ XeTeXFontInst* font = new XeTeXFontInst((const char*)pathname, index, Fix2D(pointSize), status);
+#endif
+ if (status != 0) {
+ delete font;
+ return NULL;
+ }
+ return (XeTeXFont)font;
+}
+
+XeTeXFont
+createFontFromFile(const char* filename, int index, Fixed pointSize)
+{
+ int status = 0;
+ XeTeXFontInst* font = new XeTeXFontInst(filename, index, Fix2D(pointSize), status);
+ if (status != 0) {
+ delete font;
+ return NULL;
+ }
+ return (XeTeXFont)font;
+}
+
+void
+setFontLayoutDir(XeTeXFont font, int vertical)
+{
+ ((XeTeXFontInst*)font)->setLayoutDirVertical(vertical != 0);
+}
+
+PlatformFontRef
+findFontByName(const char* name, char* var, double size)
+{
+ return XeTeXFontMgr::GetFontManager()->findFont(name, var, size);
+}
+
+char
+getReqEngine()
+{
+ return XeTeXFontMgr::GetFontManager()->getReqEngine();
+}
+
+void
+setReqEngine(char reqEngine)
+{
+ XeTeXFontMgr::GetFontManager()->setReqEngine(reqEngine);
+}
+
+const char*
+getFullName(PlatformFontRef fontRef)
+{
+ return XeTeXFontMgr::GetFontManager()->getFullName(fontRef);
+}
+
+double
+getDesignSize(XeTeXFont font)
+{
+ return XeTeXFontMgr::GetFontManager()->getDesignSize(font);
+}
+
+char*
+getFontFilename(XeTeXLayoutEngine engine, uint32_t* index)
+{
+ return xstrdup(engine->font->getFilename(index));
+}
+
+PlatformFontRef
+getFontRef(XeTeXLayoutEngine engine)
+{
+ return engine->fontRef;
+}
+
+void
+deleteFont(XeTeXFont font)
+{
+ delete (XeTeXFontInst*)font;
+}
+
+void*
+getFontTablePtr(XeTeXFont font, uint32_t tableTag)
+{
+ return const_cast<void*>(((XeTeXFontInst*)font)->getFontTable(tableTag));
+}
+
+Fixed
+getSlant(XeTeXFont font)
+{
+ float italAngle = ((XeTeXFontInst*)font)->getItalicAngle();
+ return D2Fix(tan(-italAngle * M_PI / 180.0));
+}
+
+static unsigned int
+getLargerScriptListTable(XeTeXFont font, hb_tag_t** scriptList)
+{
+ unsigned int rval = 0;
+
+ hb_face_t* face = hb_font_get_face(((XeTeXFontInst*)font)->getHbFont());
+
+ hb_tag_t* scriptListSub = NULL;
+ hb_tag_t* scriptListPos = NULL;
+
+ unsigned int scriptCountSub = hb_ot_layout_table_get_script_tags(face, HB_OT_TAG_GSUB, 0, NULL, NULL);
+ scriptListSub = (hb_tag_t*) xcalloc(scriptCountSub, sizeof(hb_tag_t*));
+ hb_ot_layout_table_get_script_tags(face, HB_OT_TAG_GSUB, 0, &scriptCountSub, scriptListSub);
+
+ unsigned int scriptCountPos = hb_ot_layout_table_get_script_tags(face, HB_OT_TAG_GPOS, 0, NULL, NULL);
+ scriptListPos = (hb_tag_t*) xcalloc(scriptCountPos, sizeof(hb_tag_t*));
+ hb_ot_layout_table_get_script_tags(face, HB_OT_TAG_GSUB, 0, &scriptCountPos, scriptListPos);
+
+ if (scriptCountSub > scriptCountPos) {
+ if (scriptList != NULL)
+ *scriptList = scriptListSub;
+ rval = scriptCountSub;
+ } else {
+ if (scriptList != NULL)
+ *scriptList = scriptListPos;
+ rval = scriptCountPos;
+ }
+
+ return rval;
+}
+
+unsigned int
+countScripts(XeTeXFont font)
+{
+ return getLargerScriptListTable(font, NULL);
+}
+
+hb_tag_t
+getIndScript(XeTeXFont font, unsigned int index)
+{
+ hb_tag_t rval = 0;
+
+ hb_tag_t* scriptList;
+
+ unsigned int scriptCount = getLargerScriptListTable(font, &scriptList);
+ if (scriptList != NULL) {
+ if (index < scriptCount)
+ rval = scriptList[index];
+ }
+
+ return rval;
+}
+
+unsigned int
+countLanguages(XeTeXFont font, hb_tag_t script)
+{
+ unsigned int rval = 0;
+
+ hb_face_t* face = hb_font_get_face(((XeTeXFontInst*)font)->getHbFont());
+ hb_tag_t* scriptList;
+
+ unsigned int scriptCount = getLargerScriptListTable(font, &scriptList);
+ if (scriptList != NULL) {
+ for (int i = 0; i < scriptCount; i++) {
+ if (scriptList[i] == script) {
+ rval += hb_ot_layout_script_get_language_tags (face, HB_OT_TAG_GSUB, i, 0, NULL, NULL);
+ rval += hb_ot_layout_script_get_language_tags (face, HB_OT_TAG_GPOS, i, 0, NULL, NULL);
+ break;
+ }
+ }
+ }
+
+ return rval;
+}
+
+hb_tag_t
+getIndLanguage(XeTeXFont font, hb_tag_t script, unsigned int index)
+{
+ hb_tag_t rval = 0;
+
+ hb_face_t* face = hb_font_get_face(((XeTeXFontInst*)font)->getHbFont());
+ hb_tag_t* scriptList;
+
+ unsigned int scriptCount = getLargerScriptListTable(font, &scriptList);
+ if (scriptList != NULL) {
+ for (int i = 0; i < scriptCount; i++) {
+ if (scriptList[i] == script) {
+ unsigned int langCount;
+ hb_tag_t* langList;
+
+ langCount = hb_ot_layout_script_get_language_tags(face, HB_OT_TAG_GSUB, i, 0, NULL, NULL);
+ langList = (hb_tag_t*) xcalloc(langCount, sizeof(hb_tag_t*));
+ hb_ot_layout_script_get_language_tags(face, HB_OT_TAG_GSUB, i, 0, &langCount, langList);
+
+ if (index < langCount) {
+ rval = langList[index];
+ break;
+ }
+
+ free(langList);
+
+ langCount = hb_ot_layout_script_get_language_tags(face, HB_OT_TAG_GPOS, i, 0, NULL, NULL);
+ langList = (hb_tag_t*) xcalloc(langCount, sizeof(hb_tag_t*));
+ hb_ot_layout_script_get_language_tags(face, HB_OT_TAG_GPOS, i, 0, &langCount, langList);
+
+ if (index < langCount) {
+ rval = langList[index];
+ break;
+ }
+
+ free(langList);
+ }
+ }
+ }
+
+ return rval;
+}
+
+unsigned int
+countFeatures(XeTeXFont font, hb_tag_t script, hb_tag_t language)
+{
+ unsigned int rval = 0;
+
+ hb_face_t* face = hb_font_get_face(((XeTeXFontInst*)font)->getHbFont());
+
+ for (int i = 0; i < 2; ++i) {
+ unsigned int scriptIndex, langIndex = 0;
+ hb_tag_t tableTag = i == 0 ? HB_OT_TAG_GSUB : HB_OT_TAG_GPOS;
+ if (hb_ot_layout_table_find_script(face, tableTag, script, &scriptIndex)) {
+ if (hb_ot_layout_script_find_language(face, tableTag, scriptIndex, language, &langIndex) || language == 0) {
+ rval += hb_ot_layout_language_get_feature_tags(face, tableTag, scriptIndex, langIndex, 0, NULL, NULL);
+ }
+ }
+ }
+
+ return rval;
+}
+
+hb_tag_t
+getIndFeature(XeTeXFont font, hb_tag_t script, hb_tag_t language, unsigned int index)
+{
+ hb_tag_t rval = 0;
+
+ hb_face_t* face = hb_font_get_face(((XeTeXFontInst*)font)->getHbFont());
+
+ for (int i = 0; i < 2; ++i) {
+ unsigned int scriptIndex, langIndex = 0;
+ hb_tag_t tableTag = i == 0 ? HB_OT_TAG_GSUB : HB_OT_TAG_GPOS;
+ if (hb_ot_layout_table_find_script(face, tableTag, script, &scriptIndex)) {
+ if (hb_ot_layout_script_find_language(face, tableTag, scriptIndex, language, &langIndex) || language == 0) {
+ unsigned int featCount = hb_ot_layout_language_get_feature_tags(face, tableTag, scriptIndex, langIndex, 0, NULL, NULL);
+ hb_tag_t* featList = (hb_tag_t*) xcalloc(featCount, sizeof(hb_tag_t*));
+ hb_ot_layout_language_get_feature_tags(face, tableTag, scriptIndex, langIndex, 0, &featCount, featList);
+
+ if (index < featCount) {
+ rval = featList[index];
+ break;
+ }
+
+ index -= featCount;
+ }
+ }
+ }
+
+ return rval;
+}
+
+uint32_t
+countGraphiteFeatures(XeTeXLayoutEngine engine)
+{
+ uint32_t rval = 0;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL)
+ rval = gr_face_n_fref(grFace);
+
+ return rval;
+}
+
+uint32_t
+getGraphiteFeatureCode(XeTeXLayoutEngine engine, uint32_t index)
+{
+ uint32_t rval = 0;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_fref(grFace, index);
+ rval = gr_fref_id(feature);
+ }
+
+ return rval;
+}
+
+uint32_t
+countGraphiteFeatureSettings(XeTeXLayoutEngine engine, uint32_t featureID)
+{
+ uint32_t rval = 0;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, featureID);
+ rval = gr_fref_n_values(feature);
+ }
+
+ return rval;
+}
+
+uint32_t
+getGraphiteFeatureSettingCode(XeTeXLayoutEngine engine, uint32_t featureID, uint32_t index)
+{
+ uint32_t rval = 0;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, featureID);
+ rval = gr_fref_value(feature, index);
+ }
+
+ return rval;
+}
+
+#define tag_from_lang(x) hb_tag_from_string(hb_language_to_string(x), strlen(hb_language_to_string(x)))
+
+uint32_t
+getGraphiteFeatureDefaultSetting(XeTeXLayoutEngine engine, uint32_t featureID)
+{
+ uint32_t rval = 0;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, featureID);
+ gr_feature_val *featureValues = gr_face_featureval_for_lang (grFace, tag_from_lang(engine->language));
+
+ rval = gr_fref_feature_value(feature, featureValues);
+ }
+
+ return rval;
+}
+
+char *
+getGraphiteFeatureLabel(XeTeXLayoutEngine engine, uint32_t featureID)
+{
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, featureID);
+ uint32_t len = 0;
+ uint16_t langID = 0x409;
+
+ return (char *) gr_fref_label(feature, &langID, gr_utf8, &len);
+ }
+
+ return NULL;
+}
+
+char *
+getGraphiteFeatureSettingLabel(XeTeXLayoutEngine engine, uint32_t featureID, uint32_t settingID)
+{
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, featureID);
+ for (int i = 0; i < gr_fref_n_values(feature); i++) {
+ if (settingID == gr_fref_value(feature, i)) {
+ uint32_t len = 0;
+ uint16_t langID = 0x409;
+
+ return (char *) gr_fref_value_label(feature, i, &langID, gr_utf8, &len);
+ }
+ }
+ }
+
+ return NULL;
+}
+
+bool
+findGraphiteFeature(XeTeXLayoutEngine engine, const char* s, const char* e, hb_tag_t* f, int* v)
+ /* s...e is a "feature=setting" string; look for this in the font */
+{
+ *f = 0;
+ *v = 0;
+ while (*s == ' ' || *s == '\t')
+ ++s;
+ const char* cp = s;
+ while (cp < e && *cp != '=')
+ ++cp;
+
+ *f = findGraphiteFeatureNamed(engine, s, cp - s);
+ if (*f == -1)
+ return false;
+
+ ++cp;
+ while (cp < e && (*cp == ' ' || *cp == '\t'))
+ ++cp;
+
+ if (cp == e)
+ /* no setting was specified */
+ return false;
+
+ *v = findGraphiteFeatureSettingNamed(engine, *f, cp, e - cp);
+ if (*v == -1)
+ return false;
+
+ return true;
+}
+
+long
+findGraphiteFeatureNamed(XeTeXLayoutEngine engine, const char* name, int namelength)
+{
+ long rval = -1;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ for (int i = 0; i < gr_face_n_fref(grFace); i++) {
+ const gr_feature_ref* feature = gr_face_fref(grFace, i);
+ uint32_t len = 0;
+ uint16_t langID = 0x409;
+
+ // the first call is to get the length of the string
+ gr_fref_label(feature, &langID, gr_utf8, &len);
+ char* label = (char*) xmalloc(len);
+ label = (char*) gr_fref_label(feature, &langID, gr_utf8, &len);
+
+ if (strncmp(label, name, namelength) == 0) {
+ rval = gr_fref_id(feature);
+ gr_label_destroy(label);
+ break;
+ }
+
+ gr_label_destroy(label);
+ }
+ }
+
+ return rval;
+}
+
+long
+findGraphiteFeatureSettingNamed(XeTeXLayoutEngine engine, uint32_t id, const char* name, int namelength)
+{
+ long rval = -1;
+
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+
+ if (grFace != NULL) {
+ const gr_feature_ref* feature = gr_face_find_fref(grFace, id);
+ for (int i = 0; i < gr_fref_n_values(feature); i++) {
+ uint32_t len = 0;
+ uint16_t langID = 0x409;
+
+ // the first call is to get the length of the string
+ gr_fref_value_label(feature, i, &langID, gr_utf8, &len);
+ char* label = (char*) xmalloc(len);
+ label = (char*) gr_fref_value_label(feature, i, &langID, gr_utf8, &len);
+
+ if (strncmp(label, name, namelength) == 0) {
+ rval = gr_fref_value(feature, i);
+ gr_label_destroy(label);
+ break;
+ }
+
+ gr_label_destroy(label);
+ }
+ }
+
+ return rval;
+}
+
+float
+getGlyphWidth(XeTeXFont font, uint32_t gid)
+{
+ return ((XeTeXFontInst*)font)->getGlyphWidth(gid);
+}
+
+unsigned int
+countGlyphs(XeTeXFont font)
+{
+ return ((XeTeXFontInst*)font)->getNumGlyphs();
+}
+
+XeTeXFont
+getFont(XeTeXLayoutEngine engine)
+{
+ return (XeTeXFont)(engine->font);
+}
+
+float
+getExtendFactor(XeTeXLayoutEngine engine)
+{
+ return engine->extend;
+}
+
+float
+getSlantFactor(XeTeXLayoutEngine engine)
+{
+ return engine->slant;
+}
+
+float
+getEmboldenFactor(XeTeXLayoutEngine engine)
+{
+ return engine->embolden;
+}
+
+XeTeXLayoutEngine
+createLayoutEngine(PlatformFontRef fontRef, XeTeXFont font, hb_tag_t script, char *language,
+ hb_feature_t* features, int nFeatures, char **shapers, uint32_t rgbValue,
+ float extend, float slant, float embolden)
+{
+ XeTeXLayoutEngine result = new XeTeXLayoutEngine_rec;
+ result->fontRef = fontRef;
+ result->font = (XeTeXFontInst*)font;
+ result->script = script;
+ result->features = features;
+ result->ShaperList = shapers;
+ result->shaper = NULL;
+ result->nFeatures = nFeatures;
+ result->rgbValue = rgbValue;
+ result->extend = extend;
+ result->slant = slant;
+ result->embolden = embolden;
+ result->hbBuffer = hb_buffer_create();
+
+ // For Graphite fonts treat the language as BCP 47 tag, for OpenType we
+ // treat it as a OT language tag for backward compatibility with pre-0.9999
+ // XeTeX.
+ if (getReqEngine() == 'G')
+ result->language = hb_language_from_string(language, -1);
+ else
+ result->language = hb_ot_tag_to_language(hb_tag_from_string(language, -1));
+
+ free(language);
+
+ return result;
+}
+
+void
+deleteLayoutEngine(XeTeXLayoutEngine engine)
+{
+ hb_buffer_destroy(engine->hbBuffer);
+ delete engine->font;
+ free(engine->shaper);
+}
+
+#if !HB_VERSION_ATLEAST(2,5,0)
+static unsigned int
+_decompose_compat(hb_unicode_funcs_t* ufuncs,
+ hb_codepoint_t u,
+ hb_codepoint_t* decomposed,
+ void* user_data)
+{
+ return 0;
+}
+
+static hb_unicode_funcs_t*
+_get_unicode_funcs(void)
+{
+ static hb_unicode_funcs_t* ufuncs = hb_unicode_funcs_create(hb_icu_get_unicode_funcs());
+ hb_unicode_funcs_set_decompose_compatibility_func(ufuncs, _decompose_compat, NULL, NULL);
+ return ufuncs;
+}
+#endif
+
+int
+layoutChars(XeTeXLayoutEngine engine, uint16_t chars[], int32_t offset, int32_t count, int32_t max,
+ bool rightToLeft)
+{
+ bool res;
+ hb_script_t script = HB_SCRIPT_INVALID;
+ hb_direction_t direction = HB_DIRECTION_LTR;
+ hb_segment_properties_t segment_props;
+ hb_shape_plan_t *shape_plan;
+ hb_font_t* hbFont = engine->font->getHbFont();
+ hb_face_t* hbFace = hb_font_get_face(hbFont);
+
+ if (engine->font->getLayoutDirVertical())
+ direction = HB_DIRECTION_TTB;
+ else if (rightToLeft)
+ direction = HB_DIRECTION_RTL;
+
+ script = hb_ot_tag_to_script (engine->script);
+
+ hb_buffer_reset(engine->hbBuffer);
+
+#if !HB_VERSION_ATLEAST(2,5,0)
+ static hb_unicode_funcs_t* hbUnicodeFuncs = NULL;
+ if (hbUnicodeFuncs == NULL)
+ hbUnicodeFuncs = _get_unicode_funcs();
+ hb_buffer_set_unicode_funcs(engine->hbBuffer, hbUnicodeFuncs);
+#endif
+
+ hb_buffer_add_utf16(engine->hbBuffer, chars, max, offset, count);
+ hb_buffer_set_direction(engine->hbBuffer, direction);
+ hb_buffer_set_script(engine->hbBuffer, script);
+ hb_buffer_set_language(engine->hbBuffer, engine->language);
+
+ hb_buffer_guess_segment_properties(engine->hbBuffer);
+ hb_buffer_get_segment_properties(engine->hbBuffer, &segment_props);
+
+ if (engine->ShaperList == NULL) {
+ // HarfBuzz gives graphite2 shaper a priority, so that for hybrid
+ // Graphite/OpenType fonts, Graphite will be used. However, pre-0.9999
+ // XeTeX preferred OpenType over Graphite, so we are doing the same
+ // here for sake of backward compatibility. Since "ot" shaper never
+ // fails, we set the shaper list to just include it.
+ engine->ShaperList = (char**) xcalloc(2, sizeof(char*));
+ engine->ShaperList[0] = (char*) "ot";
+ engine->ShaperList[1] = NULL;
+ }
+
+ shape_plan = hb_shape_plan_create_cached(hbFace, &segment_props, engine->features, engine->nFeatures, engine->ShaperList);
+ res = hb_shape_plan_execute(shape_plan, hbFont, engine->hbBuffer, engine->features, engine->nFeatures);
+
+ if (res) {
+ engine->shaper = strdup(hb_shape_plan_get_shaper(shape_plan));
+ hb_buffer_set_content_type(engine->hbBuffer, HB_BUFFER_CONTENT_TYPE_GLYPHS);
+ } else {
+ // all selected shapers failed, retrying with default
+ // we don't use _cached here as the cached plain will always fail.
+ hb_shape_plan_destroy(shape_plan);
+ shape_plan = hb_shape_plan_create(hbFace, &segment_props, engine->features, engine->nFeatures, NULL);
+ res = hb_shape_plan_execute(shape_plan, hbFont, engine->hbBuffer, engine->features, engine->nFeatures);
+
+ if (res) {
+ engine->shaper = strdup(hb_shape_plan_get_shaper(shape_plan));
+ hb_buffer_set_content_type(engine->hbBuffer, HB_BUFFER_CONTENT_TYPE_GLYPHS);
+ } else {
+ fprintf(stderr, "\nERROR: all shapers failed\n");
+ exit(3);
+ }
+ }
+
+ hb_shape_plan_destroy(shape_plan);
+
+ int glyphCount = hb_buffer_get_length(engine->hbBuffer);
+
+#ifdef DEBUG
+ char buf[1024];
+ unsigned int consumed;
+
+ printf ("shaper: %s\n", engine->shaper);
+
+ hb_buffer_serialize_flags_t flags = HB_BUFFER_SERIALIZE_FLAGS_DEFAULT;
+ hb_buffer_serialize_format_t format = HB_BUFFER_SERIALIZE_FORMAT_JSON;
+
+ hb_buffer_serialize_glyphs (engine->hbBuffer, 0, glyphCount, buf, sizeof(buf), &consumed, hbFont, format, flags);
+ if (consumed)
+ printf ("buffer glyphs: %s\n", buf);
+#endif
+
+ return glyphCount;
+}
+
+void
+getGlyphs(XeTeXLayoutEngine engine, uint32_t glyphs[])
+{
+ int glyphCount = hb_buffer_get_length(engine->hbBuffer);
+ hb_glyph_info_t *hbGlyphs = hb_buffer_get_glyph_infos(engine->hbBuffer, NULL);
+
+ for (int i = 0; i < glyphCount; i++)
+ glyphs[i] = hbGlyphs[i].codepoint;
+}
+
+void
+getGlyphAdvances(XeTeXLayoutEngine engine, float advances[])
+{
+ int glyphCount = hb_buffer_get_length(engine->hbBuffer);
+ hb_glyph_position_t *hbPositions = hb_buffer_get_glyph_positions(engine->hbBuffer, NULL);
+
+ for (int i = 0; i < glyphCount; i++) {
+ if (engine->font->getLayoutDirVertical())
+ advances[i] = engine->font->unitsToPoints(hbPositions[i].y_advance);
+ else
+ advances[i] = engine->font->unitsToPoints(hbPositions[i].x_advance);
+ }
+}
+
+void
+getGlyphPositions(XeTeXLayoutEngine engine, FloatPoint positions[])
+{
+ int glyphCount = hb_buffer_get_length(engine->hbBuffer);
+ hb_glyph_position_t *hbPositions = hb_buffer_get_glyph_positions(engine->hbBuffer, NULL);
+
+ float x = 0, y = 0;
+
+ if (engine->font->getLayoutDirVertical()) {
+ for (int i = 0; i < glyphCount; i++) {
+ positions[i].x = -engine->font->unitsToPoints(x + hbPositions[i].y_offset); /* negative is forwards */
+ positions[i].y = engine->font->unitsToPoints(y - hbPositions[i].x_offset);
+ x += hbPositions[i].y_advance;
+ y += hbPositions[i].x_advance;
+ }
+ positions[glyphCount].x = -engine->font->unitsToPoints(x);
+ positions[glyphCount].y = engine->font->unitsToPoints(y);
+ } else {
+ for (int i = 0; i < glyphCount; i++) {
+ positions[i].x = engine->font->unitsToPoints(x + hbPositions[i].x_offset);
+ positions[i].y = -engine->font->unitsToPoints(y + hbPositions[i].y_offset); /* negative is upwards */
+ x += hbPositions[i].x_advance;
+ y += hbPositions[i].y_advance;
+ }
+ positions[glyphCount].x = engine->font->unitsToPoints(x);
+ positions[glyphCount].y = -engine->font->unitsToPoints(y);
+ }
+
+ if (engine->extend != 1.0 || engine->slant != 0.0)
+ for (int i = 0; i <= glyphCount; ++i)
+ positions[i].x = positions[i].x * engine->extend - positions[i].y * engine->slant;
+}
+
+float
+getPointSize(XeTeXLayoutEngine engine)
+{
+ return engine->font->getPointSize();
+}
+
+void
+getAscentAndDescent(XeTeXLayoutEngine engine, float* ascent, float* descent)
+{
+ *ascent = engine->font->getAscent();
+ *descent = engine->font->getDescent();
+}
+
+void
+getCapAndXHeight(XeTeXLayoutEngine engine, float* capheight, float* xheight)
+{
+ *capheight = engine->font->getCapHeight();
+ *xheight = engine->font->getXHeight();
+}
+
+int
+getDefaultDirection(XeTeXLayoutEngine engine)
+{
+ hb_script_t script = hb_buffer_get_script(engine->hbBuffer);
+ if (hb_script_get_horizontal_direction (script) == HB_DIRECTION_RTL)
+ return UBIDI_DEFAULT_RTL;
+ else
+ return UBIDI_DEFAULT_LTR;
+}
+
+uint32_t
+getRgbValue(XeTeXLayoutEngine engine)
+{
+ return engine->rgbValue;
+}
+
+void
+getGlyphBounds(XeTeXLayoutEngine engine, uint32_t glyphID, GlyphBBox* bbox)
+{
+ engine->font->getGlyphBounds(glyphID, bbox);
+ if (engine->extend != 0.0) {
+ bbox->xMin *= engine->extend;
+ bbox->xMax *= engine->extend;
+ }
+}
+
+float
+getGlyphWidthFromEngine(XeTeXLayoutEngine engine, uint32_t glyphID)
+{
+ return engine->extend * engine->font->getGlyphWidth(glyphID);
+}
+
+void
+getGlyphHeightDepth(XeTeXLayoutEngine engine, uint32_t glyphID, float* height, float* depth)
+{
+ engine->font->getGlyphHeightDepth(glyphID, height, depth);
+}
+
+void
+getGlyphSidebearings(XeTeXLayoutEngine engine, uint32_t glyphID, float* lsb, float* rsb)
+{
+ engine->font->getGlyphSidebearings(glyphID, lsb, rsb);
+ if (engine->extend != 0.0) {
+ *lsb *= engine->extend;
+ *rsb *= engine->extend;
+ }
+}
+
+float
+getGlyphItalCorr(XeTeXLayoutEngine engine, uint32_t glyphID)
+{
+ return engine->extend * engine->font->getGlyphItalCorr(glyphID);
+}
+
+uint32_t
+mapCharToGlyph(XeTeXLayoutEngine engine, uint32_t charCode)
+{
+ return engine->font->mapCharToGlyph(charCode);
+}
+
+int
+getFontCharRange(XeTeXLayoutEngine engine, int reqFirst)
+{
+ if (reqFirst)
+ return engine->font->getFirstCharCode();
+ else
+ return engine->font->getLastCharCode();
+}
+
+const char*
+getGlyphName(XeTeXFont font, uint16_t gid, int* len)
+{
+ return ((XeTeXFontInst*)font)->getGlyphName(gid, *len);
+}
+
+int
+mapGlyphToIndex(XeTeXLayoutEngine engine, const char* glyphName)
+{
+ return engine->font->mapGlyphToIndex(glyphName);
+}
+
+static gr_segment* grSegment = NULL;
+static const gr_slot* grPrevSlot = NULL;
+static int grTextLen;
+
+bool
+initGraphiteBreaking(XeTeXLayoutEngine engine, const uint16_t* txtPtr, int txtLen)
+{
+ hb_face_t* hbFace = hb_font_get_face(engine->font->getHbFont());
+ gr_face* grFace = hb_graphite2_face_get_gr_face(hbFace);
+ gr_font* grFont = hb_graphite2_font_get_gr_font(engine->font->getHbFont());
+ if (grFace != NULL && grFont != NULL) {
+ if (grSegment != NULL) {
+ gr_seg_destroy(grSegment);
+ grSegment = NULL;
+ grPrevSlot = NULL;
+ }
+
+ gr_feature_val *grFeatureValues = gr_face_featureval_for_lang (grFace, tag_from_lang(engine->language));
+
+ int nFeatures = engine->nFeatures;
+ hb_feature_t *features = engine->features;
+ while (nFeatures--) {
+ const gr_feature_ref *fref = gr_face_find_fref (grFace, features->tag);
+ if (fref)
+ gr_fref_set_feature_value (fref, features->value, grFeatureValues);
+ features++;
+ }
+
+ grSegment = gr_make_seg(grFont, grFace, engine->script, grFeatureValues, gr_utf16, txtPtr, txtLen, 0);
+ grPrevSlot = gr_seg_first_slot(grSegment);
+ grTextLen = txtLen;
+
+ return true;
+ }
+
+ return false;
+}
+
+int
+findNextGraphiteBreak(void)
+{
+ int ret = -1;
+
+ if (grSegment != NULL) {
+ if (grPrevSlot && grPrevSlot != gr_seg_last_slot(grSegment)) {
+ for (const gr_slot* s = gr_slot_next_in_segment(grPrevSlot); s != NULL; s = gr_slot_next_in_segment(s)) {
+ const gr_char_info* ci = NULL;
+ int bw;
+
+ ci = gr_seg_cinfo(grSegment, gr_slot_index(s));
+ bw = gr_cinfo_break_weight(ci);
+ if (bw < gr_breakNone && bw >= gr_breakBeforeWord) {
+ grPrevSlot = s;
+ ret = gr_cinfo_base(ci);
+ } else if (bw > gr_breakNone && bw <= gr_breakWord) {
+ grPrevSlot = gr_slot_next_in_segment(s);
+ ret = gr_cinfo_base(ci) + 1;
+ }
+
+ if (ret != -1)
+ break;
+ }
+
+ if (ret == -1) {
+ grPrevSlot = gr_seg_last_slot(grSegment);
+ ret = grTextLen;
+ }
+ }
+ }
+
+ return ret;
+}
+
+bool
+usingGraphite(XeTeXLayoutEngine engine)
+{
+ if (engine->shaper != NULL && (strcmp("graphite2", engine->shaper) == 0))
+ return true;
+ else
+ return false;
+}
+
+bool
+usingOpenType(XeTeXLayoutEngine engine)
+{
+ if (engine->shaper == NULL || (strcmp("ot", engine->shaper) == 0))
+ return true;
+ else
+ return false;
+}
+
+bool
+isOpenTypeMathFont(XeTeXLayoutEngine engine)
+{
+ return hb_ot_math_has_data(hb_font_get_face(engine->font->getHbFont()));
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.h b/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.h
new file mode 100644
index 00000000000..0e0193361bf
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXLayoutInterface.h
@@ -0,0 +1,171 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012-2015 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef XETEX_LAYOUT_INTERFACE_H
+#define XETEX_LAYOUT_INTERFACE_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+typedef struct XeTeXFont_rec* XeTeXFont;
+typedef struct XeTeXLayoutEngine_rec* XeTeXLayoutEngine;
+#ifdef __cplusplus
+};
+#endif
+
+#include <ft2build.h>
+#include FT_FREETYPE_H
+#include FT_TRUETYPE_TABLES_H
+
+#include <hb.h>
+#include <hb-ot.h>
+
+#include "XeTeX_ext.h"
+#include "XeTeXFontMgr.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern char gPrefEngine;
+
+int getCachedGlyphBBox(uint16_t fontID, uint16_t glyphID, GlyphBBox* bbox);
+void cacheGlyphBBox(uint16_t fontID, uint16_t glyphID, const GlyphBBox* bbox);
+
+void terminatefontmanager();
+
+XeTeXFont createFont(PlatformFontRef fontRef, Fixed pointSize);
+XeTeXFont createFontFromFile(const char* filename, int index, Fixed pointSize);
+
+void setFontLayoutDir(XeTeXFont font, int vertical);
+
+PlatformFontRef findFontByName(const char* name, char* var, double size);
+
+char getReqEngine();
+void setReqEngine(char reqEngine);
+const char* getFullName(PlatformFontRef fontRef);
+
+char* getFontFilename(XeTeXLayoutEngine engine, uint32_t* index);
+
+double getDesignSize(XeTeXFont font);
+
+void deleteFont(XeTeXFont font);
+
+void* getFontTablePtr(XeTeXFont font, uint32_t tableTag);
+
+Fixed getSlant(XeTeXFont font);
+
+unsigned int countScripts(XeTeXFont font);
+unsigned int countLanguages(XeTeXFont font, hb_tag_t script);
+unsigned int countFeatures(XeTeXFont font, hb_tag_t script, hb_tag_t language);
+unsigned int countGlyphs(XeTeXFont font);
+
+hb_tag_t getIndScript(XeTeXFont font, unsigned int index);
+hb_tag_t getIndLanguage(XeTeXFont font, hb_tag_t script, unsigned int index);
+hb_tag_t getIndFeature(XeTeXFont font, hb_tag_t script, hb_tag_t language, unsigned int index);
+
+float getGlyphWidth(XeTeXFont font, uint32_t gid);
+
+XeTeXLayoutEngine createLayoutEngine(PlatformFontRef fontRef, XeTeXFont font, hb_tag_t script, char *language,
+ hb_feature_t* features, int nFeatures, char **shapers, uint32_t rgbValue,
+ float extend, float slant, float embolden);
+
+void deleteLayoutEngine(XeTeXLayoutEngine engine);
+
+XeTeXFont getFont(XeTeXLayoutEngine engine);
+PlatformFontRef getFontRef(XeTeXLayoutEngine engine);
+
+float getExtendFactor(XeTeXLayoutEngine engine);
+float getSlantFactor(XeTeXLayoutEngine engine);
+float getEmboldenFactor(XeTeXLayoutEngine engine);
+
+int layoutChars(XeTeXLayoutEngine engine, uint16_t* chars, int32_t offset, int32_t count, int32_t max,
+ bool rightToLeft);
+
+void getGlyphs(XeTeXLayoutEngine engine, uint32_t* glyphs);
+void getGlyphAdvances(XeTeXLayoutEngine engine, float *advances);
+void getGlyphPositions(XeTeXLayoutEngine engine, FloatPoint* positions);
+
+float getPointSize(XeTeXLayoutEngine engine);
+
+void getAscentAndDescent(XeTeXLayoutEngine engine, float* ascent, float* descent);
+void getCapAndXHeight(XeTeXLayoutEngine engine, float* capheight, float* xheight);
+
+int getDefaultDirection(XeTeXLayoutEngine engine);
+
+uint32_t getRgbValue(XeTeXLayoutEngine engine);
+
+void getGlyphBounds(XeTeXLayoutEngine engine, uint32_t glyphID, GlyphBBox* bbox);
+
+float getGlyphWidthFromEngine(XeTeXLayoutEngine engine, uint32_t glyphID);
+
+void getGlyphHeightDepth(XeTeXLayoutEngine engine, uint32_t glyphID, float* height, float* depth);
+
+void getGlyphSidebearings(XeTeXLayoutEngine engine, uint32_t glyphID, float* lsb, float* rsb);
+
+float getGlyphItalCorr(XeTeXLayoutEngine engine, uint32_t glyphID);
+
+uint32_t mapCharToGlyph(XeTeXLayoutEngine engine, uint32_t charCode);
+
+int mapGlyphToIndex(XeTeXLayoutEngine engine, const char* glyphName);
+
+const char* getGlyphName(XeTeXFont font, uint16_t gid, int* len);
+
+int getFontCharRange(XeTeXLayoutEngine engine, int reqFirst);
+
+/* graphite interface functions... */
+bool initGraphiteBreaking(XeTeXLayoutEngine engine, const uint16_t* txtPtr, int txtLen);
+int findNextGraphiteBreak(void);
+
+bool usingOpenType(XeTeXLayoutEngine engine);
+bool usingGraphite(XeTeXLayoutEngine engine);
+bool isOpenTypeMathFont(XeTeXLayoutEngine engine);
+
+bool findGraphiteFeature(XeTeXLayoutEngine engine, const char* s, const char* e, hb_tag_t* f, int* v);
+
+uint32_t countGraphiteFeatures(XeTeXLayoutEngine engine);
+uint32_t getGraphiteFeatureCode(XeTeXLayoutEngine engine, uint32_t index);
+uint32_t countGraphiteFeatureSettings(XeTeXLayoutEngine engine, uint32_t feature);
+uint32_t getGraphiteFeatureSettingCode(XeTeXLayoutEngine engine, uint32_t feature, uint32_t index);
+uint32_t getGraphiteFeatureDefaultSetting(XeTeXLayoutEngine engine, uint32_t feature);
+char* getGraphiteFeatureLabel(XeTeXLayoutEngine engine, uint32_t feature);
+char* getGraphiteFeatureSettingLabel(XeTeXLayoutEngine engine, uint32_t feature, uint32_t setting);
+long findGraphiteFeatureNamed(XeTeXLayoutEngine engine, const char* name, int namelength);
+long findGraphiteFeatureSettingNamed(XeTeXLayoutEngine engine, uint32_t feature, const char* name, int namelength);
+
+#ifdef __cplusplus
+};
+#endif
+
+#endif /* XETEX_LAYOUT_INTERFACE_H */
+
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXOTMath.cpp b/Build/source/texk/web2c/xetexdir/XeTeXOTMath.cpp
new file mode 100644
index 00000000000..667f3c62558
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXOTMath.cpp
@@ -0,0 +1,516 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012-2015 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include <assert.h>
+#include <algorithm>
+
+#include "XeTeXOTMath.h"
+
+#include "XeTeX_web.h"
+#include "XeTeXLayoutInterface.h"
+#include "XeTeXFontInst.h"
+
+int
+get_ot_math_constant(int f, int n)
+{
+ hb_ot_math_constant_t constant = (hb_ot_math_constant_t) n;
+ hb_position_t rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ rval = hb_ot_math_get_constant(hbFont, constant);
+ /* scale according to font size, except the ones that are percentages */
+ switch (constant) {
+ case HB_OT_MATH_CONSTANT_SCRIPT_PERCENT_SCALE_DOWN:
+ case HB_OT_MATH_CONSTANT_SCRIPT_SCRIPT_PERCENT_SCALE_DOWN:
+ case HB_OT_MATH_CONSTANT_RADICAL_DEGREE_BOTTOM_RAISE_PERCENT:
+ break;
+ default:
+ rval = D2Fix(font->unitsToPoints(rval));
+ break;
+ }
+ }
+ return rval;
+}
+
+#define unknown ((hb_ot_math_constant_t)-1)
+
+/* fontdimen IDs for math symbols font (family 2) */
+#define math_x_height 5
+#define math_quad 6
+#define num1 8 /* numerator shift-up in display styles */
+#define num2 9 /* numerator shift-up in non-display, non-\.{\\atop} */
+#define num3 10 /* numerator shift-up in non-display \.{\\atop} */
+#define denom1 11 /* denominator shift-down in display styles */
+#define denom2 12 /* denominator shift-down in non-display styles */
+#define sup1 13 /* superscript shift-up in uncramped display style */
+#define sup2 14 /* superscript shift-up in uncramped non-display */
+#define sup3 15 /* superscript shift-up in cramped styles */
+#define sub1 16 /* subscript shift-down if superscript is absent */
+#define sub2 17 /* subscript shift-down if superscript is present */
+#define sup_drop 18 /* superscript baseline below top of large box */
+#define sub_drop 19 /* subscript baseline below bottom of large box */
+#define delim1 20 /* size of \.{\\atopwithdelims} delimiters */
+#define delim2 21 /* size of \.{\\atopwithdelims} delimiters in non-displays */
+#define axis_height 22 /* height of fraction lines above the baseline */
+
+const hb_ot_math_constant_t TeX_sym_to_OT_map[] = {
+ unknown,
+ unknown,
+ unknown,
+ unknown,
+ unknown,
+ HB_OT_MATH_CONSTANT_ACCENT_BASE_HEIGHT, // x-height
+ unknown, // quad
+ unknown,
+ HB_OT_MATH_CONSTANT_FRACTION_NUMERATOR_DISPLAY_STYLE_SHIFT_UP,
+ HB_OT_MATH_CONSTANT_FRACTION_NUMERATOR_SHIFT_UP,
+ HB_OT_MATH_CONSTANT_STACK_TOP_SHIFT_UP,
+ HB_OT_MATH_CONSTANT_FRACTION_DENOMINATOR_DISPLAY_STYLE_SHIFT_DOWN,
+ HB_OT_MATH_CONSTANT_FRACTION_DENOMINATOR_SHIFT_DOWN,
+ HB_OT_MATH_CONSTANT_SUPERSCRIPT_SHIFT_UP, // ??
+ HB_OT_MATH_CONSTANT_SUPERSCRIPT_SHIFT_UP, // ??
+ HB_OT_MATH_CONSTANT_SUPERSCRIPT_SHIFT_UP_CRAMPED,
+ HB_OT_MATH_CONSTANT_SUBSCRIPT_SHIFT_DOWN, // ??
+ HB_OT_MATH_CONSTANT_SUBSCRIPT_SHIFT_DOWN, // ??
+ HB_OT_MATH_CONSTANT_SUPERSCRIPT_BASELINE_DROP_MAX, // ??
+ HB_OT_MATH_CONSTANT_SUBSCRIPT_BASELINE_DROP_MIN, // ??
+ HB_OT_MATH_CONSTANT_DELIMITED_SUB_FORMULA_MIN_HEIGHT,
+ unknown, // using quad instead for now
+ HB_OT_MATH_CONSTANT_AXIS_HEIGHT
+};
+
+int
+get_native_mathsy_param(int f, int n)
+{
+ int rval = 0;
+
+ if (n == math_quad) {
+ rval = fontsize[f];
+ }
+ else if (n == delim2) { // XXX not sure what OT parameter we should use here;
+ // for now we use 1.5em, clamped to delim1 height
+ rval = std::min<int>(1.5 * fontsize[f], get_native_mathsy_param(f, delim1));
+ }
+ else {
+ if (n < sizeof(TeX_sym_to_OT_map) / sizeof(hb_ot_math_constant_t)) {
+ hb_ot_math_constant_t ot_index = TeX_sym_to_OT_map[n];
+ if (ot_index != unknown)
+ rval = get_ot_math_constant(f, (int)ot_index);
+ }
+ }
+// fprintf(stderr, " math_sy(%d, %d) returns %.3f\n", f, n, Fix2D(rval));
+
+ return rval;
+}
+
+/* fontdimen IDs for math extension font (family 3) */
+#define default_rule_thickness 8 /* thickness of \.{\\over} bars */
+#define big_op_spacing1 9 /* minimum clearance above a displayed op */
+#define big_op_spacing2 10 /* minimum clearance below a displayed op */
+#define big_op_spacing3 11 /* minimum baselineskip above displayed op */
+#define big_op_spacing4 12 /* minimum baselineskip below displayed op */
+#define big_op_spacing5 13 /* padding above and below displayed limits */
+
+const hb_ot_math_constant_t TeX_ext_to_OT_map[] = {
+ unknown,
+ unknown,
+ unknown,
+ unknown,
+ unknown,
+ HB_OT_MATH_CONSTANT_ACCENT_BASE_HEIGHT, // x-height
+ unknown, // quad
+ unknown,
+ HB_OT_MATH_CONSTANT_FRACTION_RULE_THICKNESS, // default_rule_thickness
+ HB_OT_MATH_CONSTANT_UPPER_LIMIT_GAP_MIN, // big_op_spacing1
+ HB_OT_MATH_CONSTANT_LOWER_LIMIT_GAP_MIN, // big_op_spacing2
+ HB_OT_MATH_CONSTANT_UPPER_LIMIT_BASELINE_RISE_MIN, // big_op_spacing3
+ HB_OT_MATH_CONSTANT_LOWER_LIMIT_BASELINE_DROP_MIN, // big_op_spacing4
+ HB_OT_MATH_CONSTANT_STACK_GAP_MIN // big_op_spacing5
+};
+
+int
+get_native_mathex_param(int f, int n)
+{
+ int rval = 0;
+
+ if (n == math_quad)
+ rval = fontsize[f];
+ else {
+ if (n < sizeof(TeX_ext_to_OT_map) / sizeof(hb_ot_math_constant_t)) {
+ hb_ot_math_constant_t ot_index = TeX_ext_to_OT_map[n];
+ if (ot_index != unknown)
+ rval = get_ot_math_constant(f, (int)ot_index);
+ }
+ }
+// fprintf(stderr, " math_ex(%d, %d) returns %.3f\n", f, n, Fix2D(rval));
+
+ return rval;
+}
+
+int
+get_ot_math_variant(int f, int g, int v, integer* adv, int horiz)
+{
+ hb_codepoint_t rval = g;
+ *adv = -1;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ hb_ot_math_glyph_variant_t variant[1];
+ unsigned int count = 1;
+ hb_ot_math_get_glyph_variants(hbFont, g, horiz ? HB_DIRECTION_RTL : HB_DIRECTION_TTB, v, &count, variant);
+ if (count > 0) {
+ rval = variant->glyph;
+ *adv = D2Fix(font->unitsToPoints(variant->advance));
+ }
+ }
+
+ return rval;
+}
+
+
+void*
+get_ot_assembly_ptr(int f, int g, int horiz)
+{
+ void* rval = NULL;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+
+ unsigned int count = hb_ot_math_get_glyph_assembly(hbFont, g, horiz ? HB_DIRECTION_RTL : HB_DIRECTION_TTB, 0, NULL, NULL, NULL);
+ if (count > 0) {
+ GlyphAssembly* a = (GlyphAssembly*) xmalloc(sizeof(GlyphAssembly));
+ a->count = count;
+ a->parts = (hb_ot_math_glyph_part_t*) xmalloc(count * sizeof(hb_ot_math_glyph_part_t));
+ hb_ot_math_get_glyph_assembly(hbFont, g, horiz ? HB_DIRECTION_RTL : HB_DIRECTION_TTB, 0, &a->count, a->parts, NULL);
+ rval = (void*) a;
+ }
+ }
+
+ return rval;
+}
+
+void
+free_ot_assembly(GlyphAssembly* a)
+{
+ if (!a)
+ return;
+ free (a->parts);
+ free (a);
+}
+
+int
+get_ot_math_ital_corr(int f, int g)
+{
+ hb_position_t rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ rval = hb_ot_math_get_glyph_italics_correction(hbFont, g);
+ rval = D2Fix(font->unitsToPoints(rval));
+ }
+
+ return rval;
+}
+
+int
+get_ot_math_accent_pos(int f, int g)
+{
+ hb_position_t rval = 0x7fffffffUL;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ rval = hb_ot_math_get_glyph_top_accent_attachment(hbFont, g);
+ rval = D2Fix(font->unitsToPoints(rval));
+ }
+
+ return rval;
+}
+
+int
+ot_min_connector_overlap(int f)
+{
+ hb_position_t rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ rval = hb_ot_math_get_min_connector_overlap(hbFont, HB_DIRECTION_RTL);
+ rval = D2Fix(font->unitsToPoints(rval));
+ }
+
+ return rval;
+}
+
+static int
+getMathKernAt(int f, int g, int height, hb_ot_math_kern_t side)
+{
+ hb_position_t rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ hb_font_t* hbFont = font->getHbFont();
+ rval = hb_ot_math_get_glyph_kerning(hbFont, g, side, height);
+ }
+
+ return rval;
+}
+
+static float
+glyph_height(int f, int g)
+{
+ float rval = 0.0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[f];
+ getGlyphHeightDepth(engine, g, &rval, NULL);
+ }
+
+ return rval;
+}
+
+static float
+glyph_depth(int f, int g)
+{
+ float rval = 0.0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[f];
+ getGlyphHeightDepth(engine, g, NULL, &rval);
+ }
+
+ return rval;
+}
+
+// keep in sync with xetex.web
+#define sup_cmd 0
+#define sub_cmd 1
+
+int
+get_ot_math_kern(int f, int g, // Base font and glyph number
+ int sf, int sg, // Sub/superscript font and glyph number
+ int cmd, // sup_cmd or sub_cmd
+ int shift_scaled // TeX scaled points
+ )
+{
+ int rval = 0;
+
+ // Cf. https://docs.microsoft.com/en-us/typography/opentype/spec/math#mathkerninfo-table
+
+ if (fontarea[f] == OTGR_FONT_FLAG && fontarea[sf] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*) getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+
+ XeTeXFontInst* sfont = (XeTeXFontInst*) getFont((XeTeXLayoutEngine)fontlayoutengine[sf]);
+
+ // Do calculations in glyph units.
+
+ // The next four lines could be streamlined by having
+ // glyph_height() and glyph_depth() return the metrics in glyph
+ // units, but that would require tweaking getGlyphHeightDepth(),
+ // which is used elsewhere.
+
+ int g_height = font->pointsToUnits(glyph_height(f, g));
+ int g_depth = font->pointsToUnits(glyph_depth(f, g));
+
+ int sg_height = sfont->pointsToUnits(glyph_height(sf, sg));
+ int sg_depth = sfont->pointsToUnits(glyph_depth(sf, sg));
+
+ // Convert the shift amount to base glyph units.
+ int shift = font->pointsToUnits(Fix2D(shift_scaled));
+
+ // Multiply sub/superscript glyph units by scale_factor to make
+ // them commensurate with base glyph units.
+
+ float f_size = font->getPointSize();
+ float sf_size = sfont->getPointSize();
+
+ assert(f_size != 0.0);
+
+ float scale_factor = sf_size / f_size;
+
+ if (cmd == sup_cmd) { // superscript
+ // (1) Calculate the kern at the bottom of the superscript-glyph
+ // bounding box.
+
+ // In base glyph units, the bottom of the superscript is at a
+ // distance of (shift - scale_factor * sg_depth) above the
+ // baseline.
+
+ int kern = getMathKernAt(f, g, shift - scale_factor * sg_depth,
+ HB_OT_MATH_KERN_TOP_RIGHT);
+
+ // In superscript glyph units, the bottom of the superscript is
+ // a distance of sg_depth below the baseline.
+
+ int skern = getMathKernAt(sf, sg, -sg_depth,
+ HB_OT_MATH_KERN_BOTTOM_LEFT);
+
+ int top_kern = kern + scale_factor * skern;
+
+ // (2) Calculate the kern at the top of the base-glyph bounding
+ // box.
+
+ // In base glyph units, the top of the base glyph is a distance
+ // of g_height above the baseline.
+
+ kern = getMathKernAt(f, g, g_height, HB_OT_MATH_KERN_TOP_RIGHT);
+
+ // In superscript glyph units, the top of the base glyph is a
+ // distance of (g_height - shift)/scale_factor above the
+ // baseline.
+
+ skern = getMathKernAt(sf, sg, (g_height - shift) / scale_factor,
+ HB_OT_MATH_KERN_BOTTOM_LEFT);
+
+ int bot_kern = kern + scale_factor * skern;
+
+ // (3) The spec says "Take the minimum of these two sums," but
+ // surely we want the kern that results in the greater
+ // separation between the base and the superscript? That
+ // corresponds to the maximum. (In the case where both kerns
+ // are negative, this is the same as the kern with the minimum
+ // *absolute* value, which is presumably what the spec means.)
+
+ rval = (top_kern > bot_kern) ? top_kern : bot_kern;
+ } else if (cmd == sub_cmd) { // subscript
+ // (1) Calculate the kern at the top of the subscript-glyph
+ // bounding box.
+
+ // In base glyph units,, the top of the subscript is at a height
+ // of scale_factor * sg_height - shift.
+
+ int kern = getMathKernAt(f, g, scale_factor * sg_height - shift,
+ HB_OT_MATH_KERN_BOTTOM_RIGHT);
+
+ // In subscript glyph units, the top of the subscript-glyph
+ // bounding box is sg_height above the baseline.
+
+ int skern = getMathKernAt(sf, sg, sg_height,
+ HB_OT_MATH_KERN_TOP_LEFT);
+
+ int top_kern = kern + scale_factor * skern;
+
+ // (2) Calculate the kern at the bottom of the base-glyph
+ // bounding box.
+
+ // In base glyph units, the bottom of the base-glyph is at
+ // g_depth below the baseline:
+
+ kern = getMathKernAt(f, g, -g_depth,
+ HB_OT_MATH_KERN_BOTTOM_RIGHT);
+
+ // In subscript glyph units, the bottom of the base glyph is at
+ // a height of shift - g_depth above the baseline, translated
+ // into subscript glyph units.
+
+ skern = getMathKernAt(sf, sg, (shift - g_depth) / scale_factor,
+ HB_OT_MATH_KERN_TOP_LEFT);
+
+ int bot_kern = kern + scale_factor * skern;
+
+ // (3) See above.
+
+ rval = (top_kern > bot_kern) ? top_kern : bot_kern;
+ } else {
+ assert(0); // we should not reach here
+ }
+
+ rval = D2Fix(font->unitsToPoints(rval));
+ }
+
+ return rval;
+}
+
+int
+ot_part_count(const GlyphAssembly* a)
+{
+ return a->count;
+}
+
+int
+ot_part_glyph(const GlyphAssembly* a, int i)
+{
+ return a->parts[i].glyph;
+}
+
+int
+ot_part_is_extender(const GlyphAssembly* a, int i)
+{
+ return (a->parts[i].flags & HB_MATH_GLYPH_PART_FLAG_EXTENDER) != 0;
+}
+
+int
+ot_part_start_connector(int f, const GlyphAssembly* a, int i)
+{
+ int rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ rval = D2Fix(font->unitsToPoints(a->parts[i].start_connector_length));
+ }
+
+ return rval;
+}
+
+int
+ot_part_end_connector(int f, const GlyphAssembly* a, int i)
+{
+ int rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ rval = D2Fix(font->unitsToPoints(a->parts[i].end_connector_length));
+ }
+
+ return rval;
+}
+
+int
+ot_part_full_advance(int f, const GlyphAssembly* a, int i)
+{
+ int rval = 0;
+
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXFontInst* font = (XeTeXFontInst*)getFont((XeTeXLayoutEngine)fontlayoutengine[f]);
+ rval = D2Fix(font->unitsToPoints(a->parts[i].full_advance));
+ }
+
+ return rval;
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXOTMath.h b/Build/source/texk/web2c/xetexdir/XeTeXOTMath.h
new file mode 100644
index 00000000000..1b8362bb0ea
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXOTMath.h
@@ -0,0 +1,67 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEX_OT_MATH__
+#define __XETEX_OT_MATH__
+
+#include "XeTeX_ext.h"
+
+typedef struct {
+ unsigned int count;
+ hb_ot_math_glyph_part_t* parts;
+} GlyphAssembly;
+
+/* public "C" APIs for calling from Web(-to-C) code */
+#ifdef __cplusplus
+extern "C" {
+#endif
+ int get_native_mathsy_param(int f, int n);
+ int get_native_mathex_param(int f, int n);
+ int get_ot_math_constant(int f, int n);
+ int get_ot_math_variant(int f, int g, int v, integer* adv, int horiz);
+ void* get_ot_assembly_ptr(int f, int g, int horiz);
+ void free_ot_assembly(GlyphAssembly* a);
+ int get_ot_math_ital_corr(int f, int g);
+ int get_ot_math_accent_pos(int f, int g);
+ int get_ot_math_kern(int f, int g, int sf, int sg, int cmd, int shift);
+ int ot_part_count(const GlyphAssembly* a);
+ int ot_part_glyph(const GlyphAssembly* a, int i);
+ int ot_part_is_extender(const GlyphAssembly* a, int i);
+ int ot_part_start_connector(int f, const GlyphAssembly* a, int i);
+ int ot_part_end_connector(int f, const GlyphAssembly* a, int i);
+ int ot_part_full_advance(int f, const GlyphAssembly* a, int i);
+ int ot_min_connector_overlap(int f);
+#ifdef __cplusplus
+};
+#endif
+
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/XeTeX_ext.c b/Build/source/texk/web2c/xetexdir/XeTeX_ext.c
new file mode 100644
index 00000000000..4e7d113ad7a
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeX_ext.c
@@ -0,0 +1,2940 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009, 2011 by Jonathan Kew
+ Copyright (c) 2012-2015 by Khaled Hosny
+ Copyright (c) 2012, 2013 by Jiang Jiang
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/* XeTeX_ext.c
+ * additional plain C extensions for XeTeX - mostly platform-neutral
+ */
+
+#include <w2c/config.h>
+
+/*
+ * From TeX Live 2021, we use pplib by Pawe\l Jackowski instead of
+ * libpoppler
+ */
+#include <ppapi.h>
+
+#include <png.h>
+#include <zlib.h>
+#include <graphite2/Font.h>
+
+#ifdef _MSC_VER
+#undef timezone
+#endif
+
+#include <time.h> /* For `struct tm'. */
+#if defined (HAVE_SYS_TIME_H)
+#include <sys/time.h>
+#elif defined (HAVE_SYS_TIMEB_H)
+#include <sys/timeb.h>
+#endif
+
+#define EXTERN extern
+#include "xetexd.h"
+
+#include "XeTeX_ext.h"
+
+#include <teckit/TECkit_Engine.h>
+
+#include <kpathsea/c-ctype.h>
+#include <kpathsea/line.h>
+#include <kpathsea/readable.h>
+#include <kpathsea/variable.h>
+#include <kpathsea/absolute.h>
+#if defined(WIN32)
+#include <kpathsea/concatn.h>
+#endif
+
+#include <math.h> /* for fabs() */
+
+#if defined(__STDC__)
+#include <locale.h>
+#endif
+
+#include <signal.h> /* Catch interrupts. */
+
+#include "XeTeXLayoutInterface.h"
+
+#include "XeTeXswap.h"
+
+#include <unicode/ubidi.h>
+#include <unicode/ubrk.h>
+#include <unicode/ucnv.h>
+
+#include <assert.h>
+
+/* for reading input files, we don't need the default locking routines
+ as xetex is a single-threaded program */
+#ifdef WIN32
+#ifdef __MINGW32__
+/* MinGW (both 32- and 64-bit) has problems with _getc_nolock() and/or _ungetc_nolock() */
+#define GETC(f) getc(f)
+#define UNGETC(c,f) ungetc(c,f)
+#else
+#define GETC(f) _getc_nolock(f)
+#define UNGETC(c,f) _ungetc_nolock(c,f)
+#endif
+#else
+#define GETC(f) getc_unlocked(f)
+#define UNGETC(c,f) ungetc(c,f)
+#endif
+
+/* tables/values used in UTF-8 interpretation -
+ code is based on ConvertUTF.[ch] sample code
+ published by the Unicode consortium */
+const uint32_t
+offsetsFromUTF8[6] = {
+ 0x00000000UL,
+ 0x00003080UL,
+ 0x000E2080UL,
+ 0x03C82080UL,
+ 0xFA082080UL,
+ 0x82082080UL
+};
+
+const uint8_t
+bytesFromUTF8[256] = {
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+ 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+ 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5
+};
+
+const uint8_t
+firstByteMark[7] = {
+ 0x00, 0x00, 0xC0, 0xE0, 0xF0, 0xF8, 0xFC
+};
+
+const int halfShift = 10;
+const uint32_t halfBase = 0x0010000UL;
+const uint32_t halfMask = 0x3FFUL;
+const uint32_t kSurrogateHighStart = 0xD800UL;
+const uint32_t kSurrogateHighEnd = 0xDBFFUL;
+const uint32_t kSurrogateLowStart = 0xDC00UL;
+const uint32_t kSurrogateLowEnd = 0xDFFFUL;
+const uint32_t byteMask = 0x000000BFUL;
+const uint32_t byteMark = 0x00000080UL;
+
+
+/* if the user specifies a paper size or output driver program */
+const char *papersize;
+const char *outputdriver = "xdvipdfmx -q -E"; /* default to portable xdvipdfmx driver */
+
+
+void initversionstring(char **versions)
+{
+#ifndef XETEX_MAC
+ int fc_version = FcGetVersion();
+#endif
+ FT_Int ftMajor, ftMinor, ftPatch;
+ int grMajor, grMinor, grBugfix;
+ UVersionInfo icuVersion;
+ char icu_version[U_MAX_VERSION_STRING_LENGTH] = "";
+
+ const_string fmt =
+ "Compiled with ICU version %s; using %s\n"
+ "Compiled with zlib version %s; using %s\n"
+ "Compiled with FreeType2 version %d.%d.%d; using %d.%d.%d\n"
+ "Compiled with Graphite2 version %d.%d.%d; using %d.%d.%d\n"
+ "Compiled with HarfBuzz version %s; using %s\n"
+ "Compiled with libpng version %s; using %s\n"
+ "Compiled with pplib version %s\n"
+#ifdef XETEX_MAC
+ "Using Mac OS X Core Text and Cocoa frameworks\n"
+#else
+ "Compiled with fontconfig version %d.%d.%d; using %d.%d.%d\n"
+#endif
+ ;
+
+ int len = strlen(fmt)
+ + strlen(U_ICU_VERSION)
+ + strlen(icu_version)
+ + strlen(ZLIB_VERSION)
+ + strlen(zlib_version)
+ + strlen(HB_VERSION_STRING)
+ + strlen(hb_version_string())
+ + strlen(PNG_LIBPNG_VER_STRING)
+ + strlen(png_libpng_ver)
+ + strlen(pplib_version)
+#ifndef XETEX_MAC
+ + 6 * 3 /* for fontconfig version #s (won't really need 3 digits per field!) */
+#endif
+ + 6 * 3 /* for graphite2 version #s (ditto) */
+ + 6 * 3; /* for freetype version #s (ditto) */
+
+ *versions = (char *) xmalloc(len + 1);
+ /* len will be more than enough, because of the placeholder chars in fmt
+ that get replaced by the arguments */
+
+ u_getVersion(icuVersion);
+ u_versionToString(icuVersion, icu_version);
+
+ if (gFreeTypeLibrary == 0 && FT_Init_FreeType(&gFreeTypeLibrary) != 0) {
+ fprintf(stderr, "FreeType initialization failed!\n");
+ exit(9);
+ }
+ FT_Library_Version(gFreeTypeLibrary, &ftMajor, &ftMinor, &ftPatch);
+
+ gr_engine_version(&grMajor, &grMinor, &grBugfix);
+
+ (void)sprintf(*versions, fmt,
+ U_ICU_VERSION, icu_version,
+ ZLIB_VERSION, zlib_version,
+ FREETYPE_MAJOR, FREETYPE_MINOR, FREETYPE_PATCH,
+ ftMajor, ftMinor, ftPatch,
+ GR2_VERSION_MAJOR, GR2_VERSION_MINOR, GR2_VERSION_BUGFIX,
+ grMajor, grMinor, grBugfix,
+ HB_VERSION_STRING, hb_version_string(),
+ PNG_LIBPNG_VER_STRING, png_libpng_ver, pplib_version
+#ifndef XETEX_MAC
+ ,
+ FC_VERSION / 10000, (FC_VERSION % 10000) / 100, FC_VERSION % 100,
+ fc_version / 10000, (fc_version % 10000) / 100, fc_version % 100
+#endif
+ );
+}
+
+
+void
+setinputfileencoding(UFILE* f, integer mode, integer encodingData)
+{
+ if ((f->encodingMode == ICUMAPPING) && (f->conversionData != NULL))
+ ucnv_close((UConverter*)(f->conversionData));
+ f->conversionData = 0;
+
+ switch (mode) {
+ case UTF8:
+ case UTF16BE:
+ case UTF16LE:
+ case RAW:
+ f->encodingMode = mode;
+ break;
+
+ case ICUMAPPING:
+ {
+ char* name = gettexstring(encodingData);
+ UErrorCode err = U_ZERO_ERROR;
+ UConverter* cnv = ucnv_open(name, &err);
+ if (cnv == NULL) {
+ begindiagnostic();
+ printnl('E');
+ printcstring("rror ");
+ printint(err);
+ printcstring(" creating Unicode converter for `");
+ printcstring(name);
+ printcstring("'; reading as raw bytes");
+ enddiagnostic(1);
+ f->encodingMode = RAW;
+ } else {
+ f->encodingMode = ICUMAPPING;
+ f->conversionData = cnv;
+ }
+ free(name);
+ }
+ break;
+ }
+}
+
+static void
+buffer_overflow(void)
+{
+ fprintf (stderr, "! Unable to read an entire line---bufsize=%u.\n",
+ (unsigned) bufsize);
+ fputs ("Please increase buf_size in texmf.cnf.\n", stderr);
+ uexit (1);
+}
+
+static void
+conversion_error(int errcode)
+{
+ begindiagnostic();
+ printnl('U');
+ printcstring("nicode conversion failed (ICU error code = ");
+ printint(errcode);
+ printcstring(") discarding any remaining text");
+ enddiagnostic(1);
+}
+
+#ifdef WORDS_BIGENDIAN
+#define NATIVE_UTF32 kForm_UTF32BE
+#else
+#define NATIVE_UTF32 kForm_UTF32LE
+#endif
+
+static void
+apply_normalization(uint32_t* buf, int len, int norm)
+{
+ static TECkit_Converter normalizers[2] = { NULL, NULL };
+
+ TECkit_Status status;
+ UInt32 inUsed, outUsed;
+ TECkit_Converter *normPtr = &normalizers[norm - 1];
+ if (*normPtr == NULL) {
+ status = TECkit_CreateConverter(NULL, 0, 1,
+ NATIVE_UTF32, NATIVE_UTF32 | (norm == 1 ? kForm_NFC : kForm_NFD),
+ &*normPtr);
+ if (status != kStatus_NoError) {
+ fprintf(stderr, "! Failed to create normalizer: error code = %d\n", (int)status);
+ uexit (1);
+ }
+ }
+
+ status = TECkit_ConvertBuffer(*normPtr, (Byte*)buf, len * sizeof(UInt32), &inUsed,
+ (Byte*)&buffer[first], sizeof(*buffer) * (bufsize - first), &outUsed, 1);
+ if (status != kStatus_NoError)
+ buffer_overflow();
+ last = first + outUsed / sizeof(*buffer);
+}
+
+#ifdef WORDS_BIGENDIAN
+#define UCNV_UTF32_NativeEndian UCNV_UTF32_BigEndian
+#else
+#define UCNV_UTF32_NativeEndian UCNV_UTF32_LittleEndian
+#endif
+
+int
+input_line(UFILE* f)
+{
+static char* byteBuffer = NULL;
+static uint32_t *utf32Buf = NULL;
+ int i, tmpLen;
+ int norm = getinputnormalizationstate();
+#ifdef WIN32
+ const int fd = fileno(f->f);
+ if (fd == _fileno(stdin) && _isatty(fd)) {
+ f->encodingMode = WIN32CONSOLE;
+ }
+#endif
+
+ last = first;
+
+ if (f->encodingMode == ICUMAPPING) {
+ uint32_t bytesRead = 0;
+ UConverter* cnv;
+ int outLen;
+ UErrorCode errorCode = U_ZERO_ERROR;
+
+ if (byteBuffer == NULL)
+ byteBuffer = (char*) xmalloc(bufsize + 1);
+
+ /* Recognize either LF or CR as a line terminator; skip initial LF if prev line ended with CR. */
+ i = GETC(f->f);
+ if (f->skipNextLF) {
+ f->skipNextLF = 0;
+ if (i == '\n')
+ i = GETC(f->f);
+ }
+
+ if (i != EOF && i != '\n' && i != '\r')
+ byteBuffer[bytesRead++] = i;
+ if (i != EOF && i != '\n' && i != '\r')
+ while (bytesRead < bufsize && (i = GETC(f->f)) != EOF && i != '\n' && i != '\r')
+ byteBuffer[bytesRead++] = i;
+
+ if (i == EOF && errno != EINTR && bytesRead == 0)
+ return false;
+
+ if (i != EOF && i != '\n' && i != '\r')
+ buffer_overflow();
+
+ /* now apply the mapping to turn external bytes into Unicode characters in buffer */
+ cnv = (UConverter*)(f->conversionData);
+ switch (norm) {
+ case 1: // NFC
+ case 2: // NFD
+ if (utf32Buf == NULL)
+ utf32Buf = (uint32_t*) xcalloc(bufsize, sizeof(uint32_t));
+ tmpLen = ucnv_toAlgorithmic(UCNV_UTF32_NativeEndian, cnv,
+ (char*)utf32Buf, bufsize * sizeof(*utf32Buf),
+ byteBuffer, bytesRead, &errorCode);
+ if (errorCode != 0) {
+ conversion_error((int)errorCode);
+ return false;
+ }
+ apply_normalization(utf32Buf, tmpLen / sizeof(*utf32Buf), norm); // sets 'last' correctly
+ break;
+
+ default: // none
+ outLen = ucnv_toAlgorithmic(UCNV_UTF32_NativeEndian, cnv,
+ (char*)&buffer[first], sizeof(*buffer) * (bufsize - first),
+ byteBuffer, bytesRead, &errorCode);
+ if (errorCode != 0) {
+ conversion_error((int)errorCode);
+ return false;
+ }
+ outLen /= sizeof(*buffer);
+ last = first + outLen;
+ break;
+ }
+ } else {
+ /* Recognize either LF or CR as a line terminator; skip initial LF if prev line ended with CR. */
+ i = get_uni_c(f);
+ if (f->skipNextLF) {
+ f->skipNextLF = 0;
+ if (i == '\n')
+ i = get_uni_c(f);
+ }
+
+ switch (norm) {
+ case 1: // NFC
+ case 2: // NFD
+ // read Unicode chars into utf32Buf as UTF32
+ if (utf32Buf == NULL)
+ utf32Buf = (uint32_t*) xcalloc(bufsize, sizeof(uint32_t));
+ tmpLen = 0;
+ if (i != EOF && i != '\n' && i != '\r')
+ utf32Buf[tmpLen++] = i;
+ if (i != EOF && i != '\n' && i != '\r')
+ while (tmpLen < bufsize && (i = get_uni_c(f)) != EOF && i != '\n' && i != '\r')
+ utf32Buf[tmpLen++] = i;
+
+ if (i == EOF && errno != EINTR && tmpLen == 0)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small. */
+ if (i != EOF && i != '\n' && i != '\r')
+ buffer_overflow();
+ apply_normalization(utf32Buf, tmpLen, norm);
+ break;
+
+ default: // none
+#ifdef WIN32
+ if (f->encodingMode == WIN32CONSOLE && i == 0x1a) /* Ctrl+Z */
+ return false;
+#endif
+ if (last < bufsize && i != EOF && i != '\n' && i != '\r')
+ buffer[last++] = i;
+ if (i != EOF && i != '\n' && i != '\r')
+ while (last < bufsize && (i = get_uni_c(f)) != EOF && i != '\n' && i != '\r')
+ buffer[last++] = i;
+
+ if (i == EOF && errno != EINTR && last == first)
+ return false;
+
+ /* We didn't get the whole line because our buffer was too small. */
+ if (i != EOF && i != '\n' && i != '\r')
+ buffer_overflow();
+ break;
+ }
+ }
+
+ /* If line ended with CR, remember to skip following LF. */
+ if (i == '\r')
+ f->skipNextLF = 1;
+
+ buffer[last] = ' ';
+ if (last >= maxbufstack)
+ maxbufstack = last;
+
+ /* Trim trailing space or EOL characters. */
+#define IS_SPC_OR_EOL(c) ((c) == ' ' || (c) == '\r' || (c) == '\n')
+ while (last > first && IS_SPC_OR_EOL(buffer[last - 1]))
+ --last;
+
+ return true;
+}
+
+static void die(const_string s, int i)
+{
+ fprintf(stderr, s, i);
+ fprintf(stderr, " - exiting\n");
+ exit(3);
+}
+
+static UBreakIterator* brkIter = NULL;
+static int brkLocaleStrNum = 0;
+
+void
+linebreakstart(int f, integer localeStrNum, uint16_t* text, integer textLength)
+{
+ UErrorCode status = U_ZERO_ERROR;
+ char* locale = (char*)gettexstring(localeStrNum);
+
+ if (fontarea[f] == OTGR_FONT_FLAG && strcmp(locale, "G") == 0) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine) fontlayoutengine[f];
+ if (initGraphiteBreaking(engine, text, textLength))
+ /* user asked for Graphite line breaking and the font supports it */
+ return;
+ }
+
+ if ((localeStrNum != brkLocaleStrNum) && (brkIter != NULL)) {
+ ubrk_close(brkIter);
+ brkIter = NULL;
+ }
+
+ if (brkIter == NULL) {
+ brkIter = ubrk_open(UBRK_LINE, locale, NULL, 0, &status);
+ if (U_FAILURE(status)) {
+ begindiagnostic();
+ printnl('E');
+ printcstring("rror ");
+ printint(status);
+ printcstring(" creating linebreak iterator for locale `");
+ printcstring(locale);
+ printcstring("'; trying default locale `en_us'.");
+ enddiagnostic(1);
+ if (brkIter != NULL)
+ ubrk_close(brkIter);
+ status = U_ZERO_ERROR;
+ brkIter = ubrk_open(UBRK_LINE, "en_us", NULL, 0, &status);
+ }
+ free(locale);
+ brkLocaleStrNum = localeStrNum;
+ }
+
+ if (brkIter == NULL) {
+ die("! failed to create linebreak iterator, status=%d", (int)status);
+ }
+
+ ubrk_setText(brkIter, (UChar*) text, textLength, &status);
+}
+
+int
+linebreaknext(void)
+{
+ if (brkIter != NULL)
+ return ubrk_next((UBreakIterator*)brkIter);
+ else
+ return findNextGraphiteBreak();
+}
+
+int
+getencodingmodeandinfo(integer* info)
+{
+ /* \XeTeXinputencoding "enc-name"
+ * -> name is packed in |nameoffile| as a C string, starting at [1]
+ * Check if it's a built-in name; if not, try to open an ICU converter by that name
+ */
+ UErrorCode err = U_ZERO_ERROR;
+ UConverter* cnv;
+ char* name = (char*)nameoffile + 1;
+ *info = 0;
+ if (strcasecmp(name, "auto") == 0) {
+ return AUTO;
+ }
+ if (strcasecmp(name, "utf8") == 0) {
+ return UTF8;
+ }
+ if (strcasecmp(name, "utf16") == 0) { /* depends on host platform */
+#ifdef WORDS_BIGENDIAN
+ return UTF16BE;
+#else
+ return UTF16LE;
+#endif
+ }
+ if (strcasecmp(name, "utf16be") == 0) {
+ return UTF16BE;
+ }
+ if (strcasecmp(name, "utf16le") == 0) {
+ return UTF16LE;
+ }
+ if (strcasecmp(name, "bytes") == 0) {
+ return RAW;
+ }
+
+ /* try for an ICU converter */
+ cnv = ucnv_open(name, &err);
+ if (cnv == NULL) {
+ begindiagnostic();
+ printnl('U'); /* ensure message starts on a new line */
+ printcstring("nknown encoding `");
+ printcstring(name);
+ printcstring("'; reading as raw bytes");
+ enddiagnostic(1);
+ return RAW;
+ } else {
+ ucnv_close(cnv);
+ *info = maketexstring(name);
+ return ICUMAPPING;
+ }
+}
+
+void
+printutf8str(const unsigned char* str, int len)
+{
+ while (len-- > 0)
+ printrawchar(*(str++), true); /* bypass utf-8 encoding done in print_char() */
+}
+
+void
+printchars(const unsigned short* str, int len)
+{
+ while (len-- > 0)
+ printchar(*(str++));
+}
+
+#ifdef WORDS_BIGENDIAN
+#define UTF16_NATIVE kForm_UTF16BE
+#else
+#define UTF16_NATIVE kForm_UTF16LE
+#endif
+
+static void*
+load_mapping_file(const char* s, const char* e, char byteMapping)
+{
+ char* mapPath;
+ TECkit_Converter cnv = 0;
+ char* buffer = (char*) xmalloc(e - s + 5);
+ strncpy(buffer, s, e - s);
+ buffer[e - s] = 0;
+ strcat(buffer, ".tec");
+ mapPath = kpse_find_file(buffer, kpse_miscfonts_format, 1);
+
+ if (mapPath) {
+ FILE* mapFile = fopen(mapPath, FOPEN_RBIN_MODE);
+ free(mapPath);
+ if (mapFile) {
+ uint32_t mappingSize;
+ Byte* mapping;
+ /* TECkit_Status status; */
+ fseek(mapFile, 0, SEEK_END);
+ mappingSize = ftell(mapFile);
+ fseek(mapFile, 0, SEEK_SET);
+ mapping = (Byte*) xmalloc(mappingSize);
+ fread(mapping, 1, mappingSize, mapFile);
+ fclose(mapFile);
+ if (byteMapping != 0)
+ /* status = */ TECkit_CreateConverter(mapping, mappingSize,
+ false,
+ UTF16_NATIVE, kForm_Bytes,
+ &cnv);
+ else
+ /* status = */ TECkit_CreateConverter(mapping, mappingSize,
+ true,
+ UTF16_NATIVE, UTF16_NATIVE,
+ &cnv);
+ free(mapping);
+ }
+ if (cnv == NULL)
+ fontmappingwarning(buffer, strlen(buffer), 2); /* not loadable */
+ else if (gettracingfontsstate() > 1)
+ fontmappingwarning(buffer, strlen(buffer), 0); /* tracing */
+ } else {
+ fontmappingwarning(buffer, strlen(buffer), 1); /* not found */
+ }
+
+ free(buffer);
+
+ return cnv;
+}
+
+char *saved_mapping_name = NULL;
+void
+checkfortfmfontmapping(void)
+{
+ char* cp = strstr((char*)nameoffile + 1, ":mapping=");
+ if (saved_mapping_name != NULL) {
+ free(saved_mapping_name);
+ saved_mapping_name = NULL;
+ }
+ if (cp != NULL) {
+ *cp = 0;
+ cp += 9;
+ while (*cp && *cp <= ' ')
+ ++cp;
+ if (*cp)
+ saved_mapping_name = xstrdup(cp);
+ }
+}
+
+void*
+loadtfmfontmapping(void)
+{
+ void* rval = NULL;
+ if (saved_mapping_name != NULL) {
+ rval = load_mapping_file(saved_mapping_name,
+ saved_mapping_name + strlen(saved_mapping_name), 1);
+ free(saved_mapping_name);
+ saved_mapping_name = NULL;
+ }
+ return rval;
+}
+
+int
+applytfmfontmapping(void* cnv, int c)
+{
+ UniChar in = c;
+ Byte out[2];
+ UInt32 inUsed, outUsed;
+ /* TECkit_Status status; */
+ /* status = */ TECkit_ConvertBuffer((TECkit_Converter)cnv,
+ (const Byte*)&in, sizeof(in), &inUsed, out, sizeof(out), &outUsed, 1);
+ if (outUsed < 1)
+ return 0;
+ else
+ return out[0];
+}
+
+double
+read_double(const char** s)
+{
+ int neg = 0;
+ double val = 0.0;
+ const char* cp = *s;
+
+ while (*cp == ' '|| *cp == '\t')
+ ++cp;
+ if (*cp == '-') {
+ neg = 1;
+ ++cp;
+ } else if (*cp == '+') {
+ ++cp;
+ }
+
+ while (*cp >= '0' && *cp <= '9') {
+ val = val * 10.0 + *cp - '0';
+ ++cp;
+ }
+ if (*cp == '.') {
+ double dec = 10.0;
+ ++cp;
+ while (*cp >= '0' && *cp <= '9') {
+ val = val + (*cp - '0') / dec;
+ ++cp;
+ dec = dec * 10.0;
+ }
+ }
+ *s = cp;
+
+ return neg ? -val : val;
+}
+
+static hb_tag_t
+read_tag_with_param(const char* cp, int* param)
+{
+ const char* cp2;
+ hb_tag_t tag;
+
+ cp2 = cp;
+ while (*cp2 && (*cp2 != ':') && (*cp2 != ';') && (*cp2 != ',') && (*cp2 != '='))
+ ++cp2;
+
+ tag = hb_tag_from_string(cp, cp2 - cp);
+
+ cp = cp2;
+ if (*cp == '=') {
+ int neg = 0;
+ ++cp;
+ if (*cp == '-') {
+ ++neg;
+ ++cp;
+ }
+ while (*cp >= '0' && *cp <= '9') {
+ *param = *param * 10 + *cp - '0';
+ ++cp;
+ }
+ if (neg)
+ *param = -(*param);
+ }
+
+ return tag;
+}
+
+unsigned int
+read_rgb_a(const char** cp)
+{
+ uint32_t rgbValue = 0;
+ uint32_t alpha = 0;
+ int i;
+ for (i = 0; i < 6; ++i) {
+ if ((**cp >= '0') && (**cp <= '9'))
+ rgbValue = (rgbValue << 4) + **cp - '0';
+ else if ((**cp >= 'A') && (**cp <= 'F'))
+ rgbValue = (rgbValue << 4) + **cp - 'A' + 10;
+ else if ((**cp >= 'a') && (**cp <= 'f'))
+ rgbValue = (rgbValue << 4) + **cp - 'a' + 10;
+ else
+ return 0x000000FF;
+ (*cp)++;
+ }
+ rgbValue <<= 8;
+ for (i = 0; i < 2; ++i) {
+ if ((**cp >= '0') && (**cp <= '9'))
+ alpha = (alpha << 4) + **cp - '0';
+ else if ((**cp >= 'A') && (**cp <= 'F'))
+ alpha = (alpha << 4) + **cp - 'A' + 10;
+ else if ((**cp >= 'a') && (**cp <= 'f'))
+ alpha = (alpha << 4) + **cp - 'a' + 10;
+ else
+ break;
+ (*cp)++;
+ }
+ if (i == 2)
+ rgbValue += alpha;
+ else
+ rgbValue += 0xFF;
+ return rgbValue;
+}
+
+int
+readCommonFeatures(const char* feat, const char* end, float* extend, float* slant, float* embolden, float* letterspace, uint32_t* rgbValue)
+ // returns 1 to go to next_option, -1 for bad_option, 0 to continue
+{
+ const char* sep;
+ if (strncmp(feat, "mapping", 7) == 0) {
+ sep = feat + 7;
+ if (*sep != '=')
+ return -1;
+ loadedfontmapping = load_mapping_file(sep + 1, end, 0);
+ return 1;
+ }
+
+ if (strncmp(feat, "extend", 6) == 0) {
+ sep = feat + 6;
+ if (*sep != '=')
+ return -1;
+ ++sep;
+ *extend = read_double(&sep);
+ return 1;
+ }
+
+ if (strncmp(feat, "slant", 5) == 0) {
+ sep = feat + 5;
+ if (*sep != '=')
+ return -1;
+ ++sep;
+ *slant = read_double(&sep);
+ return 1;
+ }
+
+ if (strncmp(feat, "embolden", 8) == 0) {
+ sep = feat + 8;
+ if (*sep != '=')
+ return -1;
+ ++sep;
+ *embolden = read_double(&sep);
+ return 1;
+ }
+
+ if (strncmp(feat, "letterspace", 11) == 0) {
+ sep = feat + 11;
+ if (*sep != '=')
+ return -1;
+ ++sep;
+ *letterspace = read_double(&sep);
+ return 1;
+ }
+
+ if (strncmp(feat, "color", 5) == 0) {
+ const char* s;
+ sep = feat + 5;
+ if (*sep != '=')
+ return -1;
+ ++sep;
+ s = sep;
+ *rgbValue = read_rgb_a(&sep);
+ if ((sep == s+6) || (sep == s+8))
+ loadedfontflags |= FONT_FLAGS_COLORED;
+ else
+ return -1;
+ return 1;
+ }
+
+ return 0;
+}
+
+static bool
+readFeatureNumber(const char* s, const char* e, hb_tag_t* f, int* v)
+ /* s...e is a "id=setting" string; */
+{
+ *f = 0;
+ *v = 0;
+ if (*s < '0' || *s > '9')
+ return false;
+ while (*s >= '0' && *s <= '9')
+ *f = *f * 10 + *s++ - '0';
+ while ((*s == ' ') || (*s == '\t'))
+ ++s;
+ if (*s++ != '=')
+ /* no setting was specified */
+ return false;
+
+ if (*s < '0' || *s > '9')
+ return false;
+ while (*s >= '0' && *s <= '9')
+ *v = *v * 10 + *s++ - '0';
+ while ((*s == ' ') || (*s == '\t'))
+ ++s;
+ if (s != e)
+ return false;
+ return true;
+}
+
+static void*
+loadOTfont(PlatformFontRef fontRef, XeTeXFont font, Fixed scaled_size, char* cp1)
+{
+ XeTeXLayoutEngine engine = NULL;
+ hb_tag_t script = HB_TAG_NONE;
+ char * language = NULL;
+ hb_feature_t* features = NULL;
+ char** shapers = NULL; /* NULL-terminated array */
+ int nFeatures = 0;
+ int nShapers = 0;
+
+ char* cp2;
+ char* cp3;
+
+ hb_tag_t tag;
+
+ uint32_t rgbValue = 0x000000FF;
+
+ float extend = 1.0;
+ float slant = 0.0;
+ float embolden = 0.0;
+ float letterspace = 0.0;
+
+ int i;
+
+ char reqEngine = getReqEngine();
+
+ if (reqEngine == 'O' || reqEngine == 'G') {
+ shapers = (char**) xrealloc(shapers, (nShapers + 1) * sizeof(char *));
+ if (reqEngine == 'O') {
+ static char ot_const[] = "ot";
+ shapers[nShapers] = ot_const;
+ } else if (reqEngine == 'G') {
+ static char graphite2_const[] = "graphite2";
+ shapers[nShapers] = graphite2_const;
+ }
+ nShapers++;
+ }
+
+ if (reqEngine == 'G') {
+ char* tmpShapers[] = {shapers[0]};
+ /* create a default engine so we can query the font for Graphite features;
+ * because of font caching, it's cheap to discard this and create the real one later */
+ engine = createLayoutEngine(fontRef, font, script, language,
+ features, nFeatures, tmpShapers, rgbValue, extend, slant, embolden);
+
+ if (engine == NULL)
+ return NULL;
+ }
+
+ /* scan the feature string (if any) */
+ if (cp1 != NULL) {
+ while (*cp1) {
+ if ((*cp1 == ':') || (*cp1 == ';') || (*cp1 == ','))
+ ++cp1;
+ while ((*cp1 == ' ') || (*cp1 == '\t')) /* skip leading whitespace */
+ ++cp1;
+ if (*cp1 == 0) /* break if end of string */
+ break;
+
+ cp2 = cp1;
+ while (*cp2 && (*cp2 != ':') && (*cp2 != ';') && (*cp2 != ','))
+ ++cp2;
+
+ if (strncmp(cp1, "script", 6) == 0) {
+ cp3 = cp1 + 6;
+ if (*cp3 != '=')
+ goto bad_option;
+ ++cp3;
+ script = hb_tag_from_string(cp3, cp2 - cp3);
+ goto next_option;
+ }
+
+ if (strncmp(cp1, "language", 8) == 0) {
+ cp3 = cp1 + 8;
+ if (*cp3 != '=')
+ goto bad_option;
+ ++cp3;
+ language = (char*)xmalloc(cp2 - cp3 + 1);
+ language[cp2 - cp3] = '\0';
+ memcpy(language, cp3, cp2 - cp3);
+ goto next_option;
+ }
+
+ if (strncmp(cp1, "shaper", 6) == 0) {
+ cp3 = cp1 + 6;
+ if (*cp3 != '=')
+ goto bad_option;
+ ++cp3;
+ shapers = (char**) xrealloc(shapers, (nShapers + 1) * sizeof(char *));
+ /* some dumb systems have no strndup() */
+ shapers[nShapers] = strdup(cp3);
+ shapers[nShapers][cp2 - cp3] = '\0';
+ nShapers++;
+ goto next_option;
+ }
+
+ i = readCommonFeatures(cp1, cp2, &extend, &slant, &embolden, &letterspace, &rgbValue);
+ if (i == 1)
+ goto next_option;
+ else if (i == -1)
+ goto bad_option;
+
+ if (reqEngine == 'G') {
+ int value = 0;
+ if (readFeatureNumber(cp1, cp2, &tag, &value)
+ || findGraphiteFeature(engine, cp1, cp2, &tag, &value)) {
+ features = (hb_feature_t*) xrealloc(features, (nFeatures + 1) * sizeof(hb_feature_t));
+ features[nFeatures].tag = tag;
+ features[nFeatures].value = value;
+ features[nFeatures].start = 0;
+ features[nFeatures].end = (unsigned int) -1;
+ nFeatures++;
+ goto next_option;
+ }
+ }
+
+ if (*cp1 == '+') {
+ int param = 0;
+ tag = read_tag_with_param(cp1 + 1, &param);
+ features = (hb_feature_t*) xrealloc(features, (nFeatures + 1) * sizeof(hb_feature_t));
+ features[nFeatures].tag = tag;
+ features[nFeatures].start = 0;
+ features[nFeatures].end = (unsigned int) -1;
+ // for backward compatibility with pre-0.9999 where feature
+ // indices started from 0
+ if (param >= 0)
+ param++;
+ features[nFeatures].value = param;
+ nFeatures++;
+ goto next_option;
+ }
+
+ if (*cp1 == '-') {
+ ++cp1;
+ tag = hb_tag_from_string(cp1, cp2 - cp1);
+ features = (hb_feature_t*) xrealloc(features, (nFeatures + 1) * sizeof(hb_feature_t));
+ features[nFeatures].tag = tag;
+ features[nFeatures].start = 0;
+ features[nFeatures].end = (unsigned int) -1;
+ features[nFeatures].value = 0;
+ nFeatures++;
+ goto next_option;
+ }
+
+ if (strncmp(cp1, "vertical", 8) == 0) {
+ cp3 = cp2;
+ if (*cp3 == ';' || *cp3 == ':' || *cp3 == ',')
+ --cp3;
+ while (*cp3 == '\0' || *cp3 == ' ' || *cp3 == '\t')
+ --cp3;
+ if (*cp3)
+ ++cp3;
+ if (cp3 == cp1 + 8) {
+ loadedfontflags |= FONT_FLAGS_VERTICAL;
+ goto next_option;
+ }
+ }
+
+ bad_option:
+ fontfeaturewarning((void*) cp1, cp2 - cp1, 0, 0);
+
+ next_option:
+ cp1 = cp2;
+ }
+ }
+
+ if (shapers != NULL) {
+ shapers = (char**) xrealloc(shapers, (nShapers + 1) * sizeof(char *));
+ shapers[nShapers] = NULL;
+ }
+
+ if (embolden != 0.0)
+ embolden = embolden * Fix2D(scaled_size) / 100.0;
+
+ if (letterspace != 0.0)
+ loadedfontletterspace = (letterspace / 100.0) * scaled_size;
+
+ if ((loadedfontflags & FONT_FLAGS_COLORED) == 0)
+ rgbValue = 0x000000FF;
+
+ if ((loadedfontflags & FONT_FLAGS_VERTICAL) != 0)
+ setFontLayoutDir(font, 1);
+
+ engine = createLayoutEngine(fontRef, font, script, language,
+ features, nFeatures, shapers, rgbValue, extend, slant, embolden);
+
+ if (engine == 0) {
+ // only free these if creation failed, otherwise the engine now owns them
+ free(features);
+ free(shapers);
+ } else {
+ nativefonttypeflag = OTGR_FONT_FLAG;
+ }
+
+ return engine;
+}
+
+static void
+splitFontName(char* name, char** var, char** feat, char** end, int* index)
+{
+ *var = NULL;
+ *feat = NULL;
+ *index = 0;
+ if (*name == '[') {
+ int withinFileName = 1;
+#ifdef WIN32
+ char* start = name + 1;
+#endif
+ ++name;
+ while (*name) {
+ if (withinFileName && *name == ']') {
+ withinFileName = 0;
+ if (*var == NULL)
+ *var = name;
+ } else if (*name == ':') {
+ if (withinFileName && *var == NULL
+#ifdef WIN32
+ && !((name - start == 1) && isalpha(*start))
+#endif
+ ) {
+ *var = name;
+ ++name;
+ while (*name >= '0' && *name <= '9')
+ *index = *index * 10 + *name++ - '0';
+ --name;
+ } else if (!withinFileName && *feat == NULL)
+ *feat = name;
+ }
+ ++name;
+ }
+ *end = name;
+ } else {
+ while (*name) {
+ if (*name == '/' && *var == NULL && *feat == NULL)
+ *var = name;
+ else if (*name == ':' && *feat == NULL)
+ *feat = name;
+ ++name;
+ }
+ *end = name;
+ }
+ if (*feat == NULL)
+ *feat = name;
+ if (*var == NULL)
+ *var = *feat;
+}
+
+void*
+findnativefont(unsigned char* uname, integer scaled_size)
+ /* scaled_size here is in TeX points, or is a negative integer for 'scaled' */
+{
+ void* rval = NULL;
+ char* nameString;
+ char* var;
+ char* feat;
+ char* end;
+ char* name = (char*)uname;
+ char* varString = NULL;
+ char* featString = NULL;
+ PlatformFontRef fontRef;
+ XeTeXFont font = NULL;
+ int index = 0;
+
+ loadedfontmapping = NULL;
+ loadedfontflags = 0;
+ loadedfontletterspace = 0;
+
+ splitFontName(name, &var, &feat, &end, &index);
+ nameString = (char*) xmalloc(var - name + 1);
+ strncpy(nameString, name, var - name);
+ nameString[var - name] = 0;
+
+ if (feat > var) {
+ varString = (char*) xmalloc(feat - var);
+ strncpy(varString, var + 1, feat - var - 1);
+ varString[feat - var - 1] = 0;
+ }
+
+ if (end > feat) {
+ featString = (char*) xmalloc(end - feat);
+ strncpy(featString, feat + 1, end - feat - 1);
+ featString[end - feat - 1] = 0;
+ }
+
+ // check for "[filename]" form, don't search maps in this case
+ if (nameString[0] == '[') {
+ char* path = kpse_find_file(nameString + 1, kpse_opentype_format, 0);
+ if (path == NULL)
+ path = kpse_find_file(nameString + 1, kpse_truetype_format, 0);
+ if (path == NULL)
+ path = kpse_find_file(nameString + 1, kpse_type1_format, 0);
+ if (path != NULL) {
+ if (scaled_size < 0) {
+ font = createFontFromFile(path, index, 655360L);
+ if (font != NULL) {
+ Fixed dsize = D2Fix(getDesignSize(font));
+ if (scaled_size == -1000)
+ scaled_size = dsize;
+ else
+ scaled_size = zxnoverd(dsize, -scaled_size, 1000);
+ deleteFont(font);
+ }
+ }
+ font = createFontFromFile(path, index, scaled_size);
+ if (font != NULL) {
+ loadedfontdesignsize = D2Fix(getDesignSize(font));
+
+ /* This is duplicated in XeTeXFontMgr::findFont! */
+ setReqEngine(0);
+ if (varString) {
+ if (strncmp(varString, "/AAT", 4) == 0)
+ setReqEngine('A');
+ else if ((strncmp(varString, "/OT", 3) == 0) || (strncmp(varString, "/ICU", 4) == 0))
+ setReqEngine('O');
+ else if (strncmp(varString, "/GR", 3) == 0)
+ setReqEngine('G');
+ }
+
+ rval = loadOTfont(0, font, scaled_size, featString);
+ if (rval == NULL)
+ deleteFont(font);
+ if (rval != NULL && gettracingfontsstate() > 0) {
+ begindiagnostic();
+ zprintnl(' ');
+ printcstring("-> ");
+ printcstring(path);
+ zenddiagnostic(0);
+ }
+ }
+ }
+ } else {
+ fontRef = findFontByName(nameString, varString, Fix2D(scaled_size));
+
+ if (fontRef != 0) {
+ /* update nameoffile to the full name of the font, for error messages during font loading */
+ const char* fullName = getFullName(fontRef);
+ namelength = strlen(fullName);
+ if (featString != NULL)
+ namelength += strlen(featString) + 1;
+ if (varString != NULL)
+ namelength += strlen(varString) + 1;
+ free(nameoffile);
+ nameoffile = xmalloc(namelength + 4); /* +2 would be correct: initial space, final NUL */
+ nameoffile[0] = ' ';
+ strcpy((char*)nameoffile + 1, fullName);
+
+ if (scaled_size < 0) {
+ font = createFont(fontRef, scaled_size);
+ if (font != NULL) {
+ Fixed dsize = D2Fix(getDesignSize(font));
+ if (scaled_size == -1000)
+ scaled_size = dsize;
+ else
+ scaled_size = zxnoverd(dsize, -scaled_size, 1000);
+ deleteFont(font);
+ }
+ }
+
+ font = createFont(fontRef, scaled_size);
+ if (font != NULL) {
+#ifdef XETEX_MAC
+ /* decide whether to use AAT or OpenType rendering with this font */
+ if (getReqEngine() == 'A') {
+ rval = loadAATfont(fontRef, scaled_size, featString);
+ if (rval == NULL)
+ deleteFont(font);
+ } else {
+ if (getReqEngine() == 'O' || getReqEngine() == 'G' ||
+ getFontTablePtr(font, kGSUB) != NULL || getFontTablePtr(font, kGPOS) != NULL)
+ rval = loadOTfont(fontRef, font, scaled_size, featString);
+
+ /* loadOTfont failed or the above check was false */
+ if (rval == NULL)
+ rval = loadAATfont(fontRef, scaled_size, featString);
+
+ if (rval == NULL)
+ deleteFont(font);
+ }
+#else
+ rval = loadOTfont(fontRef, font, scaled_size, featString);
+ if (rval == NULL)
+ deleteFont(font);
+#endif
+ }
+
+ /* append the style and feature strings, so that \show\fontID will give a full result */
+ if (varString != NULL && *varString != 0) {
+ strcat((char*)nameoffile + 1, "/");
+ strcat((char*)nameoffile + 1, varString);
+ }
+ if (featString != NULL && *featString != 0) {
+ strcat((char*)nameoffile + 1, ":");
+ strcat((char*)nameoffile + 1, featString);
+ }
+ namelength = strlen((char*)nameoffile + 1);
+ }
+ }
+
+ if (varString != NULL)
+ free(varString);
+
+ if (featString != NULL)
+ free(featString);
+
+ free(nameString);
+
+ return rval;
+}
+
+void
+releasefontengine(void* engine, int type_flag)
+{
+#ifdef XETEX_MAC
+ if (type_flag == AAT_FONT_FLAG) {
+ CFRelease((CFDictionaryRef)engine);
+ } else
+#endif
+ if (type_flag == OTGR_FONT_FLAG) {
+ deleteLayoutEngine((XeTeXLayoutEngine)engine);
+ }
+}
+
+/* params are given as 'integer' in the header file, but are really TeX scaled integers */
+void
+otgetfontmetrics(void* pEngine, scaled* ascent, scaled* descent, scaled* xheight, scaled* capheight, scaled* slant)
+{
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ float a, d;
+
+ getAscentAndDescent(engine, &a, &d);
+ *ascent = D2Fix(a);
+ *descent = D2Fix(d);
+
+ *slant = D2Fix(Fix2D(getSlant(getFont(engine))) * getExtendFactor(engine)
+ + getSlantFactor(engine));
+
+ /* get cap and x height from OS/2 table */
+ getCapAndXHeight(engine, &a, &d);
+ *capheight = D2Fix(a);
+ *xheight = D2Fix(d);
+
+ /* fallback in case the font does not have OS/2 table */
+ if (*xheight == 0) {
+ int glyphID = mapCharToGlyph(engine, 'x');
+ if (glyphID != 0) {
+ getGlyphHeightDepth(engine, glyphID, &a, &d);
+ *xheight = D2Fix(a);
+ } else {
+ *xheight = *ascent / 2; /* arbitrary figure if there's no 'x' in the font */
+ }
+ }
+
+ if (*capheight == 0) {
+ int glyphID = mapCharToGlyph(engine, 'X');
+ if (glyphID != 0) {
+ getGlyphHeightDepth(engine, glyphID, &a, &d);
+ *capheight = D2Fix(a);
+ } else {
+ *capheight = *ascent; /* arbitrary figure if there's no 'X' in the font */
+ }
+ }
+}
+
+integer
+otfontget(integer what, void* pEngine)
+{
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ XeTeXFont fontInst = getFont(engine);
+ switch (what) {
+ case XeTeX_count_glyphs:
+ return countGlyphs(fontInst);
+ break;
+
+ case XeTeX_count_features: /* ie Graphite features */
+ return countGraphiteFeatures(engine);
+ break;
+
+ case XeTeX_OT_count_scripts:
+ return countScripts(fontInst);
+ break;
+ }
+ return 0;
+}
+
+
+integer
+otfontget1(integer what, void* pEngine, integer param)
+{
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ XeTeXFont fontInst = getFont(engine);
+ switch (what) {
+ case XeTeX_OT_count_languages:
+ return countLanguages(fontInst, param);
+ break;
+
+ case XeTeX_OT_script_code:
+ return getIndScript(fontInst, param);
+ break;
+
+ /* for graphite fonts...*/
+ case XeTeX_feature_code:
+ return getGraphiteFeatureCode(engine, param);
+ break;
+ case XeTeX_is_exclusive_feature:
+ return 1;
+ break;
+ case XeTeX_count_selectors:
+ return countGraphiteFeatureSettings(engine, param);
+ break;
+ }
+ return 0;
+}
+
+
+integer
+otfontget2(integer what, void* pEngine, integer param1, integer param2)
+{
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ XeTeXFont fontInst = getFont(engine);
+ switch (what) {
+ case XeTeX_OT_language_code:
+ return getIndLanguage(fontInst, param1, param2);
+ break;
+
+ case XeTeX_OT_count_features:
+ return countFeatures(fontInst, param1, param2);
+ break;
+
+ /* for graphite fonts */
+ case XeTeX_selector_code:
+ return getGraphiteFeatureSettingCode(engine, param1, param2);
+ break;
+ case XeTeX_is_default_selector:
+ return getGraphiteFeatureDefaultSetting(engine, param1) == param2;
+ break;
+ }
+
+ return 0;
+}
+
+
+integer
+otfontget3(integer what, void* pEngine, integer param1, integer param2, integer param3)
+{
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ XeTeXFont fontInst = getFont(engine);
+ switch (what) {
+ case XeTeX_OT_feature_code:
+ return getIndFeature(fontInst, param1, param2, param3);
+ break;
+ }
+
+ return 0;
+}
+
+void
+grprintfontname(integer what, void* pEngine, integer param1, integer param2)
+{
+ char* name = NULL;
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ switch (what) {
+ case XeTeX_feature_name:
+ name = getGraphiteFeatureLabel(engine, param1);
+ break;
+ case XeTeX_selector_name:
+ name = getGraphiteFeatureSettingLabel(engine, param1, param2);
+ break;
+ }
+
+ if (name != NULL) {
+ printcstring(name);
+ gr_label_destroy(name);
+ }
+}
+
+integer
+grfontgetnamed(integer what, void* pEngine)
+{
+ long rval = -1;
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ switch (what) {
+ case XeTeX_find_feature_by_name:
+ rval = findGraphiteFeatureNamed(engine, (const char*)nameoffile + 1, namelength);
+ break;
+ }
+ return rval;
+}
+
+integer
+grfontgetnamed1(integer what, void* pEngine, integer param)
+{
+ long rval = -1;
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)pEngine;
+ switch (what) {
+ case XeTeX_find_selector_by_name:
+ rval = findGraphiteFeatureSettingNamed(engine, param, (const char*)nameoffile + 1, namelength);
+ break;
+ }
+ return rval;
+}
+
+#define XDV_FLAG_VERTICAL 0x0100
+#define XDV_FLAG_COLORED 0x0200
+#define XDV_FLAG_EXTEND 0x1000
+#define XDV_FLAG_SLANT 0x2000
+#define XDV_FLAG_EMBOLDEN 0x4000
+
+#ifdef XETEX_MAC
+static UInt32
+cgColorToRGBA32(CGColorRef color)
+{
+ const CGFloat *components = CGColorGetComponents(color);
+
+ UInt32 rval = (UInt8)(components[0] * 255.0 + 0.5);
+ rval <<= 8;
+ rval += (UInt8)(components[1] * 255.0 + 0.5);
+ rval <<= 8;
+ rval += (UInt8)(components[2] * 255.0 + 0.5);
+ rval <<= 8;
+ rval += (UInt8)(components[3] * 255.0 + 0.5);
+ return rval;
+}
+#endif
+
+static int xdvBufSize = 0;
+
+int
+makeXDVGlyphArrayData(void* pNode)
+{
+ unsigned char* cp;
+ uint16_t* glyphIDs;
+ memoryword* p = (memoryword*) pNode;
+ void* glyph_info;
+ FixedPoint* locations;
+ Fixed width;
+ uint16_t glyphCount = native_glyph_count(p);
+
+ int i = glyphCount * native_glyph_info_size + 8; /* to guarantee enough space in the buffer */
+ if (i > xdvBufSize) {
+ if (xdvbuffer != NULL)
+ free(xdvbuffer);
+ xdvBufSize = ((i / 1024) + 1) * 1024;
+ xdvbuffer = (char*) xmalloc(xdvBufSize);
+ }
+
+ glyph_info = native_glyph_info_ptr(p);
+ locations = (FixedPoint*)glyph_info;
+ glyphIDs = (uint16_t*)(locations + glyphCount);
+
+ cp = (unsigned char*)xdvbuffer;
+
+ width = node_width(p);
+ *cp++ = (width >> 24) & 0xff;
+ *cp++ = (width >> 16) & 0xff;
+ *cp++ = (width >> 8) & 0xff;
+ *cp++ = width & 0xff;
+
+ *cp++ = (glyphCount >> 8) & 0xff;
+ *cp++ = glyphCount & 0xff;
+
+ for (i = 0; i < glyphCount; ++i) {
+ Fixed x = locations[i].x;
+ Fixed y = locations[i].y;
+ *cp++ = (x >> 24) & 0xff;
+ *cp++ = (x >> 16) & 0xff;
+ *cp++ = (x >> 8) & 0xff;
+ *cp++ = x & 0xff;
+ *cp++ = (y >> 24) & 0xff;
+ *cp++ = (y >> 16) & 0xff;
+ *cp++ = (y >> 8) & 0xff;
+ *cp++ = y & 0xff;
+ }
+
+ for (i = 0; i < glyphCount; ++i) {
+ uint16_t g = glyphIDs[i];
+ *cp++ = (g >> 8) & 0xff;
+ *cp++ = g & 0xff;
+ }
+
+ return ((char*)cp - xdvbuffer);
+}
+
+int
+makefontdef(integer f)
+{
+ uint16_t flags = 0;
+ uint32_t rgba;
+ Fixed size;
+ char* filename;
+ uint32_t index;
+ uint8_t filenameLen;
+ int fontDefLength;
+ char* cp;
+ /* PlatformFontRef fontRef = 0; */
+ float extend = 1.0;
+ float slant = 0.0;
+ float embolden = 0.0;
+
+#ifdef XETEX_MAC
+ CFDictionaryRef attributes = NULL;
+
+ if (fontarea[f] == AAT_FONT_FLAG) {
+ CTFontRef font;
+ CGColorRef color;
+ CGAffineTransform t;
+ CFNumberRef emboldenNumber;
+ CGFloat fSize;
+
+ attributes = (CFDictionaryRef) fontlayoutengine[f];
+ font = CFDictionaryGetValue(attributes, kCTFontAttributeName);
+
+ filename = getFileNameFromCTFont(font, &index);
+ assert(filename);
+
+ if (CFDictionaryGetValue(attributes, kCTVerticalFormsAttributeName))
+ flags |= XDV_FLAG_VERTICAL;
+
+ color = (CGColorRef) CFDictionaryGetValue(attributes, kCTForegroundColorAttributeName);
+ if (color)
+ rgba = cgColorToRGBA32(color);
+
+ t = CTFontGetMatrix(font);
+ extend = t.a;
+ slant = t.c;
+
+ emboldenNumber = CFDictionaryGetValue(attributes, kXeTeXEmboldenAttributeName);
+ if (emboldenNumber)
+ CFNumberGetValue(emboldenNumber, kCFNumberFloatType, &embolden);
+
+ fSize = CTFontGetSize(font);
+ size = D2Fix(fSize);
+ } else
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine;
+
+ engine = (XeTeXLayoutEngine)fontlayoutengine[f];
+ /* fontRef = */ getFontRef(engine);
+ filename = getFontFilename(engine, &index);
+ assert(filename);
+
+ rgba = getRgbValue(engine);
+ if ((fontflags[f] & FONT_FLAGS_VERTICAL) != 0)
+ flags |= XDV_FLAG_VERTICAL;
+
+ extend = getExtendFactor(engine);
+ slant = getSlantFactor(engine);
+ embolden = getEmboldenFactor(engine);
+
+ size = D2Fix(getPointSize(engine));
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `make_font_def'\n");
+ exit(3);
+ }
+
+ filenameLen = strlen(filename);
+
+ /* parameters after internal font ID:
+ // size[4]
+ // flags[2]
+ // l[1] n[l]
+ // if flags & COLORED:
+ // c[4]
+ */
+
+ fontDefLength
+ = 4 /* size */
+ + 2 /* flags */
+ + 1 /* name length */
+ + filenameLen
+ + 4 /* face index */;
+
+ if ((fontflags[f] & FONT_FLAGS_COLORED) != 0) {
+ fontDefLength += 4; /* 32-bit RGBA value */
+ flags |= XDV_FLAG_COLORED;
+ }
+
+ if (extend != 1.0) {
+ fontDefLength += 4;
+ flags |= XDV_FLAG_EXTEND;
+ }
+ if (slant != 0.0) {
+ fontDefLength += 4;
+ flags |= XDV_FLAG_SLANT;
+ }
+ if (embolden != 0.0) {
+ fontDefLength += 4;
+ flags |= XDV_FLAG_EMBOLDEN;
+ }
+
+ if (fontDefLength > xdvBufSize) {
+ if (xdvbuffer != NULL)
+ free(xdvbuffer);
+ xdvBufSize = ((fontDefLength / 1024) + 1) * 1024;
+ xdvbuffer = (char*) xmalloc(xdvBufSize);
+ }
+ cp = xdvbuffer;
+
+ *(Fixed*)cp = SWAP32(size);
+ cp += 4;
+
+ *(uint16_t*)cp = SWAP16(flags);
+ cp += 2;
+
+ *(uint8_t*)cp = filenameLen;
+ cp += 1;
+ memcpy(cp, filename, filenameLen);
+ cp += filenameLen;
+
+ *(uint32_t*)cp = SWAP32(index);
+ cp += 4;
+
+ if ((fontflags[f] & FONT_FLAGS_COLORED) != 0) {
+ *(uint32_t*)cp = SWAP32(rgba);
+ cp += 4;
+ }
+
+ if (flags & XDV_FLAG_EXTEND) {
+ Fixed f = D2Fix(extend);
+ *(uint32_t*)(cp) = SWAP32(f);
+ cp += 4;
+ }
+ if (flags & XDV_FLAG_SLANT) {
+ Fixed f = D2Fix(slant);
+ *(uint32_t*)(cp) = SWAP32(f);
+ cp += 4;
+ }
+ if (flags & XDV_FLAG_EMBOLDEN) {
+ Fixed f = D2Fix(embolden);
+ *(uint32_t*)(cp) = SWAP32(f);
+ cp += 4;
+ }
+
+ free((char*) filename);
+
+ return fontDefLength;
+}
+
+int
+applymapping(void* pCnv, uint16_t* txtPtr, int txtLen)
+{
+ TECkit_Converter cnv = (TECkit_Converter)pCnv;
+ UInt32 inUsed, outUsed;
+ TECkit_Status status;
+ static UInt32 outLength = 0;
+
+ /* allocate outBuffer if not big enough */
+ if (outLength < txtLen * sizeof(UniChar) + 32) {
+ if (mappedtext != 0)
+ free(mappedtext);
+ outLength = txtLen * sizeof(UniChar) + 32;
+ mappedtext = xmalloc(outLength);
+ }
+
+ /* try the mapping */
+retry:
+ status = TECkit_ConvertBuffer(cnv,
+ (Byte*)txtPtr, txtLen * sizeof(UniChar), &inUsed,
+ (Byte*)mappedtext, outLength, &outUsed, true);
+
+ switch (status) {
+ case kStatus_NoError:
+ txtPtr = (UniChar*)mappedtext;
+ return outUsed / sizeof(UniChar);
+
+ case kStatus_OutputBufferFull:
+ outLength += (txtLen * sizeof(UniChar)) + 32;
+ free(mappedtext);
+ mappedtext = xmalloc(outLength);
+ goto retry;
+
+ default:
+ return 0;
+ }
+}
+
+static void
+snap_zone(scaled* value, scaled snap_value, scaled fuzz)
+{
+ scaled difference = *value - snap_value;
+ if (difference <= fuzz && difference >= -fuzz)
+ *value = snap_value;
+}
+
+void
+getnativecharheightdepth(integer font, integer ch, scaled* height, scaled* depth)
+{
+#define QUAD(f) fontinfo[6+parambase[f]].cint
+#define X_HEIGHT(f) fontinfo[5+parambase[f]].cint
+#define CAP_HEIGHT(f) fontinfo[8+parambase[f]].cint
+
+ float ht = 0.0;
+ float dp = 0.0;
+ Fixed fuzz;
+
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG) {
+ CFDictionaryRef attributes = (CFDictionaryRef)(fontlayoutengine[font]);
+ int gid = MapCharToGlyph_AAT(attributes, ch);
+ GetGlyphHeightDepth_AAT(attributes, gid, &ht, &dp);
+ } else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[font];
+ int gid = mapCharToGlyph(engine, ch);
+ getGlyphHeightDepth(engine, gid, &ht, &dp);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `get_native_char_height_depth`\n");
+ exit(3);
+ }
+
+ *height = D2Fix(ht);
+ *depth = D2Fix(dp);
+
+ /* snap to "known" zones for baseline, x-height, cap-height if within 4% of em-size */
+ fuzz = QUAD(font) / 25;
+ snap_zone(depth, 0, fuzz);
+ snap_zone(height, 0, fuzz);
+ snap_zone(height, X_HEIGHT(font), fuzz);
+ snap_zone(height, CAP_HEIGHT(font), fuzz);
+}
+
+scaled
+getnativecharht(integer f, integer c)
+{
+ scaled h, d;
+ getnativecharheightdepth(f, c, &h, &d);
+ return h;
+}
+
+scaled
+getnativechardp(integer f, integer c)
+{
+ scaled h, d;
+ getnativecharheightdepth(f, c, &h, &d);
+ return d;
+}
+
+void
+getnativecharsidebearings(integer font, integer ch, scaled* lsb, scaled* rsb)
+{
+ float l, r;
+
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG) {
+ CFDictionaryRef attributes = (CFDictionaryRef)(fontlayoutengine[font]);
+ int gid = MapCharToGlyph_AAT(attributes, ch);
+ GetGlyphSidebearings_AAT(attributes, gid, &l, &r);
+ } else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[font];
+ int gid = mapCharToGlyph(engine, ch);
+ getGlyphSidebearings(engine, gid, &l, &r);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `get_native_char_side_bearings'\n");
+ exit(3);
+ }
+
+ *lsb = D2Fix(l);
+ *rsb = D2Fix(r);
+}
+
+scaled
+getglyphbounds(integer font, integer edge, integer gid)
+{
+/* edge codes 1,2,3,4 => L T R B */
+ float a, b;
+
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG) {
+ CFDictionaryRef attributes = (CFDictionaryRef)(fontlayoutengine[font]);
+ if (edge & 1)
+ GetGlyphSidebearings_AAT(attributes, gid, &a, &b);
+ else
+ GetGlyphHeightDepth_AAT(attributes, gid, &a, &b);
+ } else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[font];
+ if (edge & 1)
+ getGlyphSidebearings(engine, gid, &a, &b);
+ else
+ getGlyphHeightDepth(engine, gid, &a, &b);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `get_glyph_bounds'\n");
+ exit(3);
+ }
+ return D2Fix((edge <= 2) ? a : b);
+}
+
+scaled
+getnativecharic(integer f, integer c)
+{
+ scaled lsb, rsb;
+ getnativecharsidebearings(f, c, &lsb, &rsb);
+ if (rsb < 0)
+ return fontletterspace[f] - rsb;
+ else
+ return fontletterspace[f];
+}
+
+scaled
+getnativecharwd(integer f, integer c)
+{
+ scaled wd = 0;
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG) {
+ CFDictionaryRef attributes = (CFDictionaryRef)(fontlayoutengine[f]);
+ int gid = MapCharToGlyph_AAT(attributes, c);
+ wd = D2Fix(GetGlyphWidth_AAT(attributes, gid));
+ } else
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[f];
+ int gid = mapCharToGlyph(engine, c);
+ wd = D2Fix(getGlyphWidthFromEngine(engine, gid));
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `get_native_char_wd'\n");
+ exit(3);
+ }
+ return wd;
+}
+
+uint16_t
+get_native_glyph(void* pNode, unsigned index)
+{
+ memoryword* node = (memoryword*)pNode;
+ FixedPoint* locations = (FixedPoint*)native_glyph_info_ptr(node);
+ uint16_t* glyphIDs = (uint16_t*)(locations + native_glyph_count(node));
+ if (index >= native_glyph_count(node))
+ return 0;
+ else
+ return glyphIDs[index];
+}
+
+void
+store_justified_native_glyphs(void* pNode)
+{
+ memoryword* node = (memoryword*)pNode;
+ unsigned f = native_font(node);
+
+#ifdef XETEX_MAC /* separate Mac-only codepath for AAT fonts */
+ if (fontarea[f] == AAT_FONT_FLAG) {
+ (void)DoAATLayout(node, 1);
+ return;
+ }
+#endif
+
+ /* save desired width */
+ int savedWidth = node_width(node);
+
+ measure_native_node(node, 0);
+
+ if (node_width(node) != savedWidth) {
+ /* see how much adjustment is needed overall */
+ double justAmount = Fix2D(savedWidth - node_width(node));
+
+ /* apply justification to spaces (or if there are none, distribute it to all glyphs as a last resort) */
+ FixedPoint* locations = (FixedPoint*)native_glyph_info_ptr(node);
+ uint16_t* glyphIDs = (uint16_t*)(locations + native_glyph_count(node));
+ int glyphCount = native_glyph_count(node);
+ int spaceCount = 0, i;
+
+ int spaceGlyph = mapchartoglyph(f, ' ');
+ for (i = 0; i < glyphCount; ++i)
+ if (glyphIDs[i] == spaceGlyph)
+ spaceCount++;
+
+ if (spaceCount > 0) {
+ double adjustment = 0;
+ int spaceIndex = 0;
+ for (i = 0; i < glyphCount; ++i) {
+ locations[i].x = D2Fix(Fix2D(locations[i].x) + adjustment);
+ if (glyphIDs[i] == spaceGlyph) {
+ spaceIndex++;
+ adjustment = justAmount * spaceIndex / spaceCount;
+ }
+ }
+ } else {
+ for (i = 1; i < glyphCount; ++i)
+ locations[i].x = D2Fix(Fix2D(locations[i].x) + justAmount * i / (glyphCount - 1));
+ }
+
+ node_width(node) = savedWidth;
+ }
+}
+
+void
+measure_native_node(void* pNode, int use_glyph_metrics)
+{
+ memoryword* node = (memoryword*)pNode;
+ int txtLen = native_length(node);
+ uint16_t* txtPtr = (uint16_t*)(node + native_node_size);
+
+ unsigned f = native_font(node);
+
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG) {
+ /* we're using this font in AAT mode, so fontlayoutengine[f] is actually a CFDictionaryRef */
+ DoAATLayout(node, 0);
+ } else
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ /* using this font in OT Layout mode, so fontlayoutengine[f] is actually a XeTeXLayoutEngine */
+
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)(fontlayoutengine[f]);
+
+ FixedPoint* locations = NULL;
+ uint16_t* glyphIDs;
+ Fixed* glyphAdvances = NULL;
+ int totalGlyphCount = 0;
+
+ /* need to find direction runs within the text, and call layoutChars separately for each */
+
+ UBiDiDirection dir;
+ void* glyph_info = 0;
+ static FloatPoint* positions = 0;
+ static float* advances = 0;
+ static uint32_t* glyphs = 0;
+
+ UBiDi* pBiDi = ubidi_open();
+
+ UErrorCode errorCode = U_ZERO_ERROR;
+ ubidi_setPara(pBiDi, (const UChar*) txtPtr, txtLen, getDefaultDirection(engine), NULL, &errorCode);
+
+ dir = ubidi_getDirection(pBiDi);
+ if (dir == UBIDI_MIXED) {
+ /* we actually do the layout twice here, once to count glyphs and then again to get them;
+ which is inefficient, but i figure that MIXED is a relatively rare occurrence, so i can't be
+ bothered to deal with the memory reallocation headache of doing it differently
+ */
+ int nRuns = ubidi_countRuns(pBiDi, &errorCode);
+ double width = 0;
+ int i, runIndex;
+ int32_t logicalStart, length;
+ for (runIndex = 0; runIndex < nRuns; ++runIndex) {
+ dir = ubidi_getVisualRun(pBiDi, runIndex, &logicalStart, &length);
+ totalGlyphCount += layoutChars(engine, txtPtr, logicalStart, length, txtLen, (dir == UBIDI_RTL));
+ }
+
+ if (totalGlyphCount > 0) {
+ double x, y;
+ glyph_info = xcalloc(totalGlyphCount, native_glyph_info_size);
+ locations = (FixedPoint*)glyph_info;
+ glyphIDs = (uint16_t*)(locations + totalGlyphCount);
+ glyphAdvances = (Fixed*) xcalloc(totalGlyphCount, sizeof(Fixed));
+ totalGlyphCount = 0;
+
+ x = y = 0.0;
+ for (runIndex = 0; runIndex < nRuns; ++runIndex) {
+ int nGlyphs;
+ dir = ubidi_getVisualRun(pBiDi, runIndex, &logicalStart, &length);
+ nGlyphs = layoutChars(engine, txtPtr, logicalStart, length, txtLen,
+ (dir == UBIDI_RTL));
+
+ glyphs = (uint32_t*) xcalloc(nGlyphs, sizeof(uint32_t));
+ positions = (FloatPoint*) xcalloc(nGlyphs + 1, sizeof(FloatPoint));
+ advances = (float*) xcalloc(nGlyphs, sizeof(float));
+
+ getGlyphs(engine, glyphs);
+ getGlyphAdvances(engine, advances);
+ getGlyphPositions(engine, positions);
+
+ for (i = 0; i < nGlyphs; ++i) {
+ glyphIDs[totalGlyphCount] = glyphs[i];
+ locations[totalGlyphCount].x = D2Fix(positions[i].x + x);
+ locations[totalGlyphCount].y = D2Fix(positions[i].y + y);
+ glyphAdvances[totalGlyphCount] = D2Fix(advances[i]);
+ ++totalGlyphCount;
+ }
+ x += positions[nGlyphs].x;
+ y += positions[nGlyphs].y;
+
+ free(glyphs);
+ free(positions);
+ free(advances);
+ }
+ width = x;
+ }
+
+ node_width(node) = D2Fix(width);
+ native_glyph_count(node) = totalGlyphCount;
+ native_glyph_info_ptr(node) = glyph_info;
+ } else {
+ double width = 0;
+ totalGlyphCount = layoutChars(engine, txtPtr, 0, txtLen, txtLen, (dir == UBIDI_RTL));
+
+ glyphs = (uint32_t*) xcalloc(totalGlyphCount, sizeof(uint32_t));
+ positions = (FloatPoint*) xcalloc(totalGlyphCount + 1, sizeof(FloatPoint));
+ advances = (float*) xcalloc(totalGlyphCount, sizeof(float));
+
+ getGlyphs(engine, glyphs);
+ getGlyphAdvances(engine, advances);
+ getGlyphPositions(engine, positions);
+
+ if (totalGlyphCount > 0) {
+ int i;
+ glyph_info = xcalloc(totalGlyphCount, native_glyph_info_size);
+ locations = (FixedPoint*)glyph_info;
+ glyphIDs = (uint16_t*)(locations + totalGlyphCount);
+ glyphAdvances = (Fixed*) xcalloc(totalGlyphCount, sizeof(Fixed));
+ for (i = 0; i < totalGlyphCount; ++i) {
+ glyphIDs[i] = glyphs[i];
+ glyphAdvances[i] = D2Fix(advances[i]);
+ locations[i].x = D2Fix(positions[i].x);
+ locations[i].y = D2Fix(positions[i].y);
+ }
+ width = positions[totalGlyphCount].x;
+ }
+
+ node_width(node) = D2Fix(width);
+ native_glyph_count(node) = totalGlyphCount;
+ native_glyph_info_ptr(node) = glyph_info;
+
+ free(glyphs);
+ free(positions);
+ free(advances);
+ }
+
+ ubidi_close(pBiDi);
+
+
+ if (fontletterspace[f] != 0) {
+ Fixed lsDelta = 0;
+ Fixed lsUnit = fontletterspace[f];
+ int i;
+ for (i = 0; i < totalGlyphCount; ++i) {
+ if (glyphAdvances[i] == 0 && lsDelta != 0)
+ lsDelta -= lsUnit;
+ locations[i].x += lsDelta;
+ lsDelta += lsUnit;
+ }
+ if (lsDelta != 0) {
+ lsDelta -= lsUnit;
+ node_width(node) += lsDelta;
+ }
+ }
+ free(glyphAdvances);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `measure_native_node'\n");
+ exit(3);
+ }
+
+ if (use_glyph_metrics == 0 || native_glyph_count(node) == 0) {
+ /* for efficiency, height and depth are the font's ascent/descent,
+ not true values based on the actual content of the word,
+ unless use_glyph_metrics is non-zero */
+ node_height(node) = heightbase[f];
+ node_depth(node) = depthbase[f];
+ } else {
+ /* this iterates over the glyph data whether it comes from AAT or OT layout */
+ FixedPoint* locations = (FixedPoint*)native_glyph_info_ptr(node);
+ uint16_t* glyphIDs = (uint16_t*)(locations + native_glyph_count(node));
+ float yMin = 65536.0;
+ float yMax = -65536.0;
+ int i;
+ for (i = 0; i < native_glyph_count(node); ++i) {
+ float ht, dp;
+ float y = Fix2D(-locations[i].y); /* NB negative is upwards in locations[].y! */
+
+ GlyphBBox bbox;
+ if (getCachedGlyphBBox(f, glyphIDs[i], &bbox) == 0) {
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG)
+ GetGlyphBBox_AAT((CFDictionaryRef)(fontlayoutengine[f]), glyphIDs[i], &bbox);
+ else
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG)
+ getGlyphBounds((XeTeXLayoutEngine)(fontlayoutengine[f]), glyphIDs[i], &bbox);
+
+ cacheGlyphBBox(f, glyphIDs[i], &bbox);
+ }
+
+ ht = bbox.yMax;
+ dp = -bbox.yMin;
+
+ if (y + ht > yMax)
+ yMax = y + ht;
+ if (y - dp < yMin)
+ yMin = y - dp;
+ }
+ node_height(node) = D2Fix(yMax);
+ node_depth(node) = -D2Fix(yMin);
+ }
+}
+
+Fixed
+get_native_italic_correction(void* pNode)
+{
+ memoryword* node = (memoryword*) pNode;
+ unsigned f = native_font(node);
+ unsigned n = native_glyph_count(node);
+ if (n > 0) {
+ FixedPoint* locations = (FixedPoint*)native_glyph_info_ptr(node);
+ uint16_t* glyphIDs = (uint16_t*)(locations + n);
+
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG)
+ return D2Fix(GetGlyphItalCorr_AAT((CFDictionaryRef)(fontlayoutengine[f]), glyphIDs[n-1]))
+ + fontletterspace[f];
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG)
+ return D2Fix(getGlyphItalCorr((XeTeXLayoutEngine)(fontlayoutengine[f]), glyphIDs[n-1]))
+ + fontletterspace[f];
+ }
+
+ return 0;
+}
+
+
+Fixed
+get_native_glyph_italic_correction(void* pNode)
+{
+ memoryword* node = (memoryword*) pNode;
+ uint16_t gid = native_glyph(node);
+ unsigned f = native_font(node);
+
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG)
+ return D2Fix(GetGlyphItalCorr_AAT((CFDictionaryRef)(fontlayoutengine[f]), gid));
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG)
+ return D2Fix(getGlyphItalCorr((XeTeXLayoutEngine)(fontlayoutengine[f]), gid));
+
+ return 0; /* can't actually happen */
+}
+
+void
+measure_native_glyph(void* pNode, int use_glyph_metrics)
+{
+ memoryword* node = (memoryword*) pNode;
+ uint16_t gid = native_glyph(node);
+ unsigned f = native_font(node);
+
+ float ht = 0.0;
+ float dp = 0.0;
+
+#ifdef XETEX_MAC
+ if (fontarea[f] == AAT_FONT_FLAG) {
+ CFDictionaryRef attributes = (CFDictionaryRef)(fontlayoutengine[f]);
+ node_width(node) = D2Fix(GetGlyphWidth_AAT(attributes, gid));
+ if (use_glyph_metrics)
+ GetGlyphHeightDepth_AAT(attributes, gid, &ht, &dp);
+ } else
+#endif
+ if (fontarea[f] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[f];
+ XeTeXFont fontInst = getFont(engine);
+ node_width(node) = D2Fix(getGlyphWidth(fontInst, gid));
+ if (use_glyph_metrics)
+ getGlyphHeightDepth(engine, gid, &ht, &dp);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `measure_native_glyph'\n");
+ exit(3);
+ }
+
+ if (use_glyph_metrics) {
+ node_height(node) = D2Fix(ht);
+ node_depth(node) = D2Fix(dp);
+ } else {
+ node_height(node) = heightbase[f];
+ node_depth(node) = depthbase[f];
+ }
+}
+
+integer
+mapchartoglyph(integer font, integer ch)
+{
+ if (ch > 0x10ffff || ((ch >= 0xd800) && (ch <= 0xdfff)))
+ return 0;
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG)
+ return MapCharToGlyph_AAT((CFDictionaryRef)(fontlayoutengine[font]), ch);
+ else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG)
+ return mapCharToGlyph((XeTeXLayoutEngine)(fontlayoutengine[font]), ch);
+ else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `map_char_to_glyph'\n");
+ exit(3);
+ }
+}
+
+integer
+mapglyphtoindex(integer font)
+ /* glyph name is at nameoffile+1 */
+{
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG)
+ return MapGlyphToIndex_AAT((CFDictionaryRef)(fontlayoutengine[font]), (const char*)nameoffile + 1);
+ else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG)
+ return mapGlyphToIndex((XeTeXLayoutEngine)(fontlayoutengine[font]), (const char*)nameoffile + 1);
+ else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `map_glyph_to_index'\n");
+ exit(3);
+ }
+}
+
+integer
+getfontcharrange(integer font, int first)
+{
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG)
+ return GetFontCharRange_AAT((CFDictionaryRef)(fontlayoutengine[font]), first);
+ else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG)
+ return getFontCharRange((XeTeXLayoutEngine)(fontlayoutengine[font]), first);
+ else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `get_font_char_range'\n");
+ exit(3);
+ }
+}
+
+Fixed D2Fix(double d)
+{
+ Fixed rval = (int)(d * 65536.0 + 0.5);
+ return rval;
+}
+
+double Fix2D(Fixed f)
+{
+ double rval = f / 65536.0;
+ return rval;
+}
+
+/* these are here, not XeTeX_mac.c, because we need stubs on other platforms */
+void
+aatgetfontmetrics(CFDictionaryRef attributes, integer* ascent, integer* descent, integer* xheight, integer* capheight, integer* slant)
+{
+#ifdef XETEX_MAC
+ CTFontRef font = fontFromAttributes(attributes);
+
+ *ascent = D2Fix(CTFontGetAscent(font));
+ *descent = D2Fix(CTFontGetDescent(font));
+ *xheight = D2Fix(CTFontGetXHeight(font));
+ *capheight = D2Fix(CTFontGetCapHeight(font));
+ *slant = D2Fix(tan(-CTFontGetSlantAngle(font) * M_PI / 180.0));
+#endif
+}
+
+int
+aatfontget(int what, CFDictionaryRef attributes)
+{
+ int rval = -1;
+
+#ifdef XETEX_MAC
+ CTFontRef font = fontFromAttributes(attributes);
+ CFArrayRef list;
+
+ switch (what) {
+ case XeTeX_count_glyphs:
+ rval = CTFontGetGlyphCount(font);
+ break;
+
+ case XeTeX_count_features:
+ list = CTFontCopyFeatures(font);
+ if (list) {
+ rval = CFArrayGetCount(list);
+ CFRelease(list);
+ }
+ break;
+ }
+#endif
+ return rval;
+}
+
+int
+aatfontget1(int what, CFDictionaryRef attributes, int param)
+{
+ int rval = -1;
+
+#ifdef XETEX_MAC
+ CTFontRef font = fontFromAttributes(attributes);
+
+ switch (what) {
+ case XeTeX_feature_code:
+ {
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ if (CFArrayGetCount(features) > param) {
+ CFDictionaryRef feature = CFArrayGetValueAtIndex(features, param);
+ CFNumberRef identifier = CFDictionaryGetValue(feature, kCTFontFeatureTypeIdentifierKey);
+ if (identifier)
+ CFNumberGetValue(identifier, kCFNumberIntType, &rval);
+ }
+ CFRelease(features);
+ }
+ break;
+ }
+
+ case XeTeX_is_exclusive_feature:
+ {
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFBooleanRef value;
+ CFDictionaryRef feature = findDictionaryInArrayWithIdentifier(features, kCTFontFeatureTypeIdentifierKey, param);
+ Boolean found = CFDictionaryGetValueIfPresent(feature, kCTFontFeatureTypeExclusiveKey, (const void **)&value);
+ if (found)
+ rval = CFBooleanGetValue(value);
+ CFRelease(features);
+ }
+ break;
+ }
+
+ case XeTeX_count_selectors:
+ {
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFDictionaryRef feature = findDictionaryInArrayWithIdentifier(features, kCTFontFeatureTypeIdentifierKey, param);
+ if (feature) {
+ CFArrayRef selectors = CFDictionaryGetValue(feature, kCTFontFeatureTypeSelectorsKey);
+ if (selectors)
+ rval = CFArrayGetCount(selectors);
+ }
+ CFRelease(features);
+ }
+ break;
+ }
+ }
+#endif
+
+ return rval;
+}
+
+int
+aatfontget2(int what, CFDictionaryRef attributes, int param1, int param2)
+{
+ int rval = -1;
+
+#ifdef XETEX_MAC
+ CTFontRef font = fontFromAttributes(attributes);
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFDictionaryRef feature = findDictionaryInArrayWithIdentifier(features, kCTFontFeatureTypeIdentifierKey, param1);
+ if (feature) {
+ CFArrayRef selectors = CFDictionaryGetValue(feature, kCTFontFeatureTypeSelectorsKey);
+ if (selectors) {
+ CFDictionaryRef selector;
+ switch (what) {
+ case XeTeX_selector_code:
+ if (CFArrayGetCount(selectors) > param2) {
+ CFNumberRef identifier;
+ selector = CFArrayGetValueAtIndex(selectors, param2);
+ identifier = CFDictionaryGetValue(selector, kCTFontFeatureSelectorIdentifierKey);
+ if (identifier)
+ CFNumberGetValue(identifier, kCFNumberIntType, &rval);
+ }
+ break;
+ case XeTeX_is_default_selector:
+ selector = findDictionaryInArrayWithIdentifier(selectors, kCTFontFeatureSelectorIdentifierKey, param2);
+ if (selector) {
+ CFBooleanRef isDefault;
+ Boolean found = CFDictionaryGetValueIfPresent(selector, kCTFontFeatureSelectorDefaultKey, (const void **)&isDefault);
+ if (found)
+ rval = CFBooleanGetValue(isDefault);
+ }
+ break;
+ }
+ }
+ }
+ CFRelease(features);
+ }
+#endif
+
+ return rval;
+}
+
+int
+aatfontgetnamed(int what, CFDictionaryRef attributes)
+{
+ int rval = -1;
+
+#ifdef XETEX_MAC
+ if (what == XeTeX_find_feature_by_name)
+ {
+ CTFontRef font = fontFromAttributes(attributes);
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFDictionaryRef feature = findDictionaryInArray(features, kCTFontFeatureTypeNameKey,
+ (const char*)nameoffile + 1, namelength);
+ if (feature) {
+ CFNumberRef identifier = CFDictionaryGetValue(feature, kCTFontFeatureTypeIdentifierKey);
+ CFNumberGetValue(identifier, kCFNumberIntType, &rval);
+ }
+ CFRelease(features);
+ }
+ }
+#endif
+
+ return rval;
+}
+
+int
+aatfontgetnamed1(int what, CFDictionaryRef attributes, int param)
+{
+ int rval = -1;
+
+#ifdef XETEX_MAC
+ CTFontRef font = fontFromAttributes(attributes);
+
+ if (what == XeTeX_find_selector_by_name) {
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFDictionaryRef feature = findDictionaryInArrayWithIdentifier(features, kCTFontFeatureTypeIdentifierKey, param);
+ if (feature) {
+ CFNumberRef selector = findSelectorByName(feature, (const char*)nameoffile + 1, namelength);
+ if (selector)
+ CFNumberGetValue(selector, kCFNumberIntType, &rval);
+ }
+ CFRelease(features);
+ }
+ }
+#endif
+
+ return rval;
+}
+
+void
+aatprintfontname(int what, CFDictionaryRef attributes, int param1, int param2)
+{
+#ifdef XETEX_MAC
+ CFStringRef name = NULL;
+ if (what == XeTeX_feature_name || what == XeTeX_selector_name) {
+ CTFontRef font = fontFromAttributes(attributes);
+ CFArrayRef features = CTFontCopyFeatures(font);
+ if (features) {
+ CFDictionaryRef feature = findDictionaryInArrayWithIdentifier(features,
+ kCTFontFeatureTypeIdentifierKey,
+ param1);
+ if (feature) {
+ if (what == XeTeX_feature_name)
+ name = CFDictionaryGetValue(feature, kCTFontFeatureTypeNameKey);
+ else {
+ CFArrayRef selectors = CFDictionaryGetValue(feature, kCTFontFeatureTypeSelectorsKey);
+ CFDictionaryRef selector = findDictionaryInArrayWithIdentifier(selectors,
+ kCTFontFeatureSelectorIdentifierKey,
+ param2);
+ if (selector)
+ name = CFDictionaryGetValue(selector, kCTFontFeatureSelectorNameKey);
+ }
+ }
+ CFRelease(features);
+ }
+ }
+
+ if (name) {
+ CFIndex len = CFStringGetLength(name);
+ UniChar* buf = xcalloc(len, sizeof(UniChar));
+ CFStringGetCharacters(name, CFRangeMake(0, len), buf);
+ printchars(buf, len);
+ free(buf);
+ }
+#endif
+}
+
+void
+printglyphname(integer font, integer gid)
+{
+ const char* s;
+ int len = 0;
+#ifdef XETEX_MAC
+ if (fontarea[font] == AAT_FONT_FLAG) {
+ s = GetGlyphNameFromCTFont(fontFromInteger(font), gid, &len);
+ } else
+#endif
+ if (fontarea[font] == OTGR_FONT_FLAG) {
+ XeTeXLayoutEngine engine = (XeTeXLayoutEngine)fontlayoutengine[font];
+ s = getGlyphName(getFont(engine), gid, &len);
+ } else {
+ fprintf(stderr, "\n! Internal error: bad native font flag in `print_glyph_name'\n");
+ exit(3);
+ }
+ while (len-- > 0)
+ printchar(*s++);
+}
+
+int
+u_open_in(unicodefile* f, integer filefmt, const_string fopen_mode, integer mode, integer encodingData)
+{
+ boolean rval;
+ *f = (unicodefile) xmalloc(sizeof(UFILE));
+ (*f)->encodingMode = 0;
+ (*f)->conversionData = 0;
+ (*f)->savedChar = -1;
+ (*f)->skipNextLF = 0;
+ rval = open_input (&((*f)->f), filefmt, fopen_mode);
+ if (rval) {
+ int B1, B2;
+ if (mode == AUTO) {
+ /* sniff encoding form */
+ B1 = GETC((*f)->f);
+ B2 = GETC((*f)->f);
+ if (B1 == 0xfe && B2 == 0xff)
+ mode = UTF16BE;
+ else if (B2 == 0xfe && B1 == 0xff)
+ mode = UTF16LE;
+ else if (B1 == 0 && B2 != 0) {
+ mode = UTF16BE;
+ rewind((*f)->f);
+ } else if (B2 == 0 && B1 != 0) {
+ mode = UTF16LE;
+ rewind((*f)->f);
+ } else if (B1 == 0xef && B2 == 0xbb) {
+ int B3 = GETC((*f)->f);
+ if (B3 == 0xbf)
+ mode = UTF8;
+ }
+ if (mode == AUTO) {
+ rewind((*f)->f);
+ mode = UTF8;
+ }
+ }
+
+ setinputfileencoding(*f, mode, encodingData);
+ }
+ return rval;
+}
+
+void
+u_close_inout(unicodefile* f)
+{
+ if (f != 0) {
+ fclose((*f)->f);
+ if (((*f)->encodingMode == ICUMAPPING) && ((*f)->conversionData != NULL))
+ ucnv_close((*f)->conversionData);
+ free(*f);
+ }
+}
+
+#if defined(WIN32)
+static int
+Isspace(char c)
+{
+ return (c == ' ' || c == '\t');
+}
+#endif
+
+int
+open_dvi_output(FILE** fptr)
+{
+ if (nopdfoutput) {
+ return open_output(fptr, FOPEN_WBIN_MODE);
+ } else {
+ const char *p = (const char*)nameoffile+1;
+ char *cmd, *q, *bindir = NULL;
+ int len = strlen(p);
+ while (*p)
+ if (*p++ == '\"')
+ ++len;
+ len += strlen(outputdriver);
+#ifndef WIN32
+ if (!kpse_absolute_p(outputdriver, true))
+ bindir = kpse_var_value("SELFAUTOLOC");
+ if (bindir)
+ len += strlen(bindir) + 1;
+#endif
+ if (output_directory)
+ len += strlen(output_directory);
+ len += 10; /* space for -o flag, quotes, NUL */
+ for (p = (const char*)nameoffile+1; *p; p++)
+ if (*p == '\"')
+ ++len; /* allow extra space to escape quotes in filename */
+ cmd = xmalloc(len);
+#ifdef WIN32
+ strcpy(cmd, outputdriver);
+#else
+ if (bindir) {
+ strcpy(cmd, bindir);
+ strcat(cmd, "/");
+ strcat(cmd, outputdriver);
+ } else {
+ strcpy(cmd, outputdriver);
+ }
+#endif
+ strcat(cmd, " -o \"");
+ if (output_directory) {
+ len = strlen(output_directory);
+ if (IS_DIR_SEP(output_directory[len-1]))
+ output_directory[len-1] = '\0';
+ strcat(cmd, output_directory);
+ strcat(cmd, "/");
+ }
+ q = cmd + strlen(cmd);
+ for (p = (const char*)nameoffile+1; *p; p++) {
+ if (*p == '\"')
+ *q++ = '\\';
+ *q++ = *p;
+ }
+ *q++ = '\"';
+ *q = '\0';
+ if (papersize != 0) {
+ char* cmd2 = concat3(cmd, " -p ", papersize);
+ free(cmd);
+ cmd = cmd2;
+ }
+ if (output_directory) {
+ char *fullname = concat3(output_directory, "/", (const char*)nameoffile+1);
+ free(nameoffile);
+ namelength = strlen(fullname);
+ nameoffile = (unsigned char*) xmalloc(namelength + 2);
+ strcpy((char*)nameoffile+1, fullname);
+ free(fullname);
+ }
+#if defined(WIN32)
+ {
+ wchar_t *tmp1w;
+ char *p, *pp, *fullcmd, *prgnam;
+ bindir = kpse_var_value("SELFAUTOLOC");
+ for(pp = bindir; *pp; pp++) {
+ if(*pp == '/') *pp = '\\';
+ }
+ pp = cmd;
+ while(Isspace(*pp))
+ pp++;
+ prgnam = xmalloc(strlen(cmd));
+ p = prgnam;
+ while(!Isspace(*pp)) {
+ *p++ = *pp++;
+ }
+ *p = '\0';
+ fullcmd = concatn("\"\"", bindir, "\\", prgnam, "\"", pp, "\"", NULL);
+ tmp1w = get_wstring_from_mbstring(CP_UTF8, (const char *)fullcmd, tmp1w=NULL);
+ *fptr = _wpopen(tmp1w, L"wb");
+ free(bindir);
+ free(prgnam);
+ free(fullcmd);
+ free(tmp1w);
+ }
+#else
+ *fptr = popen(cmd, "w");
+#endif
+ free(cmd);
+ return (*fptr != 0);
+ }
+}
+
+int
+dviclose(FILE* fptr)
+{
+ if (nopdfoutput) {
+ if (fclose(fptr) != 0)
+ return errno;
+ } else {
+ return pclose(fptr);
+ }
+ return 0;
+}
+
+int
+get_uni_c(UFILE* f)
+{
+ int rval;
+ int c;
+#ifdef WIN32
+ HANDLE hStdin;
+ DWORD ret;
+ wint_t wc[1];
+#endif
+
+ if (f->savedChar != -1) {
+ rval = f->savedChar;
+ f->savedChar = -1;
+ return rval;
+ }
+
+ switch (f->encodingMode) {
+ case UTF8:
+ c = rval = GETC(f->f);
+ if (rval != EOF) {
+ uint16_t extraBytes = bytesFromUTF8[rval];
+ switch (extraBytes) { /* note: code falls through cases! */
+ case 3: c = GETC(f->f);
+ if (c < 0x80 || c >= 0xc0) goto bad_utf8;
+ rval <<= 6; rval += c;
+ case 2: c = GETC(f->f);
+ if (c < 0x80 || c >= 0xc0) goto bad_utf8;
+ rval <<= 6; rval += c;
+ case 1: c = GETC(f->f);
+ if (c < 0x80 || c >= 0xc0) goto bad_utf8;
+ rval <<= 6; rval += c;
+ case 0:
+ break;
+
+ bad_utf8:
+ if (c != EOF)
+ UNGETC(c, f->f);
+ case 5:
+ case 4:
+ badutf8warning();
+ return 0xfffd; /* return without adjusting by offsetsFromUTF8 */
+ };
+ rval -= offsetsFromUTF8[extraBytes];
+ if (rval < 0 || rval > 0x10ffff) {
+ badutf8warning();
+ return 0xfffd;
+ }
+ }
+ break;
+
+ case UTF16BE:
+ rval = GETC(f->f);
+ if (rval != EOF) {
+ rval <<= 8;
+ rval += GETC(f->f);
+ if (rval >= 0xd800 && rval <= 0xdbff) {
+ int lo = GETC(f->f);
+ lo <<= 8;
+ lo += GETC(f->f);
+ if (lo >= 0xdc00 && lo <= 0xdfff)
+ rval = 0x10000 + (rval - 0xd800) * 0x400 + (lo - 0xdc00);
+ else {
+ rval = 0xfffd;
+ f->savedChar = lo;
+ }
+ } else if (rval >= 0xdc00 && rval <= 0xdfff)
+ rval = 0xfffd;
+ }
+ break;
+
+ case UTF16LE:
+ rval = GETC(f->f);
+ if (rval != EOF) {
+ rval += (GETC(f->f) << 8);
+ if (rval >= 0xd800 && rval <= 0xdbff) {
+ int lo = GETC(f->f);
+ lo += (GETC(f->f) << 8);
+ if (lo >= 0xdc00 && lo <= 0xdfff)
+ rval = 0x10000 + (rval - 0xd800) * 0x400 + (lo - 0xdc00);
+ else {
+ rval = 0xfffd;
+ f->savedChar = lo;
+ }
+ } else if (rval >= 0xdc00 && rval <= 0xdfff)
+ rval = 0xfffd;
+ }
+ break;
+
+#ifdef WIN32
+ case WIN32CONSOLE:
+ hStdin = GetStdHandle(STD_INPUT_HANDLE);
+ if (ReadConsoleW(hStdin, wc, 1, &ret, NULL) == 0) {
+ rval = EOF;
+ break;
+ }
+ rval = wc[0];
+ if (rval >= 0xd800 && rval <= 0xdbff) {
+ int lo;
+ if (ReadConsoleW(hStdin, wc, 1, &ret, NULL) == 0) {
+ rval = EOF;
+ break;
+ }
+ lo = wc[0];
+ if (lo >= 0xdc00 && lo <= 0xdfff)
+ rval = 0x10000 + (rval - 0xd800) * 0x400 + (lo - 0xdc00);
+ else {
+ rval = 0xfffd;
+ f->savedChar = lo;
+ }
+ } else if (rval >= 0xdc00 && rval <= 0xdfff)
+ rval = 0xfffd;
+ break;
+#endif
+
+ case RAW:
+ rval = GETC(f->f);
+ break;
+
+ default:
+ /* this can't happen */
+ fprintf(stderr, "! Internal error---file input mode=%d.\n", f->encodingMode);
+ uexit(3);
+ }
+
+ return rval;
+}
+
+void
+makeutf16name(void)
+{
+ unsigned char* s = nameoffile + 1;
+ uint32_t rval;
+ uint16_t* t;
+ static int name16len = 0;
+ if (name16len <= namelength) {
+ if (nameoffile16 != 0)
+ free(nameoffile16);
+ name16len = namelength + 10;
+ nameoffile16 = (uint16_t*) xcalloc(name16len, sizeof(uint16_t));
+ }
+ t = nameoffile16;
+ while (s <= nameoffile + namelength) {
+ uint16_t extraBytes;
+ rval = *(s++);
+ extraBytes = bytesFromUTF8[rval];
+ switch (extraBytes) { /* note: code falls through cases! */
+ case 5: rval <<= 6; if (*s) rval += *(s++);
+ case 4: rval <<= 6; if (*s) rval += *(s++);
+ case 3: rval <<= 6; if (*s) rval += *(s++);
+ case 2: rval <<= 6; if (*s) rval += *(s++);
+ case 1: rval <<= 6; if (*s) rval += *(s++);
+ case 0: ;
+ };
+ rval -= offsetsFromUTF8[extraBytes];
+ if (rval > 0xffff) {
+ rval -= 0x10000;
+ *(t++) = 0xd800 + rval / 0x0400;
+ *(t++) = 0xdc00 + rval % 0x0400;
+ } else {
+ *(t++) = rval;
+ }
+ }
+ namelength16 = t - nameoffile16;
+}
+
+
+integer get_native_word_cp(void* pNode, int side)
+{
+ memoryword* node = (memoryword*)pNode;
+ FixedPoint* locations = (FixedPoint*)native_glyph_info_ptr(node);
+ uint16_t* glyphIDs = (uint16_t*)(locations + native_glyph_count(node));
+ uint16_t glyphCount = native_glyph_count(node);
+ integer f = native_font(node);
+ uint16_t actual_glyph;
+
+ if (glyphCount == 0)
+ return 0;
+
+ switch (side) {
+ case LEFT_SIDE:
+ actual_glyph = *glyphIDs;
+ break;
+ case RIGHT_SIDE:
+ actual_glyph = glyphIDs[glyphCount - 1];
+ break;
+ default:
+ assert(0); // we should not reach this point
+ }
+ return get_cp_code(f, actual_glyph, side);
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeX_ext.h b/Build/source/texk/web2c/xetexdir/XeTeX_ext.h
new file mode 100644
index 00000000000..29c06ab6891
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeX_ext.h
@@ -0,0 +1,319 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009, 2011 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+ Copyright (c) 2012-2015 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEXEXT_H
+#define __XETEXEXT_H
+
+#include <unicode/utypes.h>
+
+#ifndef XETEX_UNICODE_FILE_DEFINED
+typedef struct UFILE* unicodefile;
+#endif
+
+#define AAT_FONT_FLAG 0xFFFFU
+#define OTGR_FONT_FLAG 0xFFFEU
+
+#define FONT_FLAGS_COLORED 0x01
+#define FONT_FLAGS_VERTICAL 0x02
+
+/* some typedefs that XeTeX uses - on Mac OS, we get these from Apple headers,
+ but otherwise we'll need these substitute definitions */
+
+#ifdef XETEX_MAC
+#include <CoreFoundation/CoreFoundation.h>
+#include <ApplicationServices/ApplicationServices.h>
+#else
+typedef int32_t Fixed;
+typedef struct {
+ Fixed x;
+ Fixed y;
+} FixedPoint;
+#endif
+
+typedef uint32_t OTTag;
+typedef uint16_t GlyphID;
+typedef struct {
+ float x;
+ float y;
+} FloatPoint;
+
+
+/* these are also in xetex.web and must correspond! */
+
+#define pdfbox_crop 1
+#define pdfbox_media 2
+#define pdfbox_bleed 3
+#define pdfbox_trim 4
+#define pdfbox_art 5
+
+
+#define XeTeX_count_glyphs 1
+
+#define XeTeX_count_features 8
+#define XeTeX_feature_code 9
+#define XeTeX_find_feature_by_name 10
+#define XeTeX_is_exclusive_feature 11
+#define XeTeX_count_selectors 12
+#define XeTeX_selector_code 13
+#define XeTeX_find_selector_by_name 14
+#define XeTeX_is_default_selector 15
+
+#define XeTeX_OT_count_scripts 16
+#define XeTeX_OT_count_languages 17
+#define XeTeX_OT_count_features 18
+#define XeTeX_OT_script_code 19
+#define XeTeX_OT_language_code 20
+#define XeTeX_OT_feature_code 21
+
+#define XeTeX_map_char_to_glyph_code 22
+
+#define XeTeX_feature_name 8
+#define XeTeX_selector_name 9
+
+
+/* definitions used to access info in a native_word_node; must correspond with defines in xetex.web */
+#define width_offset 1
+#define depth_offset 2
+#define height_offset 3
+#define native_info_offset 4
+#define native_glyph_info_offset 5
+
+#define node_width(node) node[width_offset].cint
+#define node_depth(node) node[depth_offset].cint
+#define node_height(node) node[height_offset].cint
+#define native_length(node) node[native_info_offset].qqqq.b2
+#define native_font(node) node[native_info_offset].qqqq.b1
+#define native_glyph_count(node) node[native_info_offset].qqqq.b3
+#define native_glyph_info_ptr(node) node[native_glyph_info_offset].ptr
+#define native_glyph_info_size 10 /* info for each glyph is location (FixedPoint) + glyph ID (uint16_t) */
+
+#define native_glyph(p) native_length(p) /* glyph ID field in a glyph_node */
+
+/* OT-related constants we need */
+#define kGSUB HB_TAG('G','S','U','B')
+#define kGPOS HB_TAG('G','P','O','S')
+
+typedef struct
+{
+ float xMin;
+ float yMin;
+ float xMax;
+ float yMax;
+} GlyphBBox;
+
+
+/* For Unicode encoding form interpretation... */
+extern const uint32_t offsetsFromUTF8[6];
+extern const uint8_t bytesFromUTF8[256];
+extern const uint8_t firstByteMark[7];
+
+extern const int halfShift;
+extern const uint32_t halfBase;
+extern const uint32_t halfMask;
+extern const uint32_t kSurrogateHighStart;
+extern const uint32_t kSurrogateHighEnd;
+extern const uint32_t kSurrogateLowStart;
+extern const uint32_t kSurrogateLowEnd;
+extern const uint32_t byteMask;
+extern const uint32_t byteMark;
+
+extern const char *papersize;
+extern const char *outputdriver;
+
+/* gFreeTypeLibrary is defined in XeTeXFontInst_FT2.cpp,
+ * also used in XeTeXFontMgr_FC.cpp and XeTeX_ext.c. */
+#include <ft2build.h>
+#include FT_FREETYPE_H
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern FT_Library gFreeTypeLibrary;
+#ifdef __cplusplus
+}
+#endif
+
+#include <stdio.h> /* for FILE */
+
+#ifdef WIN32
+#undef fputs
+#undef putc
+#define fputs win32_fputs
+#define putc win32_putc
+#endif
+
+#include "trans.h"
+
+#ifdef HAVE_STDBOOL_H
+# include <stdbool.h>
+#else
+/* boolean is an enum type from kpathsea/types.h loaded in
+ kpathsea/kpathsea.h, use it as fallback */
+#ifndef __cplusplus
+# define bool boolean
+#endif
+#endif
+
+#include "XeTeXLayoutInterface.h"
+
+#ifdef XETEX_MAC
+extern const CFStringRef kXeTeXEmboldenAttributeName;
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+ void initversionstring(char **versions);
+
+ void setinputfileencoding(unicodefile f, integer mode, integer encodingData);
+ void linebreakstart(int f, integer localeStrNum, uint16_t* text, integer textLength);
+ int linebreaknext(void);
+ int getencodingmodeandinfo(integer* info);
+ void printutf8str(const unsigned char* str, int len);
+ void printchars(const unsigned short* str, int len);
+ void* findnativefont(unsigned char* name, integer scaled_size);
+ void releasefontengine(void* engine, int type_flag);
+ int readCommonFeatures(const char* feat, const char* end, float* extend, float* slant, float* embolden, float* letterspace, uint32_t* rgbValue);
+
+ /* the metrics params here are really TeX 'scaled' values, but that typedef isn't available every place this is included */
+ void otgetfontmetrics(void* engine, integer* ascent, integer* descent, integer* xheight, integer* capheight, integer* slant);
+ void getnativecharheightdepth(integer font, integer ch, integer* height, integer* depth);
+ void getnativecharsidebearings(integer font, integer ch, integer* lsb, integer* rsb);
+
+ /* single-purpose metrics accessors */
+ integer getnativecharwd(integer font, integer ch);
+ integer getnativecharht(integer font, integer ch);
+ integer getnativechardp(integer font, integer ch);
+ integer getnativecharic(integer font, integer ch);
+
+ integer getglyphbounds(integer font, integer edge, integer gid);
+
+ integer otfontget(integer what, void* engine);
+ integer otfontget1(integer what, void* engine, integer param);
+ integer otfontget2(integer what, void* engine, integer param1, integer param2);
+ integer otfontget3(integer what, void* engine, integer param1, integer param2, integer param3);
+ int makeXDVGlyphArrayData(void* p);
+ int makefontdef(integer f);
+ int applymapping(void* cnv, uint16_t* txtPtr, int txtLen);
+ void store_justified_native_glyphs(void* node);
+ void measure_native_node(void* node, int use_glyph_metrics);
+ Fixed get_native_italic_correction(void* node);
+ Fixed get_native_glyph_italic_correction(void* node);
+ integer get_native_word_cp(void* node, int side);
+ void measure_native_glyph(void* node, int use_glyph_metrics);
+ integer mapchartoglyph(integer font, integer ch);
+ integer mapglyphtoindex(integer font);
+ integer getfontcharrange(integer font, int first);
+ void printglyphname(integer font, integer gid);
+ uint16_t get_native_glyph(void* pNode, unsigned index);
+
+ void grprintfontname(integer what, void* pEngine, integer param1, integer param2);
+ integer grfontgetnamed(integer what, void* pEngine);
+ integer grfontgetnamed1(integer what, void* pEngine, integer param);
+
+ double read_double(const char** s);
+ unsigned int read_rgb_a(const char** cp);
+
+ int countpdffilepages(void);
+ int find_pic_file(char** path, realrect* bounds, int pdfBoxType, int page);
+ int u_open_in(unicodefile* f, integer filefmt, const char* fopen_mode, integer mode, integer encodingData);
+ void u_close_inout(unicodefile* f);
+ int open_dvi_output(FILE** fptr);
+ int dviclose(FILE* fptr);
+ int get_uni_c(UFILE* f);
+ int input_line(UFILE* f);
+ void makeutf16name(void);
+
+ void terminatefontmanager(void);
+ int maketexstring(const char* s);
+
+ void checkfortfmfontmapping(void);
+ void* loadtfmfontmapping(void);
+ int applytfmfontmapping(void* mapping, int c);
+
+#ifndef XETEX_MAC
+typedef void* CFDictionaryRef; /* dummy declaration just so the stubs can compile */
+#endif
+
+ int aatfontget(int what, CFDictionaryRef attrs);
+ int aatfontget1(int what, CFDictionaryRef attrs, int param);
+ int aatfontget2(int what, CFDictionaryRef attrs, int param1, int param2);
+ int aatfontgetnamed(int what, CFDictionaryRef attrs);
+ int aatfontgetnamed1(int what, CFDictionaryRef attrs, int param);
+ void aatprintfontname(int what, CFDictionaryRef attrs, int param1, int param2);
+ /* the metrics params here are really TeX 'scaled' (or MacOS 'Fixed') values, but that typedef isn't available every place this is included */
+ void aatgetfontmetrics(CFDictionaryRef attrs, integer* ascent, integer* descent, integer* xheight, integer* capheight, integer* slant);
+
+ void set_cp_code(int fontNum, unsigned int code, int side, int value);
+ int get_cp_code(int fontNum, unsigned int code, int side);
+
+#ifdef XETEX_MAC
+
+/* functions in XeTeX_mac.c */
+ void* loadAATfont(CTFontDescriptorRef descriptor, integer scaled_size, const char* cp1);
+ void DoAATLayout(void* node, int justify);
+ void GetGlyphBBox_AAT(CFDictionaryRef fontAttrs, uint16_t gid, GlyphBBox* bbox);
+ double GetGlyphWidth_AAT(CFDictionaryRef fontAttrs, uint16_t gid);
+ void GetGlyphHeightDepth_AAT(CFDictionaryRef fontAttrs, uint16_t gid, float* ht, float* dp);
+ void GetGlyphSidebearings_AAT(CFDictionaryRef fontAttrs, uint16_t gid, float* lsb, float* rsb);
+ double GetGlyphItalCorr_AAT(CFDictionaryRef fontAttrs, uint16_t gid);
+ int MapCharToGlyph_AAT(CFDictionaryRef fontAttrs, UInt32 ch);
+ int MapGlyphToIndex_AAT(CFDictionaryRef attributes, const char* glyphName);
+ char* GetGlyphNameFromCTFont(CTFontRef ctFontRef, uint16_t gid, int* len);
+ CFDictionaryRef findDictionaryInArray(CFArrayRef array, const void* nameKey, const char* name, int nameLength);
+ CFDictionaryRef findDictionaryInArrayWithIdentifier(CFArrayRef array, const void* identifierKey, int identifier);
+ CFNumberRef findSelectorByName(CFDictionaryRef feature, const char* name, int nameLength);
+ char* getNameFromCTFont(CTFontRef ctFontRef, CFStringRef nameKey);
+ char* getFileNameFromCTFont(CTFontRef ctFontRef, uint32_t* index);
+ int GetFontCharRange_AAT(CFDictionaryRef fontAttrs, int reqFirst);
+ CTFontRef fontFromAttributes(CFDictionaryRef fontAttrs);
+ CTFontRef fontFromInteger(integer font);
+#endif
+#ifdef __cplusplus
+};
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+ double Fix2D(Fixed f);
+ Fixed D2Fix(double d);
+#ifdef __cplusplus
+};
+#endif
+
+// copied from xetex.web
+#define LEFT_SIDE 0
+#define RIGHT_SIDE 1
+
+#endif /* __XETEX_EXT_H */
diff --git a/Build/source/texk/web2c/xetexdir/XeTeX_mac.c b/Build/source/texk/web2c/xetexdir/XeTeX_mac.c
new file mode 100644
index 00000000000..bf9fdeb98a4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeX_mac.c
@@ -0,0 +1,747 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+ Copyright (c) 2012, 2013 by Jiang Jiang
+ Copyright (c) 2012-2015 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/* XeTeX_mac.c
+ * additional plain C extensions for XeTeX - MacOS-specific routines
+ */
+
+#define EXTERN extern
+#include "xetexd.h"
+
+#include <ApplicationServices/ApplicationServices.h>
+
+#include <teckit/TECkit_Engine.h>
+#include "XeTeX_ext.h"
+#include "XeTeXLayoutInterface.h"
+
+static inline double
+TeXtoPSPoints(double pts)
+{
+ return pts * 72.0 / 72.27;
+}
+
+static inline double
+PStoTeXPoints(double pts)
+{
+ return pts * 72.27 / 72.0;
+}
+
+static inline Fixed
+FixedPStoTeXPoints(double pts)
+{
+ return D2Fix(PStoTeXPoints(pts));
+}
+
+CTFontRef
+fontFromAttributes(CFDictionaryRef attributes)
+{
+ return CFDictionaryGetValue(attributes, kCTFontAttributeName);
+}
+
+CTFontRef
+fontFromInteger(integer font)
+{
+ CFDictionaryRef attributes = (CFDictionaryRef) fontlayoutengine[font];
+ return fontFromAttributes(attributes);
+}
+
+void
+DoAATLayout(void* p, int justify)
+{
+ CFArrayRef glyphRuns;
+ CFIndex i, j, runCount;
+ CFIndex totalGlyphCount = 0;
+ UInt16* glyphIDs;
+ Fixed* glyphAdvances;
+ void* glyph_info = NULL;
+ FixedPoint* locations;
+ CGFloat width;
+
+ long txtLen;
+ const UniChar* txtPtr;
+
+ CFDictionaryRef attributes;
+ CFStringRef string;
+ CFAttributedStringRef attrString;
+ CTTypesetterRef typesetter;
+ CTLineRef line;
+
+ memoryword* node = (memoryword*)p;
+
+ unsigned f = native_font(node);
+ if (fontarea[f] != AAT_FONT_FLAG) {
+ fprintf(stderr, "internal error: DoAATLayout called for non-AAT font\n");
+ exit(1);
+ }
+
+ txtLen = native_length(node);
+ txtPtr = (UniChar*)(node + native_node_size);
+
+ attributes = fontlayoutengine[native_font(node)];
+ string = CFStringCreateWithCharactersNoCopy(NULL, txtPtr, txtLen, kCFAllocatorNull);
+ attrString = CFAttributedStringCreate(NULL, string, attributes);
+ CFRelease(string);
+
+ typesetter = CTTypesetterCreateWithAttributedString(attrString);
+ CFRelease(attrString);
+ line = CTTypesetterCreateLine(typesetter, CFRangeMake(0, txtLen));
+ if (justify) {
+ CGFloat lineWidth = TeXtoPSPoints(Fix2D(node_width(node)));
+ CTLineRef justifiedLine = CTLineCreateJustifiedLine(line, TeXtoPSPoints(Fix2D(fract1)), lineWidth);
+ // TODO(jjgod): how to handle the case when justification failed? for
+ // now we just fallback to use the original line.
+ if (justifiedLine) {
+ CFRelease(line);
+ line = justifiedLine;
+ }
+ }
+
+ glyphRuns = CTLineGetGlyphRuns(line);
+ runCount = CFArrayGetCount(glyphRuns);
+ totalGlyphCount = CTLineGetGlyphCount(line);
+
+ if (totalGlyphCount > 0) {
+ glyph_info = xmalloc(totalGlyphCount * native_glyph_info_size);
+ locations = (FixedPoint*)glyph_info;
+ glyphIDs = (UInt16*)(locations + totalGlyphCount);
+ glyphAdvances = xmalloc(totalGlyphCount * sizeof(Fixed));
+ totalGlyphCount = 0;
+
+ width = 0;
+ for (i = 0; i < runCount; i++) {
+ CTRunRef run = CFArrayGetValueAtIndex(glyphRuns, i);
+ CFIndex count = CTRunGetGlyphCount(run);
+ CFDictionaryRef runAttributes = CTRunGetAttributes(run);
+ CFBooleanRef vertical = CFDictionaryGetValue(runAttributes, kCTVerticalFormsAttributeName);
+ // TODO(jjgod): Avoid unnecessary allocation with CTRunGetFoosPtr().
+ CGGlyph* glyphs = (CGGlyph*) xmalloc(count * sizeof(CGGlyph));
+ CGPoint* positions = (CGPoint*) xmalloc(count * sizeof(CGPoint));
+ CGSize* advances = (CGSize*) xmalloc(count * sizeof(CGSize));
+ CGFloat runWidth = CTRunGetTypographicBounds(run, CFRangeMake(0, 0), NULL, NULL, NULL);
+ CTRunGetGlyphs(run, CFRangeMake(0, 0), glyphs);
+ CTRunGetPositions(run, CFRangeMake(0, 0), positions);
+ CTRunGetAdvances(run, CFRangeMake(0, 0), advances);
+ for (j = 0; j < count; j++) {
+ // XXX Core Text has that font cascading thing that will do
+ // font substitution for missing glyphs, which we do not want
+ // but I can not find a way to disable it yet, so if the font
+ // of the resulting run is not the same font we asked for, use
+ // the glyph at index 0 (usually .notdef) instead or we will be
+ // showing garbage or even invalid glyphs
+ if (!CFEqual(fontFromAttributes(attributes), fontFromAttributes(runAttributes)))
+ glyphIDs[totalGlyphCount] = 0;
+ else
+ glyphIDs[totalGlyphCount] = glyphs[j];
+
+ // Swap X and Y when doing vertical layout
+ if (vertical == kCFBooleanTrue) {
+ locations[totalGlyphCount].x = -FixedPStoTeXPoints(positions[j].y);
+ locations[totalGlyphCount].y = FixedPStoTeXPoints(positions[j].x);
+ } else {
+ locations[totalGlyphCount].x = FixedPStoTeXPoints(positions[j].x);
+ locations[totalGlyphCount].y = -FixedPStoTeXPoints(positions[j].y);
+ }
+ glyphAdvances[totalGlyphCount] = advances[j].width;
+ totalGlyphCount++;
+ }
+ width += FixedPStoTeXPoints(runWidth);
+ free(glyphs);
+ free(positions);
+ free(advances);
+ }
+ }
+
+ native_glyph_count(node) = totalGlyphCount;
+ native_glyph_info_ptr(node) = glyph_info;
+
+ if (!justify) {
+ node_width(node) = width;
+
+ if (totalGlyphCount > 0) {
+ /* this is essentially a copy from similar code in XeTeX_ext.c, easier
+ * to be done here */
+ if (fontletterspace[f] != 0) {
+ Fixed lsDelta = 0;
+ Fixed lsUnit = fontletterspace[f];
+ int i;
+ for (i = 0; i < totalGlyphCount; ++i) {
+ if (glyphAdvances[i] == 0 && lsDelta != 0)
+ lsDelta -= lsUnit;
+ locations[i].x += lsDelta;
+ lsDelta += lsUnit;
+ }
+ if (lsDelta != 0) {
+ lsDelta -= lsUnit;
+ node_width(node) += lsDelta;
+ }
+ }
+ }
+ }
+
+ free(glyphAdvances);
+ CFRelease(line);
+ CFRelease(typesetter);
+}
+
+static void
+getGlyphBBoxFromCTFont(CTFontRef font, UInt16 gid, GlyphBBox* bbox)
+{
+ CGRect rect;
+
+ bbox->xMin = 65536.0;
+ bbox->yMin = 65536.0;
+ bbox->xMax = -65536.0;
+ bbox->yMax = -65536.0;
+
+ rect = CTFontGetBoundingRectsForGlyphs(font,
+ 0, /* Use default orientation for now, handle vertical later */
+ (const CGGlyph *) &gid, NULL, 1);
+
+ if (CGRectIsNull(rect))
+ bbox->xMin = bbox->yMin = bbox->xMax = bbox->yMax = 0;
+ else {
+ bbox->yMin = PStoTeXPoints(rect.origin.y);
+ bbox->yMax = PStoTeXPoints(rect.origin.y + rect.size.height);
+ bbox->xMin = PStoTeXPoints(rect.origin.x);
+ bbox->xMax = PStoTeXPoints(rect.origin.x + rect.size.width);
+ }
+}
+
+void
+GetGlyphBBox_AAT(CFDictionaryRef attributes, UInt16 gid, GlyphBBox* bbox)
+ /* returns glyph bounding box in TeX points */
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ return getGlyphBBoxFromCTFont(font, gid, bbox);
+}
+
+static double
+getGlyphWidthFromCTFont(CTFontRef font, UInt16 gid)
+{
+ return PStoTeXPoints(CTFontGetAdvancesForGlyphs(font, kCTFontHorizontalOrientation, &gid, NULL, 1));
+}
+
+double
+GetGlyphWidth_AAT(CFDictionaryRef attributes, UInt16 gid)
+ /* returns TeX points */
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ return getGlyphWidthFromCTFont(font, gid);
+}
+
+void
+GetGlyphHeightDepth_AAT(CFDictionaryRef attributes, UInt16 gid, float* ht, float* dp)
+ /* returns TeX points */
+{
+ GlyphBBox bbox;
+
+ GetGlyphBBox_AAT(attributes, gid, &bbox);
+
+ *ht = bbox.yMax;
+ *dp = -bbox.yMin;
+}
+
+void
+GetGlyphSidebearings_AAT(CFDictionaryRef attributes, UInt16 gid, float* lsb, float* rsb)
+ /* returns TeX points */
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ CGSize advances[1] = { CGSizeMake(0, 0) };
+ double advance = CTFontGetAdvancesForGlyphs(font, 0, &gid, advances, 1);
+ GlyphBBox bbox;
+ getGlyphBBoxFromCTFont(font, gid, &bbox);
+ *lsb = bbox.xMin;
+ *rsb = PStoTeXPoints(advance) - bbox.xMax;
+}
+
+double
+GetGlyphItalCorr_AAT(CFDictionaryRef attributes, UInt16 gid)
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ CGSize advances[1] = { CGSizeMake(0, 0) };
+ double advance = CTFontGetAdvancesForGlyphs(font, 0, &gid, advances, 1);
+
+ GlyphBBox bbox;
+ getGlyphBBoxFromCTFont(font, gid, &bbox);
+
+ if (bbox.xMax > PStoTeXPoints(advance))
+ return bbox.xMax - PStoTeXPoints(advance);
+ return 0;
+}
+
+static int
+mapCharToGlyphFromCTFont(CTFontRef font, UInt32 ch)
+{
+ CGGlyph glyphs[2] = { 0 };
+ UniChar txt[2];
+ int len = 1;
+
+ if (ch > 0xffff) {
+ ch -= 0x10000;
+ txt[0] = 0xd800 + ch / 1024;
+ txt[1] = 0xdc00 + ch % 1024;
+ len = 2;
+ } else {
+ txt[0] = ch;
+ }
+
+ if (CTFontGetGlyphsForCharacters(font, txt, glyphs, len))
+ return glyphs[0];
+
+ return 0;
+}
+
+int
+MapCharToGlyph_AAT(CFDictionaryRef attributes, UInt32 ch)
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ return mapCharToGlyphFromCTFont(font, ch);
+}
+
+static int
+GetGlyphIDFromCTFont(CTFontRef ctFontRef, const char* glyphName)
+{
+ CFStringRef glyphname = CFStringCreateWithCStringNoCopy(kCFAllocatorDefault,
+ glyphName,
+ kCFStringEncodingUTF8,
+ kCFAllocatorNull);
+ int rval = CTFontGetGlyphWithName(ctFontRef, glyphname);
+ CFRelease(glyphname);
+ return rval;
+}
+
+int
+MapGlyphToIndex_AAT(CFDictionaryRef attributes, const char* glyphName)
+{
+ CTFontRef font = fontFromAttributes(attributes);
+ return GetGlyphIDFromCTFont(font, glyphName);
+}
+
+char*
+GetGlyphNameFromCTFont(CTFontRef ctFontRef, UInt16 gid, int* len)
+{
+ CGFontRef cgfont;
+ static char buffer[256];
+ buffer[0] = 0;
+ *len = 0;
+
+ cgfont = CTFontCopyGraphicsFont(ctFontRef, 0);
+ if (cgfont && gid < CGFontGetNumberOfGlyphs(cgfont)) {
+ CFStringRef glyphname = CGFontCopyGlyphNameForGlyph(cgfont, gid);
+ if (glyphname) {
+ if (CFStringGetCString(glyphname, buffer, 256, kCFStringEncodingUTF8)) {
+ *len = strlen(buffer);
+ }
+ CFRelease(glyphname);
+ }
+ CGFontRelease(cgfont);
+ }
+
+ return &buffer[0];
+}
+
+int
+GetFontCharRange_AAT(CFDictionaryRef attributes, int reqFirst)
+{
+ if (reqFirst) {
+ int ch = 0;
+ while (MapCharToGlyph_AAT(attributes, ch) == 0 && ch < 0x10ffff)
+ ++ch;
+ return ch;
+ } else {
+ int ch = 0x10ffff;
+ while (MapCharToGlyph_AAT(attributes, ch) == 0 && ch > 0)
+ --ch;
+ return ch;
+ }
+}
+
+char*
+getNameFromCTFont(CTFontRef ctFontRef, CFStringRef nameKey)
+{
+ char *buf;
+ CFStringRef name = CTFontCopyName(ctFontRef, nameKey);
+ CFIndex len = CFStringGetLength(name);
+ len = len * 6 + 1;
+ buf = xmalloc(len);
+ if (CFStringGetCString(name, buf, len, kCFStringEncodingUTF8))
+ return buf;
+ free(buf);
+ return NULL;
+}
+
+char*
+getFileNameFromCTFont(CTFontRef ctFontRef, uint32_t *index)
+{
+ char *ret = NULL;
+ CFURLRef url = NULL;
+
+#if !defined(MAC_OS_X_VERSION_10_6) || MAC_OS_X_VERSION_MIN_REQUIRED < MAC_OS_X_VERSION_10_6
+ /* kCTFontURLAttribute was not avialable before 10.6 */
+ ATSFontRef atsFont;
+ FSRef fsref;
+ OSStatus status;
+ atsFont = CTFontGetPlatformFont(ctFontRef, NULL);
+ status = ATSFontGetFileReference(atsFont, &fsref);
+ if (status == noErr)
+ url = CFURLCreateFromFSRef(NULL, &fsref);
+#else
+ url = (CFURLRef) CTFontCopyAttribute(ctFontRef, kCTFontURLAttribute);
+#endif
+ if (url) {
+ UInt8 pathname[PATH_MAX];
+ if (CFURLGetFileSystemRepresentation(url, true, pathname, PATH_MAX)) {
+ FT_Error error;
+ FT_Face face;
+
+ *index = 0;
+
+ if (!gFreeTypeLibrary) {
+ error = FT_Init_FreeType(&gFreeTypeLibrary);
+ if (error) {
+ fprintf(stderr, "FreeType initialization failed! (%d)\n", error);
+ exit(1);
+ }
+ }
+
+ error = FT_New_Face(gFreeTypeLibrary, (char *) pathname, 0, &face);
+ if (!error) {
+ if (face->num_faces > 1) {
+ int num_faces = face->num_faces;
+ char *ps_name1 = getNameFromCTFont(ctFontRef, kCTFontPostScriptNameKey);
+ int i;
+ *index = -1;
+ FT_Done_Face (face);
+ for (i = 0; i < num_faces; i++) {
+ error = FT_New_Face (gFreeTypeLibrary, (char *) pathname, i, &face);
+ if (!error) {
+ const char *ps_name2 = FT_Get_Postscript_Name(face);
+ if (strcmp(ps_name1, ps_name2) == 0) {
+ *index = i;
+ break;
+ }
+ FT_Done_Face (face);
+ }
+ }
+ free(ps_name1);
+ }
+ }
+
+ if (*index != -1)
+ ret = strdup((char *) pathname);
+ }
+ CFRelease(url);
+ }
+
+ return ret;
+}
+
+CFDictionaryRef
+findDictionaryInArrayWithIdentifier(CFArrayRef array, const void* identifierKey, int identifier)
+{
+ CFDictionaryRef dict = NULL;
+
+ if (array) {
+ int value = -1;
+ CFIndex i;
+ for (i = 0; i < CFArrayGetCount(array); i++) {
+ CFDictionaryRef item = CFArrayGetValueAtIndex(array, i);
+ CFNumberRef itemId = CFDictionaryGetValue(item, identifierKey);
+ if (itemId) {
+ CFNumberGetValue(itemId, kCFNumberIntType, &value);
+ if (value == identifier) {
+ dict = item;
+ break;
+ }
+ }
+ }
+ }
+ return dict;
+}
+
+CFDictionaryRef
+findDictionaryInArray(CFArrayRef array, const void* nameKey, const char* name, int nameLength)
+{
+ CFDictionaryRef dict = NULL;
+
+ if (array) {
+ CFStringRef itemName;
+ CFIndex i;
+ itemName = CFStringCreateWithBytes(NULL, (UInt8 *) name, nameLength,
+ kCFStringEncodingUTF8, false);
+ for (i = 0; i < CFArrayGetCount(array); i++) {
+ CFDictionaryRef item = CFArrayGetValueAtIndex(array, i);
+ CFStringRef iName = CFDictionaryGetValue(item, nameKey);
+ if (iName && !CFStringCompare(itemName, iName, kCFCompareCaseInsensitive)) {
+ dict = item;
+ break;
+ }
+ }
+ CFRelease(itemName);
+ }
+ return dict;
+}
+
+CFNumberRef
+findSelectorByName(CFDictionaryRef feature, const char* name, int nameLength)
+{
+ CFNumberRef selector = NULL;
+ CFArrayRef selectors = CFDictionaryGetValue(feature, kCTFontFeatureTypeSelectorsKey);
+ if (selectors) {
+ CFDictionaryRef s = findDictionaryInArray(selectors, kCTFontFeatureSelectorNameKey, name, nameLength);
+ if (s)
+ selector = CFDictionaryGetValue(s, kCTFontFeatureSelectorIdentifierKey);
+ }
+ return selector;
+}
+
+static CFDictionaryRef
+createFeatureSettingDictionary(CFNumberRef featureTypeIdentifier, CFNumberRef featureSelectorIdentifier)
+{
+ const void* settingKeys[] = { kCTFontFeatureTypeIdentifierKey, kCTFontFeatureSelectorIdentifierKey };
+ const void* settingValues[] = { featureTypeIdentifier, featureSelectorIdentifier };
+
+ return CFDictionaryCreate(kCFAllocatorDefault, settingKeys, settingValues, 2,
+ &kCFTypeDictionaryKeyCallBacks, &kCFTypeDictionaryValueCallBacks);
+}
+
+const CFStringRef kXeTeXEmboldenAttributeName = CFSTR("XeTeXEmbolden");
+
+void*
+loadAATfont(CTFontDescriptorRef descriptor, integer scaled_size, const char* cp1)
+{
+ CTFontRef font, actualFont;
+ CGFloat ctSize;
+ CFMutableDictionaryRef stringAttributes, attributes;
+ CGAffineTransform matrix;
+ CFMutableArrayRef cascadeList;
+ CTFontDescriptorRef lastResort;
+ double tracking = 0.0;
+ float extend = 1.0;
+ float slant = 0.0;
+ float embolden = 0.0;
+ float letterspace = 0.0;
+ uint32_t rgbValue;
+
+ // create a base font instance for applying further attributes
+ ctSize = TeXtoPSPoints(Fix2D(scaled_size));
+ font = CTFontCreateWithFontDescriptor(descriptor, ctSize, NULL);
+ if (!font)
+ return NULL;
+
+ stringAttributes = CFDictionaryCreateMutable(NULL, 0,
+ &kCFTypeDictionaryKeyCallBacks,
+ &kCFTypeDictionaryValueCallBacks);
+ attributes = CFDictionaryCreateMutable(NULL, 0,
+ &kCFTypeDictionaryKeyCallBacks,
+ &kCFTypeDictionaryValueCallBacks);
+ if (cp1) {
+ CFArrayRef features = CTFontCopyFeatures(font);
+ CFMutableArrayRef featureSettings =
+ CFArrayCreateMutable(NULL, 0, &kCFTypeArrayCallBacks);
+
+ // interpret features following ":"
+ while (*cp1) {
+ CFDictionaryRef feature;
+ int ret;
+ const char* cp2;
+ const char* cp3;
+ // locate beginning of name=value pair
+ if (*cp1 == ':' || *cp1 == ';') // skip over separator
+ ++cp1;
+ while (*cp1 == ' ' || *cp1 == '\t') // skip leading whitespace
+ ++cp1;
+ if (*cp1 == 0) // break if end of string
+ break;
+
+ // scan to end of pair
+ cp2 = cp1;
+ while (*cp2 && (*cp2 != ';') && (*cp2 != ':'))
+ ++cp2;
+
+ // look for the '=' separator
+ cp3 = cp1;
+ while ((cp3 < cp2) && (*cp3 != '='))
+ ++cp3;
+ if (cp3 == cp2)
+ goto bad_option;
+
+ // now cp1 points to option name, cp3 to '=', cp2 to ';' or null
+
+ // first try for a feature by this name
+ feature = findDictionaryInArray(features, kCTFontFeatureTypeNameKey, cp1, cp3 - cp1);
+ if (feature) {
+ // look past the '=' separator for setting names
+ int featLen = cp3 - cp1;
+ int zeroInteger = 0;
+ CFNumberRef zero = CFNumberCreate(NULL, kCFNumberIntType, &zeroInteger);
+ ++cp3;
+ while (cp3 < cp2) {
+ CFNumberRef selector;
+ int disable = 0;
+ const char* cp4;
+ // skip leading whitespace
+ while (*cp3 == ' ' || *cp3 == '\t')
+ ++cp3;
+
+ // possibly multiple settings...
+ if (*cp3 == '!') { // check for negation
+ disable = 1;
+ ++cp3;
+ }
+
+ // scan for end of setting name
+ cp4 = cp3;
+ while (cp4 < cp2 && *cp4 != ',')
+ ++cp4;
+
+ // now cp3 points to name, cp4 to ',' or ';' or null
+ selector = findSelectorByName(feature, cp3, cp4 - cp3);
+ if (selector && CFNumberCompare(selector, zero, NULL) >= 0) {
+ CFNumberRef featureType = CFDictionaryGetValue(feature, kCTFontFeatureTypeIdentifierKey);
+ CFDictionaryRef featureSetting = createFeatureSettingDictionary(featureType, selector);
+ CFArrayAppendValue(featureSettings, featureSetting);
+ CFRelease(featureSetting);
+ } else {
+ fontfeaturewarning(cp1, featLen, cp3, cp4 - cp3);
+ }
+
+ // point beyond setting name terminator
+ cp3 = cp4 + 1;
+ }
+ CFRelease(zero);
+
+ goto next_option;
+ }
+
+ // didn't find feature, try other options...
+ ret = readCommonFeatures(cp1, cp2, &extend, &slant, &embolden, &letterspace, &rgbValue);
+ if (ret == 1)
+ goto next_option;
+ else if (ret == -1)
+ goto bad_option;
+
+ if (strncmp(cp1, "tracking", 8) == 0) {
+ CFNumberRef trackingNumber;
+ cp3 = cp1 + 8;
+ if (*cp3 != '=')
+ goto bad_option;
+ ++cp3;
+ tracking = read_double(&cp3);
+ trackingNumber = CFNumberCreate(NULL, kCFNumberDoubleType, &tracking);
+ CFDictionaryAddValue(stringAttributes, kCTKernAttributeName, trackingNumber);
+ CFRelease(trackingNumber);
+ goto next_option;
+ }
+
+ bad_option:
+ // not a name=value pair, or not recognized....
+ // check for plain "vertical" before complaining
+ if (strncmp(cp1, "vertical", 8) == 0) {
+ cp3 = cp2;
+ if (*cp3 == ';' || *cp3 == ':')
+ --cp3;
+ while (*cp3 == '\0' || *cp3 == ' ' || *cp3 == '\t')
+ --cp3;
+ if (*cp3)
+ ++cp3;
+ if (cp3 == cp1 + 8) {
+ int orientation = kCTFontVerticalOrientation;
+ CFNumberRef orientationNumber = CFNumberCreate(NULL, kCFNumberIntType, &orientation);
+ CFDictionaryAddValue(attributes, kCTFontOrientationAttribute, orientationNumber);
+ CFRelease(orientationNumber);
+ CFDictionaryAddValue(stringAttributes, kCTVerticalFormsAttributeName, kCFBooleanTrue);
+ goto next_option;
+ }
+ }
+
+ fontfeaturewarning(cp1, cp2 - cp1, 0, 0);
+
+ next_option:
+ // go to next name=value pair
+ cp1 = cp2;
+ }
+
+ if (features)
+ CFRelease(features);
+
+ if (CFArrayGetCount(featureSettings))
+ CFDictionaryAddValue(attributes, kCTFontFeatureSettingsAttribute, featureSettings);
+ CFRelease(featureSettings);
+ }
+
+ if ((loadedfontflags & FONT_FLAGS_COLORED) != 0) {
+ CGFloat red = ((rgbValue & 0xFF000000) >> 24) / 255.0;
+ CGFloat green = ((rgbValue & 0x00FF0000) >> 16) / 255.0;
+ CGFloat blue = ((rgbValue & 0x0000FF00) >> 8 ) / 255.0;
+ CGFloat alpha = ((rgbValue & 0x000000FF) ) / 255.0;
+ CGColorRef color = CGColorCreateGenericRGB(red, green, blue, alpha);
+ CFDictionaryAddValue(stringAttributes, kCTForegroundColorAttributeName, color);
+ CGColorRelease(color);
+ }
+
+ matrix = CGAffineTransformIdentity;
+ if (extend != 1.0 || slant != 0.0)
+ matrix = CGAffineTransformMake(extend, 0, slant, 1.0, 0, 0);
+
+ if (embolden != 0.0) {
+ CFNumberRef emboldenNumber;
+ embolden = embolden * Fix2D(scaled_size) / 100.0;
+ emboldenNumber = CFNumberCreate(NULL, kCFNumberFloatType, &embolden);
+ CFDictionaryAddValue(stringAttributes, kXeTeXEmboldenAttributeName, emboldenNumber);
+ CFRelease(emboldenNumber);
+ }
+
+ if (letterspace != 0.0)
+ loadedfontletterspace = (letterspace / 100.0) * scaled_size;
+
+ // Disable Core Text font fallback (cascading) with only the last resort font
+ // in the cascade list.
+ cascadeList = CFArrayCreateMutable(NULL, 1, &kCFTypeArrayCallBacks);
+ lastResort = CTFontDescriptorCreateWithNameAndSize(CFSTR("LastResort"), 0);
+ CFArrayAppendValue(cascadeList, lastResort);
+ CFRelease(lastResort);
+ CFDictionaryAddValue(attributes, kCTFontCascadeListAttribute, cascadeList);
+ CFRelease(cascadeList);
+
+ descriptor = CTFontDescriptorCreateWithAttributes(attributes);
+ CFRelease(attributes);
+ actualFont = CTFontCreateCopyWithAttributes(font, ctSize, &matrix, descriptor);
+ CFRelease(font);
+ CFDictionaryAddValue(stringAttributes, kCTFontAttributeName, actualFont);
+ CFRelease(actualFont);
+
+ nativefonttypeflag = AAT_FONT_FLAG;
+ return (void *) stringAttributes;
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeX_pic.c b/Build/source/texk/web2c/xetexdir/XeTeX_pic.c
new file mode 100644
index 00000000000..237e7afcb8e
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeX_pic.c
@@ -0,0 +1,153 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+XeTeX_pic.c
+ interface between xetex and graphics files
+ only needs to get image dimensions, not actually load/process the file
+*/
+
+#define EXTERN extern
+#include "xetexd.h"
+
+#include "XeTeX_ext.h"
+
+#include <kpathsea/c-ctype.h>
+#include <kpathsea/line.h>
+#include <kpathsea/readable.h>
+#include <kpathsea/variable.h>
+#include <kpathsea/absolute.h>
+
+#include "pdfimage.h"
+#include "image/pngimage.h"
+#include "image/jpegimage.h"
+#include "image/bmpimage.h"
+
+
+int
+countpdffilepages(void)
+{
+ int rval = 0;
+
+ char* pic_path = kpse_find_file((char*)nameoffile + 1, kpse_pict_format, 1);
+ if (pic_path) {
+ rval = pdf_count_pages(pic_path);
+ free(pic_path);
+ }
+
+ return rval;
+}
+
+
+/*
+ locate picture file from /nameoffile+1/ using kpathsearch
+ pdfBoxType indicates which pdf bounding box to use (0 for \XeTeXpicfile)
+ page indicates which page is wanted (0-based)
+ return 0 for success, or non-zero error code for failure
+ return full path in *path
+ return bounds (tex points) in *bounds
+*/
+
+#ifdef _WIN32
+#undef fopen
+#define fopen fsyscp_fopen
+#endif
+
+int
+find_pic_file(char** path, realrect* bounds, int pdfBoxType, int page)
+{
+ int err = -1;
+ FILE* fp = NULL;
+ char* pic_path = kpse_find_file((char*)nameoffile + 1, kpse_pict_format, 1);
+
+ *path = NULL;
+ bounds->x = bounds->y = bounds->wd = bounds->ht = 0.0;
+
+ if (pic_path == NULL)
+ goto done;
+
+ /* if cmd was \XeTeXpdffile, use xpdflib to read it */
+ if (pdfBoxType != 0) {
+ err = pdf_get_rect(pic_path, page, pdfBoxType, bounds);
+ goto done;
+ }
+
+ /* otherwise try graphics formats that we know */
+ fp = fopen(pic_path, FOPEN_RBIN_MODE);
+ if (fp == NULL)
+ goto done;
+
+ if (check_for_jpeg(fp)) {
+ struct JPEG_info info;
+ err = JPEG_scan_file(&info, fp);
+ if (err == 0) {
+ bounds->wd = (info.width * 72.27) / info.xdpi;
+ bounds->ht = (info.height * 72.27) / info.ydpi;
+ }
+ goto done;
+ }
+
+ if (check_for_bmp(fp)) {
+ struct bmp_info info;
+ err = bmp_scan_file(&info, fp);
+ if (err == 0) {
+ bounds->wd = (info.width * 72.27) / info.xdpi;
+ bounds->ht = (info.height * 72.27) / info.ydpi;
+ }
+ goto done;
+ }
+
+ if (check_for_png(fp)) {
+ struct png_info info;
+ err = png_scan_file(&info, fp);
+ if (err == 0) {
+ bounds->wd = (info.width * 72.27) / info.xdpi;
+ bounds->ht = (info.height * 72.27) / info.ydpi;
+ }
+ goto done;
+ }
+
+ /* could support other file types here (TIFF, WMF, etc?) */
+
+done:
+ if (fp != NULL)
+ fclose(fp);
+
+ if (err == 0)
+ *path = pic_path;
+ else {
+ if (pic_path != NULL)
+ free(pic_path);
+ }
+
+ return err;
+}
diff --git a/Build/source/texk/web2c/xetexdir/XeTeX_web.h b/Build/source/texk/web2c/xetexdir/XeTeX_web.h
new file mode 100644
index 00000000000..6d38fd8b96d
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeX_web.h
@@ -0,0 +1,64 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2012 by Jonathan Kew
+ Copyright (c) 2010-2014 by Han The Thanh
+ Copyright (c) 2012-2015 by Khaled Hosny
+ Copyright (c) 2014 by Peter Breitenlohner
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XETEX_WEB_H
+#define __XETEX_WEB_H
+
+#include <XeTeX_ext.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+// declarations from the Pascal/WEB side used in C++ code
+
+extern void zprintnl(int s);
+extern void zprintchar(int c);
+extern void begindiagnostic(void);
+extern void zenddiagnostic(int nl);
+extern int gettracingfontsstate(void);
+extern void set_cp_code(int, unsigned int, int, int);
+extern int get_cp_code(int, unsigned int, int);
+
+extern Fixed loadedfontdesignsize;
+extern void **fontlayoutengine;
+extern integer *fontarea;
+extern integer *fontsize;
+
+#ifdef __cplusplus
+};
+#endif
+
+#endif /* __XETEX_WEB_H */
diff --git a/Build/source/texk/web2c/xetexdir/XeTeXswap.h b/Build/source/texk/web2c/xetexdir/XeTeXswap.h
new file mode 100644
index 00000000000..ffdcc2e2a01
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/XeTeXswap.h
@@ -0,0 +1,84 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __XeTeXswap_H
+#define __XeTeXswap_H
+
+#include <unicode/platform.h> // ICU's platform.h defines U_IS_BIG_ENDIAN for us
+
+static inline uint16_t
+SWAP16(const uint16_t p)
+{
+#if U_IS_BIG_ENDIAN
+ return p;
+#else
+ return (p >> 8) + (p << 8);
+#endif
+}
+
+static inline uint32_t
+SWAP32(const uint32_t p)
+{
+#if U_IS_BIG_ENDIAN
+ return p;
+#else
+ return (p >> 24) + ((p >> 8) & 0x0000ff00) + ((p << 8) & 0x00ff0000) + (p << 24);
+#endif
+}
+
+#ifdef __cplusplus
+static inline uint16_t
+SWAP(uint16_t p)
+{
+ return SWAP16(p);
+}
+
+static inline uint32_t
+SWAP(uint32_t p)
+{
+ return SWAP32(p);
+}
+
+static inline int16_t
+SWAP(int16_t p)
+{
+ return (int16_t)SWAP16((uint16_t)p);
+}
+
+static inline int32_t
+SWAP(int32_t p)
+{
+ return (int32_t)SWAP32((uint32_t)p);
+}
+#endif
+
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/am/xetex.am b/Build/source/texk/web2c/xetexdir/am/xetex.am
new file mode 100644
index 00000000000..ecbdc8ca31f
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/am/xetex.am
@@ -0,0 +1,219 @@
+## $Id$
+## texk/web2c/xetexdir/am/xetex.am: Makefile fragment for XeTeX.
+##
+## Copyright 2017-2021 Karl Berry <tex-live@tug.org>
+## Copyright 2009-2015 Peter Breitenlohner <tex-live@tug.org>
+## You may freely use, modify and/or distribute this file.
+
+## XeTeX
+##
+if XETEX
+bin_PROGRAMS += xetex
+endif XETEX
+EXTRA_PROGRAMS += xetex
+
+# Force Automake to use CXXLD for linking
+nodist_EXTRA_xetex_SOURCES = dummy.cxx
+
+xe_tangle = WEBINPUTS=.:$(srcdir)/xetexdir AM_V_P=$(AM_V_P) $(SHELL) ./tangle-sh $@ $(OTANGLE)
+
+libxetex = libxetex.a
+
+xetex_cppflags = $(AM_CPPFLAGS) -I$(srcdir)/xetexdir
+## Must add icu first to avoid an installed version.
+xetex_cppflags += $(ICU_INCLUDES)
+## Must add freetype2 includes early to avoid
+## freetype1/freetype2 confusion -- what a mess.
+xetex_cppflags += $(FREETYPE2_INCLUDES)
+xetex_cppflags += $(TECKIT_INCLUDES)
+xetex_cppflags += $(HARFBUZZ_INCLUDES)
+xetex_cppflags += $(GRAPHITE2_INCLUDES)
+xetex_cppflags += $(LIBPNG_INCLUDES)
+xetex_cppflags += $(ZLIB_INCLUDES)
+xetex_cppflags += $(PPLIB_INCLUDES)
+xetex_cppflags += -I$(srcdir)/libmd5
+xetex_ldadd = $(libxetex)
+xetex_ldadd += $(HARFBUZZ_LIBS)
+xetex_ldadd += $(GRAPHITE2_LIBS)
+xetex_ldadd += $(ICU_LIBS) $(ICU_LIBS_EXTRA)
+xetex_ldadd += $(TECKIT_LIBS)
+xetex_ldadd += $(LIBPNG_LIBS)
+xetex_ldadd += $(FREETYPE2_LIBS)
+xetex_ldadd += $(PPLIB_LIBS)
+xetex_ldadd += $(ZLIB_LIBS)
+xetex_ldadd += libmd5.a
+xetex_dependencies = $(proglib)
+xetex_dependencies += $(KPATHSEA_DEPEND)
+xetex_dependencies += $(ICU_DEPEND)
+xetex_dependencies += $(TECKIT_DEPEND)
+xetex_dependencies += $(HARFBUZZ_DEPEND)
+xetex_dependencies += $(GRAPHITE2_DEPEND)
+xetex_dependencies += $(LIBPNG_DEPEND)
+xetex_dependencies += $(FREETYPE2_DEPEND)
+xetex_dependencies += $(ZLIB_DEPEND)
+xetex_dependencies += $(PPLIB_DEPEND)
+xetex_dependencies += libmd5.a
+
+if XETEX_MACOSX
+xetex_cppflags += -DXETEX_MAC
+xetex_LDFLAGS = -framework ApplicationServices -framework Cocoa
+OBJCXXFLAGS += -std=c++11
+
+else !XETEX_MACOSX
+xetex_cppflags += $(FONTCONFIG_INCLUDES)
+xetex_ldadd += $(FONTCONFIG_LIBS)
+
+endif !XETEX_MACOSX
+
+xetex_CPPFLAGS = $(xetex_cppflags)
+xetex_CFLAGS = $(WARNING_CFLAGS)
+xetex_CXXFLAGS = # $(WARNING_CXXFLAGS)
+
+## With --enable-ipc, XeTeX may need to link with -lsocket.
+xetex_LDADD = $(xetex_ldadd) $(LDADD) $(ipc_socketlibs)
+
+## We must create libxetex.a etc before building the xetex_OBJECTS
+xetex_prereq = $(libxetex) xetexdir/etex_version.h xetexdir/xetex_version.h
+$(xetex_OBJECTS): $(xetex_prereq)
+
+## XeTeX C sources
+xetex_c_h = xetexini.c xetex0.c xetexcoerce.h xetexd.h
+nodist_xetex_SOURCES = $(xetex_c_h) xetex-pool.c
+dist_xetex_SOURCES = xetexdir/xetexextra.c xetexdir/xetexextra.h \
+ xetexdir/etex_version.h xetexdir/xetex_version.h
+
+$(xetex_c_h): xetex-web2c
+ @$(web2c) xetex
+xetex-web2c: xetex.p $(web2c_texmf) xetexdir/xetex.defines
+ @$(web2c) xetex
+
+xetex-pool.c: xetex.pool xetexd.h $(makecpool_stamp)
+ $(makecpool) xetex >$@ || rm -f $@
+
+## Tangling XeTeX
+xetex.p xetex.pool: xetex-tangle
+ @$(xe_tangle) xetex xetex-final
+xetex-tangle: otangle$(EXEEXT) xetexdir/xetex.web xetex-final.ch tangle-sh
+ @$(xe_tangle) xetex xetex-final
+
+# Extract etex version
+$(srcdir)/xetexdir/etex_version.h: @MAINTAINER_MODE_TRUE@ xetexdir/xetex.web
+ $(AM_V_GEN)grep '^@d eTeX_version_string==' $(srcdir)/xetexdir/xetex.web \
+ | sed "s/^.*'-/#define ETEX_VERSION \"/;s/'.*$$/\"/" >$@
+
+## Extract xetex version
+$(srcdir)/xetexdir/xetex_version.h: @MAINTAINER_MODE_TRUE@ xetexdir/xetex.web
+ $(AM_V_GEN)grep '^@d XeTeX_version_string==' $(srcdir)/xetexdir/xetex.web \
+ | sed "s/^.*'-/#define XETEX_VERSION \"/;s/'.*$$/\"/" >$@
+
+## Generate xetex-final.ch
+xetex-final.ch: tie$(EXEEXT) $(xetex_ch_srcs)
+ $(tie_c) $(xetex_ch_srcs)
+xetex_ch_srcs = \
+ xetexdir/xetex.web \
+ xetexdir/tex.ch0 \
+ tex.ch \
+ tracingstacklevels.ch \
+ $(xetex_ch_synctex) \
+ xetexdir/xetex.ch \
+ $(xetex_post_ch_synctex) \
+ xetexdir/char-warning-xetex.ch \
+ tex-binpool.ch
+
+##
+EXTRA_DIST += $(xetex_web_srcs) $(xetex_ch_srcs) xetexdir/xetex.defines
+
+DISTCLEANFILES += $(nodist_xetex_SOURCES) xetex.web xetex-final.ch \
+ xetex-web2c xetex.p xetex.pool xetex-tangle
+
+
+## libxetex
+##
+EXTRA_LIBRARIES += libxetex.a
+
+libxetex_a_CPPFLAGS = $(xetex_cppflags)
+libxetex_a_CFLAGS = $(WARNING_CFLAGS)
+libxetex_a_CXXFLAGS = # $(WARNING_CXXFLAGS)
+libxetex_a_OBJCXXFLAGS = # $(WARNING_OBJCXXFLAGS)
+
+libxetex_a_SOURCES = \
+ xetexdir/XeTeXFontInst.cpp \
+ xetexdir/XeTeXFontInst.h \
+ xetexdir/XeTeXFontMgr.cpp \
+ xetexdir/XeTeXFontMgr.h \
+ xetexdir/XeTeXLayoutInterface.cpp \
+ xetexdir/XeTeXLayoutInterface.h \
+ xetexdir/XeTeXOTMath.cpp \
+ xetexdir/XeTeXOTMath.h \
+ xetexdir/XeTeX_ext.c \
+ xetexdir/XeTeX_ext.h \
+ xetexdir/XeTeX_pic.c \
+ xetexdir/XeTeX_web.h \
+ xetexdir/XeTeXswap.h \
+ xetexdir/trans.c \
+ xetexdir/trans.h \
+ xetexdir/hz.cpp \
+ xetexdir/xetex.h \
+ xetexdir/pdfimage.cpp \
+ xetexdir/pdfimage.h \
+ xetexdir/image/bmpimage.c \
+ xetexdir/image/bmpimage.h \
+ xetexdir/image/jpegimage.c \
+ xetexdir/image/jpegimage.h \
+ xetexdir/image/mfileio.c \
+ xetexdir/image/mfileio.h \
+ xetexdir/image/numbers.c \
+ xetexdir/image/numbers.h \
+ xetexdir/image/pngimage.c \
+ xetexdir/image/pngimage.h
+
+if XETEX_MACOSX
+
+libxetex_a_SOURCES += \
+ xetexdir/XeTeXFontInst_Mac.cpp \
+ xetexdir/XeTeXFontInst_Mac.h \
+ xetexdir/XeTeXFontMgr_Mac.mm \
+ xetexdir/XeTeXFontMgr_Mac.h \
+ xetexdir/XeTeX_mac.c
+
+else !XETEX_MACOSX
+
+libxetex_a_SOURCES += \
+ xetexdir/XeTeXFontMgr_FC.cpp \
+ xetexdir/XeTeXFontMgr_FC.h
+
+endif !XETEX_MACOSX
+
+# We must create xetexd.h etc. before building the libxetex_a_OBJECTS.
+libxetex_prereq = xetexd.h $(xetex_dependencies)
+$(libxetex_a_OBJECTS): $(libxetex_prereq)
+
+EXTRA_DIST += \
+ xetexdir/ChangeLog \
+ xetexdir/COPYING \
+ xetexdir/NEWS \
+ xetexdir/image/README \
+ xetexdir/unicode-char-prep.pl \
+ xetexdir/xewebmac.tex
+
+# XeTeX Tests
+#
+xetex_tests = \
+ xetexdir/xetex-filedump.test \
+ xetexdir/xetex-bug73.test \
+ xetexdir/xetex.test
+xetexdir/xetex-filedump.log xetexdir/xetex-bug73.log xetexdir/xetex.log: xetex$(EXEEXT)
+
+EXTRA_DIST += $(xetex_tests)
+
+if XETEX
+TESTS += $(xetex_tests)
+endif XETEX
+
+## xetex-bug73.test
+EXTRA_DIST += xetexdir/tests/bug73.log xetexdir/tests/bug73.tex
+DISTCLEANFILES += bug73.fmt bug73.log bug73.out bug73.tex
+
+## xetex-filedump.test
+EXTRA_DIST += xetexdir/tests/filedump.log xetexdir/tests/filedump.tex
+DISTCLEANFILES += filedump.log filedump.out filedump.tex
diff --git a/Build/source/texk/web2c/xetexdir/char-warning-xetex.ch b/Build/source/texk/web2c/xetexdir/char-warning-xetex.ch
new file mode 100644
index 00000000000..fcf9a6386a2
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/char-warning-xetex.ch
@@ -0,0 +1,84 @@
+% $Id$
+% Public domain. See ../pdftexdir/char-warning-pdftex.ch for basic info.
+% In addition to the basic change, we also define a new procedure
+% print_ucs_code to print in the format U+.... for system fonts.
+%
+% To test:
+% xetex -ini
+% \font\x=/usr/local/texlive/2020/texmf-dist/fonts/tfm/public/knuth-lib/logo10.tfm
+% \tracinglostchars=3 \x \char99\end
+% should get:
+% ! Missing character: There is no c ("63) in font logo10.
+% And:
+% \font\y="Nimbus Mono" \tracinglostchars=3 \y \char43981\end
+% should get:
+% ! Missing character: There is no ꯍ (U+ABCD) in font Nimbus Mono Regular!.
+% Assuming that font is findable as a system font, e.g., shown by
+% fc-list :scalable=true family
+
+@x [30] If \tracinglostchars > 2, then promote to full error.
+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 eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+ begin begin_diagnostic;
+ print_nl("Missing character: There is no ");
+@.Missing character@>
+ if c < @"10000 then print_ASCII(c)
+ else print_char(c); {non-Plane 0 Unicodes can't be sent through |print_ASCII|}
+ print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ end;
+ tracing_online:=old_setting;
+ end;
+end;
+@y
+procedure print_ucs_code(@!n: UnicodeScalar); { cf.~|print_hex| }
+ var k: 0..22; {index to current digit; we assume that $0\L n<16^{22}$}
+ begin
+ k := 0;
+ print("U+"); { prefix with U+ instead of " }
+ repeat
+ dig[k] := n mod 16;
+ n := n div 16;
+ incr(k);
+ until n = 0;
+ { pad to at least 4 hex digits }
+ while k < 4 do
+ begin
+ dig[k] := 0;
+ incr(k);
+ end;
+ print_the_digs(k);
+end;
+
+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 eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+ if tracing_lost_chars > 2 then
+ print_err("Missing character: There is no ")
+ else begin
+ begin_diagnostic;
+ print_nl("Missing character: There is no ")
+ end;
+@.Missing character@>
+ if c < @"10000 then print_ASCII(c)
+ else print_char(c); {non-Plane 0 Unicodes can't be sent through |print_ASCII|}
+ print(" (");
+ if is_native_font(f) then print_ucs_code(c)
+ else print_hex(c);
+ print(")");
+ print(" in font ");
+ slow_print(font_name[f]);
+ if tracing_lost_chars < 3 then print_char("!");
+ tracing_online:=old_setting;
+ if tracing_lost_chars > 2 then begin
+ help0;
+ error;
+ end else end_diagnostic(false);
+ end; {of |tracing_lost_chars>0|}
+end; {of procedure}
+@z
diff --git a/Build/source/texk/web2c/xetexdir/etex_version.h b/Build/source/texk/web2c/xetexdir/etex_version.h
new file mode 100644
index 00000000000..13752253536
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/etex_version.h
@@ -0,0 +1 @@
+#define ETEX_VERSION "2.6"
diff --git a/Build/source/texk/web2c/xetexdir/hz.cpp b/Build/source/texk/web2c/xetexdir/hz.cpp
new file mode 100644
index 00000000000..113a03f7a28
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/hz.cpp
@@ -0,0 +1,77 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 2010-2014 by Han The Thanh
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include "XeTeX_web.h"
+
+#include <map>
+#include <iostream>
+#include <assert.h>
+using namespace std;
+
+typedef pair<int, unsigned int> GlyphId;
+typedef map<GlyphId, int> ProtrusionFactor;
+ProtrusionFactor leftProt, rightProt;
+
+void set_cp_code(int fontNum, unsigned int code, int side, int value)
+{
+ GlyphId id(fontNum, code);
+ switch (side) {
+ case LEFT_SIDE:
+ leftProt[id] = value;
+ break;
+ case RIGHT_SIDE:
+ rightProt[id] = value;
+ break;
+ default:
+ assert(0); // we should not reach here
+ }
+}
+
+int get_cp_code(int fontNum, unsigned int code, int side)
+{
+ GlyphId id(fontNum, code);
+ ProtrusionFactor* container;
+ switch (side) {
+ case LEFT_SIDE:
+ container = &leftProt;
+ break;
+ case RIGHT_SIDE:
+ container = &rightProt;
+ break;
+ default:
+ assert(0); // we should not reach here
+ }
+ ProtrusionFactor::iterator it = container->find(id);
+ if (it == container->end())
+ return 0;
+ return it->second;
+}
+
diff --git a/Build/source/texk/web2c/xetexdir/image/README b/Build/source/texk/web2c/xetexdir/image/README
new file mode 100644
index 00000000000..744d2fa2ef4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/README
@@ -0,0 +1 @@
+The files in this directory are derived from DVIPDFMx project
diff --git a/Build/source/texk/web2c/xetexdir/image/bmpimage.c b/Build/source/texk/web2c/xetexdir/image/bmpimage.c
new file mode 100644
index 00000000000..57b76091904
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/bmpimage.c
@@ -0,0 +1,211 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2006 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* $Header: /home/cvsroot/dvipdfmx/src/bmpimage.c,v 1.2 2004/07/27 12:08:46 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>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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.
+*/
+
+/*
+ * BMP SUPPORT:
+ */
+
+#if HAVE_CONFIG_H
+#include <w2c/config.h>
+#endif
+
+#include "bmpimage.h"
+
+#define DIB_FILE_HEADER_SIZE 14
+#define DIB_CORE_HEADER_SIZE 12
+#define DIB_INFO_HEADER_SIZE 40
+#define DIB_INFO_HEADER_SIZE2 64
+#define DIB_INFO_HEADER_SIZE4 108
+#define DIB_INFO_HEADER_SIZE5 124
+
+#define DIB_COMPRESS_NONE 0
+#define DIB_COMPRESS_RLE8 1
+#define DIB_COMPRESS_RLE4 2
+
+#define DIB_HEADER_SIZE_MAX (DIB_FILE_HEADER_SIZE+DIB_INFO_HEADER_SIZE5)
+
+static void
+WARN(const char *fmt, ...)
+{
+ va_list argp;
+
+ fprintf(stderr, "** WARNING ** ");
+ va_start(argp, fmt);
+ vfprintf(stderr, fmt, argp);
+ va_end(argp);
+ fprintf(stderr, "\n");
+}
+
+int
+check_for_bmp (FILE *fp)
+{
+ unsigned char sigbytes[2];
+
+ if (!fp)
+ return 0;
+
+ rewind(fp);
+ if (fread(sigbytes, 1, sizeof(sigbytes), fp) != sizeof(sigbytes) ||
+ sigbytes[0] != 'B' || sigbytes[1] != 'M')
+ return 0;
+ else
+ return 1;
+
+ return 0;
+}
+
+int
+bmp_scan_file(struct bmp_info *info, FILE *fp)
+{
+ unsigned char buf[DIB_HEADER_SIZE_MAX+4];
+ unsigned char *p;
+ long offset, hsize;
+ long psize; /* Bytes per palette color: 3 for OS2, 4 for Win */
+ unsigned short bit_count; /* Bits per pix */
+ int num_palette;
+ unsigned long biXPelsPerMeter, biYPelsPerMeter;
+
+ p = buf;
+
+ rewind(fp);
+ if (fread(buf, 1, DIB_FILE_HEADER_SIZE + 4, fp)
+ != DIB_FILE_HEADER_SIZE + 4) {
+ WARN("Could not read BMP file header...");
+ }
+
+ if (p[0] != 'B' || p[1] != 'M') {
+ WARN("File not starting with \'B\' \'M\'... Not a BMP file?");
+ return -1;
+ }
+ p += 2;
+
+#define ULONG_LE(b) ((b)[0] + ((b)[1] << 8) +\
+ ((b)[2] << 16) + ((b)[3] << 24))
+#define USHORT_LE(b) ((b)[0] + ((b)[1] << 8))
+
+ /* ignore fsize */ p += 4;
+ if (ULONG_LE(p) != 0) {
+ WARN("Not a BMP file???");
+ return -1;
+ }
+ p += 4;
+ offset = ULONG_LE(p); p += 4;
+
+ /* info header */
+ hsize = ULONG_LE(p); p += 4;
+ if (fread(p, sizeof(char), hsize - 4, fp) != hsize - 4) {
+ WARN("Could not read BMP file header...");
+ return -1;
+ }
+ if (hsize == DIB_CORE_HEADER_SIZE) {
+ info->width = USHORT_LE(p); p += 2;
+ info->height = USHORT_LE(p); p += 2;
+ info->xdpi = 72.0; /* assume 72 DPI */
+ info->ydpi = 72.0; /* assume 72 DPI */
+ if (USHORT_LE(p) != 1) {
+ WARN("Unknown bcPlanes value in BMP COREHEADER.");
+ return -1;
+ }
+ p += 2;
+ bit_count = USHORT_LE(p); p += 2;
+ psize = 3;
+ } else if (hsize == DIB_INFO_HEADER_SIZE ||
+ hsize == DIB_INFO_HEADER_SIZE2 ||
+ hsize == DIB_INFO_HEADER_SIZE4 ||
+ hsize == DIB_INFO_HEADER_SIZE5) {
+ info->width = ULONG_LE(p); p += 4;
+ info->height = ULONG_LE(p); p += 4;
+ if (USHORT_LE(p) != 1) {
+ WARN("Unknown biPlanes value in BMP INFOHEADER.");
+ return -1;
+ }
+ p += 2;
+ bit_count = USHORT_LE(p); p += 2;
+ /* ignore compression */ p += 4;
+ /* ignore biSizeImage */ p += 4;
+ biXPelsPerMeter = ULONG_LE(p); p += 4;
+ biYPelsPerMeter = ULONG_LE(p); p += 4;
+ info->xdpi = biXPelsPerMeter * 0.0254; /* convert pixels per meter to DPI */
+ info->ydpi = biYPelsPerMeter * 0.0254;
+ if (info->height < 0) {
+ info->height = -info->height;
+ }
+ psize = 4;
+ } else {
+ fprintf (stderr, "Unknown BMP header type.\n");
+ exit (1);
+ return -1; /* never reaches here */
+ }
+
+ if (bit_count < 24) {
+ if (bit_count != 1 &&
+ bit_count != 4 && bit_count != 8) {
+ WARN("Unsupported palette size: %ld", bit_count);
+ return -1;
+ }
+ num_palette = (offset - hsize - DIB_FILE_HEADER_SIZE) / psize;
+ info->bits_per_component = bit_count;
+ info->num_components = 1;
+ } else if (bit_count == 24) { /* full color */
+ num_palette = 1; /* dummy */
+ info->bits_per_component = 8;
+ info->num_components = 3;
+ } else {
+ WARN("Unkown BMP bitCount: %ld", bit_count);
+ return -1;
+ }
+
+ if (info->width == 0 || info->height == 0 || num_palette < 1) {
+ WARN("Invalid BMP file: width=%ld, height=%ld, #palette=%d",
+ info->width, info->height, num_palette);
+ return -1;
+ }
+
+ return 0;
+}
+
diff --git a/Build/source/texk/web2c/xetexdir/image/bmpimage.h b/Build/source/texk/web2c/xetexdir/image/bmpimage.h
new file mode 100644
index 00000000000..c9f8b5b7c50
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/bmpimage.h
@@ -0,0 +1,67 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2006 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* $Header: /home/cvsroot/dvipdfmx/src/bmpimage.h,v 1.1 2004/07/25 11:54:20 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>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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 _BMPIMAGE_H_
+#define _BMPIMAGE_H_
+
+#include "mfileio.h"
+
+struct bmp_info {
+ int width;
+ int height;
+ double xdpi;
+ double ydpi;
+ int bits_per_component;
+ int num_components;
+};
+
+extern int bmp_scan_file(struct bmp_info *info, FILE *file);
+extern int check_for_bmp(FILE *file);
+
+#endif /* _BMPIMAGE_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/image/jpegimage.c b/Build/source/texk/web2c/xetexdir/image/jpegimage.c
new file mode 100644
index 00000000000..6b43fae194c
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/jpegimage.c
@@ -0,0 +1,504 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2017 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+ Copyright (C) 2002-2017 by Jin-Hwan Cho and Shunsaku Hirata,
+ the dvipdfmx project team.
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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.
+*/
+
+/*
+ * JPEG SUPPORT
+ *
+ * Accroding to Libjpeg document:
+ *
+ * CAUTION: it appears that Adobe Photoshop writes inverted data in CMYK
+ * JPEG files: 0 represents 100% ink coverage, rather than 0% ink as you'd
+ * expect....
+ *
+ * To wrok with this problem, we must detect whether CMYK JPEG file is
+ * created by Photoshop. But there are no reliable way to determine this.
+ *
+ * According to Adobe Technical Note #5516,
+ * "Supporting the DCT Filters in PostScript Level 2", Section 18, p.27.
+ *
+ * DCTDecode ignores and skips any APPE marker segment does not begin with
+ * the `Adobe' 5-character string.
+ *
+ * PDF Reference Manual 4th ed., p.61-62.
+ *
+ * The JPEG filter implementation in Adobe Acrobat products does not
+ * support features of the JPEG standard that are irrelevant to images.
+ * In addition, certain choices have been made regarding reserved marker
+ * codes and other optional features of the standard. For details, see
+ * Adobe Technical Note #5116, Supporting the DCT Filters in PostScript
+ * Level 2.
+ */
+
+#if HAVE_CONFIG_H
+#include <w2c/config.h>
+#endif
+
+#include "mfileio.h"
+#include "numbers.h"
+#include "jpegimage.h"
+
+#define JPEG_DEBUG_STR "JPEG"
+#define JPEG_DEBUG 3
+
+#define HAVE_APPn_JFIF (1 << 0)
+#define HAVE_APPn_ADOBE (1 << 1)
+#define HAVE_APPn_ICC (1 << 2)
+#define HAVE_APPn_Exif (1 << 3)
+
+#define RELEASE(p) free(p)
+#define NEW(n, t) (t*)xmalloc(n * sizeof(t))
+#define RENEW(p, n, t) ((p) ? (t*)xrealloc(p, (n) * sizeof(t)) : NEW(n, t))
+
+int
+check_for_jpeg (FILE *fp)
+{
+ unsigned char jpeg_sig[2];
+
+ rewind(fp);
+ if (fread(jpeg_sig, sizeof(unsigned char), 2, fp) != 2)
+ return 0;
+ else if (jpeg_sig[0] != 0xff || jpeg_sig[1] != JM_SOI)
+ return 0;
+
+ return 1;
+}
+
+static void
+JPEG_info_init (struct JPEG_info *j_info)
+{
+ j_info->width = 0;
+ j_info->height = 0;
+ j_info->bits_per_component = 0;
+ j_info->num_components = 0;
+
+ j_info->xdpi = 0.0;
+ j_info->ydpi = 0.0;
+
+ j_info->flags = 0;
+ j_info->num_appn = 0;
+ j_info->max_appn = 0;
+ j_info->appn = NULL;
+
+ memset(j_info->skipbits, 0, MAX_COUNT / 8 + 1);
+}
+
+static JPEG_marker
+JPEG_get_marker (FILE *fp)
+{
+ int c;
+
+ c = fgetc(fp);
+ if (c != 255)
+ return -1;
+
+ for (;;) {
+ c = fgetc(fp);
+ if (c < 0)
+ return -1;
+ else if (c > 0 && c < 255) {
+ return c;
+ }
+ }
+
+ return -1;
+}
+
+static int
+add_APPn_marker (struct JPEG_info *j_info,
+ JPEG_marker marker, int app_sig, void *app_data)
+{
+ int n;
+
+ if (j_info->num_appn >= j_info->max_appn) {
+ j_info->max_appn += 16;
+ j_info->appn = RENEW(j_info->appn, j_info->max_appn, struct JPEG_ext);
+ }
+ n = j_info->num_appn;
+
+ j_info->appn[n].marker = marker;
+ j_info->appn[n].app_sig = app_sig;
+ j_info->appn[n].app_data = app_data;
+
+ j_info->num_appn += 1;
+
+ return n;
+}
+
+static unsigned short
+read_APP14_Adobe (struct JPEG_info *j_info, FILE *fp)
+{
+ struct JPEG_APPn_Adobe *app_data;
+
+ app_data = NEW(1, struct JPEG_APPn_Adobe);
+ app_data->version = get_unsigned_pair(fp);
+ app_data->flag0 = get_unsigned_pair(fp);
+ app_data->flag1 = get_unsigned_pair(fp);
+ app_data->transform = get_unsigned_byte(fp);
+
+ add_APPn_marker(j_info, JM_APP14, JS_APPn_ADOBE, app_data);
+
+ return 7;
+}
+
+static unsigned int
+read_exif_bytes(unsigned char **p, int n, int b)
+{
+ unsigned int rval = 0;
+ unsigned char *pp = *p;
+ if (b) {
+ switch (n) {
+ case 4:
+ rval += *pp++; rval <<= 8;
+ rval += *pp++; rval <<= 8;
+ case 2:
+ rval += *pp++; rval <<= 8;
+ rval += *pp;
+ break;
+ }
+ }
+ else {
+ pp += n;
+ switch (n) {
+ case 4:
+ rval += *--pp; rval <<= 8;
+ rval += *--pp; rval <<= 8;
+ case 2:
+ rval += *--pp; rval <<= 8;
+ rval += *--pp;
+ break;
+ }
+ }
+ *p += n;
+ return rval;
+}
+
+static unsigned short
+read_APP1_Exif (struct JPEG_info *j_info, FILE *fp, unsigned short length)
+{
+ /* this doesn't save the data, just reads the tags we need */
+ /* based on info from http://www.exif.org/Exif2-2.PDF */
+ unsigned char *buffer = NEW(length, unsigned char);
+ unsigned char *p, *rp;
+ unsigned char *tiff_header;
+ char bigendian;
+ int i;
+ int num_fields, tag, type;
+ int value = 0, num = 0, den = 0; /* silence uninitialized warnings */
+ double xres = 72.0;
+ double yres = 72.0;
+ double res_unit = 1.0;
+ fread(buffer, length, 1, fp);
+ p = buffer;
+ while ((p < buffer + length) && (*p == 0))
+ ++p;
+ tiff_header = p;
+ if ((*p == 'M') && (*(p+1) == 'M'))
+ bigendian = 1;
+ else if ((*p == 'I') && (*(p+1) == 'I'))
+ bigendian = 0;
+ else
+ goto err;
+ p += 2;
+ i = read_exif_bytes(&p, 2, bigendian);
+ if (i != 42)
+ goto err;
+ i = read_exif_bytes(&p, 4, bigendian);
+ p = tiff_header + i;
+ num_fields = read_exif_bytes(&p, 2, bigendian);
+ while (num_fields-- > 0) {
+ tag = read_exif_bytes(&p, 2, bigendian);
+ type = read_exif_bytes(&p, 2, bigendian);
+ (void)read_exif_bytes(&p, 4, bigendian);
+ switch (type) {
+ case 1: /* byte */
+ value = *p++;
+ p += 3;
+ break;
+ case 3: /* short */
+ value = read_exif_bytes(&p, 2, bigendian);
+ p += 2;
+ break;
+ case 4: /* long */
+ case 9: /* slong */
+ value = read_exif_bytes(&p, 4, bigendian);
+ break;
+ case 5: /* rational */
+ case 10: /* srational */
+ value = read_exif_bytes(&p, 4, bigendian);
+ rp = tiff_header + value;
+ num = read_exif_bytes(&rp, 4, bigendian);
+ den = read_exif_bytes(&rp, 4, bigendian);
+ break;
+ case 7: /* undefined */
+ value = *p++;
+ p += 3;
+ break;
+ case 2: /* ascii */
+ default:
+ p += 4;
+ break;
+ }
+ switch (tag) {
+ case 282: /* x res */
+ if (den != 0)
+ xres = num / den;
+ break;
+ case 283: /* y res */
+ if (den != 0)
+ yres = num / den;
+ break;
+ case 296: /* res unit */
+ switch (value) {
+ case 2:
+ res_unit = 1.0;
+ break;
+ case 3:
+ res_unit = 2.54;
+ break;
+ }
+ }
+ }
+/*
+ Do not overwrite if j_info->xdpi and j_info->ydpi are
+ already determined as JFIF
+*/
+ if (j_info->xdpi < 0.1 && j_info->ydpi < 0.1) {
+ j_info->xdpi = xres * res_unit;
+ j_info->ydpi = yres * res_unit;
+ }
+
+err:
+ RELEASE(buffer);
+ return length;
+}
+
+static unsigned short
+read_APP0_JFIF (struct JPEG_info *j_info, FILE *fp)
+{
+ struct JPEG_APPn_JFIF *app_data;
+ unsigned short thumb_data_len;
+
+ app_data = NEW(1, struct JPEG_APPn_JFIF);
+ app_data->version = get_unsigned_pair(fp);
+ app_data->units = get_unsigned_byte(fp);
+ app_data->Xdensity = get_unsigned_pair(fp);
+ app_data->Ydensity = get_unsigned_pair(fp);
+ app_data->Xthumbnail = get_unsigned_byte(fp);
+ app_data->Ythumbnail = get_unsigned_byte(fp);
+ thumb_data_len = 3 * app_data->Xthumbnail * app_data->Ythumbnail;
+ if (thumb_data_len > 0) {
+ app_data->thumbnail = NEW(thumb_data_len, unsigned char);
+ fread(app_data->thumbnail, 1, thumb_data_len, fp);
+ } else {
+ app_data->thumbnail = NULL;
+ }
+
+ add_APPn_marker(j_info, JM_APP0, JS_APPn_JFIF, app_data);
+
+ switch (app_data->units) {
+ case 1:
+ j_info->xdpi = app_data->Xdensity;
+ j_info->ydpi = app_data->Ydensity;
+ break;
+ case 2: /* density is in pixels per cm */
+ j_info->xdpi = app_data->Xdensity * 2.54;
+ j_info->ydpi = app_data->Ydensity * 2.54;
+ break;
+ default: /* FIXME: not sure what to do with this.... */
+ j_info->xdpi = 72.0;
+ j_info->ydpi = 72.0;
+ break;
+ }
+
+ return (9 + thumb_data_len);
+}
+
+static unsigned short
+read_APP0_JFXX (FILE *fp, unsigned short length)
+{
+ (void)get_unsigned_byte(fp);
+ /* Extension Code:
+ *
+ * 0x10: Thumbnail coded using JPEG
+ * 0x11: Thumbnail stored using 1 byte/pixel
+ * 0x13: Thumbnail stored using 3 bytes/pixel
+ */
+ seek_relative(fp, length-1); /* Thunbnail image */
+
+ /* Ignore */
+
+ return length;
+}
+
+static unsigned short
+read_APP2_ICC (struct JPEG_info *j_info, FILE *fp, unsigned short length)
+{
+ struct JPEG_APPn_ICC *app_data;
+
+ app_data = NEW(1, struct JPEG_APPn_ICC);
+ app_data->seq_id = get_unsigned_byte(fp); /* Starting at 1 */
+ app_data->num_chunks = get_unsigned_byte(fp);
+ app_data->length = length - 2;
+ app_data->chunk = NEW(app_data->length, unsigned char);
+ fread(app_data->chunk, 1, app_data->length, fp);
+
+ add_APPn_marker(j_info, JM_APP2, JS_APPn_ICC, app_data);
+
+ return length;
+}
+
+int
+JPEG_scan_file (struct JPEG_info *j_info, FILE *fp)
+{
+ JPEG_marker marker;
+ unsigned short length;
+ int found_SOFn, count;
+ char app_sig[128];
+
+ JPEG_info_init(j_info);
+
+ rewind(fp);
+ count = 0;
+ found_SOFn = 0;
+ while (!found_SOFn &&
+ (marker = JPEG_get_marker(fp)) != (JPEG_marker) -1) {
+ if (marker == JM_SOI ||
+ (marker >= JM_RST0 && marker <= JM_RST7)) {
+ count++;
+ continue;
+ }
+ length = get_unsigned_pair(fp) - 2;
+ switch (marker) {
+ case JM_SOF0: case JM_SOF1: case JM_SOF2: case JM_SOF3:
+ case JM_SOF5: case JM_SOF6: case JM_SOF7: case JM_SOF9:
+ case JM_SOF10: case JM_SOF11: case JM_SOF13: case JM_SOF14:
+ case JM_SOF15:
+ j_info->bits_per_component = get_unsigned_byte(fp);
+ j_info->height = get_unsigned_pair(fp);
+ j_info->width = get_unsigned_pair(fp);
+ j_info->num_components = get_unsigned_byte(fp);
+ found_SOFn = 1;
+ break;
+ case JM_APP0:
+ if (length > 5) {
+ if (fread(app_sig, sizeof(char), 5, fp) != 5)
+ return -1;
+ length -= 5;
+ if (!memcmp(app_sig, "JFIF\000", 5)) {
+ j_info->flags |= HAVE_APPn_JFIF;
+ length -= read_APP0_JFIF(j_info, fp);
+ } else if (!memcmp(app_sig, "JFXX", 5)) {
+ length -= read_APP0_JFXX(fp, length);
+ }
+ }
+ seek_relative(fp, length);
+ break;
+ case JM_APP1:
+ if (length > 5) {
+ if (fread(app_sig, sizeof(char), 5, fp) != 5)
+ return -1;
+ length -= 5;
+ if (!memcmp(app_sig, "Exif\000", 5)) {
+ j_info->flags |= HAVE_APPn_Exif;
+ length -= read_APP1_Exif(j_info, fp, length);
+ }
+ }
+ seek_relative(fp, length);
+ break;
+ case JM_APP2:
+ if (length >= 14) {
+ if (fread(app_sig, sizeof(char), 12, fp) != 12)
+ return -1;
+ length -= 12;
+ if (!memcmp(app_sig, "ICC_PROFILE\000", 12)) {
+ j_info->flags |= HAVE_APPn_ICC;
+ length -= read_APP2_ICC(j_info, fp, length);
+ if (count < MAX_COUNT) {
+ j_info->skipbits[count / 8] |= (1 << (7 - (count % 8)));
+ }
+ }
+ }
+ seek_relative(fp, length);
+ break;
+ case JM_APP14:
+ if (length > 5) {
+ if (fread(app_sig, sizeof(char), 5, fp) != 5)
+ return -1;
+ length -= 5;
+ if (!memcmp(app_sig, "Adobe", 5)) {
+ j_info->flags |= HAVE_APPn_ADOBE;
+ length -= read_APP14_Adobe(j_info, fp);
+ } else {
+ if (count < MAX_COUNT) {
+ j_info->skipbits[count/8] |= (1 << (7 - (count % 8)));
+ }
+ }
+ }
+ seek_relative(fp, length);
+ break;
+ default:
+ seek_relative(fp, length);
+ if (marker >= JM_APP0 &&
+ marker <= JM_APP15) {
+ if (count < MAX_COUNT) {
+ j_info->skipbits[count / 8] |= (1 << (7 - (count % 8)));
+ }
+ }
+ break;
+ }
+ count++;
+ }
+
+/*
+ * If j_info->xdpi, and j_info->ydpi are not yet determined,
+ * they are assumed to be 72.0 to avoid division by zero.
+ */
+ if (j_info->xdpi < 0.1 && j_info->ydpi < 0.1) {
+ j_info->xdpi = j_info->ydpi = 72.0;
+ }
+
+ return (found_SOFn ? 0 : -1);
+}
diff --git a/Build/source/texk/web2c/xetexdir/image/jpegimage.h b/Build/source/texk/web2c/xetexdir/image/jpegimage.h
new file mode 100644
index 00000000000..432cef96546
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/jpegimage.h
@@ -0,0 +1,168 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2006 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* $Header: /home/cvsroot/dvipdfmx/src/jpegimage.h,v 1.2 2004/03/11 11:50:21 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>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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 _JPEGIMAGE_H_
+#define _JPEGIMAGE_H_
+
+#include "mfileio.h"
+
+/* JPEG Markers */
+typedef enum {
+ JM_SOF0 = 0xc0,
+ JM_SOF1 = 0xc1,
+ JM_SOF2 = 0xc2,
+ JM_SOF3 = 0xc3,
+ JM_SOF5 = 0xc5,
+ JM_DHT = 0xc4,
+ JM_SOF6 = 0xc6,
+ JM_SOF7 = 0xc7,
+ JM_SOF9 = 0xc9,
+ JM_SOF10 = 0xca,
+ JM_SOF11 = 0xcb,
+ JM_DAC = 0xcc,
+ JM_SOF13 = 0xcd,
+ JM_SOF14 = 0xce,
+ JM_SOF15 = 0xcf,
+
+ JM_RST0 = 0xd0,
+ JM_RST1 = 0xd1,
+ JM_RST2 = 0xd2,
+ JM_RST3 = 0xd3,
+ JM_RST4 = 0xd4,
+ JM_RST5 = 0xd5,
+ JM_RST6 = 0xd6,
+ JM_RST7 = 0xd7,
+
+ JM_SOI = 0xd8,
+ JM_EOI = 0xd9,
+ JM_SOS = 0xda,
+ JM_DQT = 0xdb,
+ JM_DNL = 0xdc,
+ JM_DRI = 0xdd,
+ JM_DHP = 0xde,
+ JM_EXP = 0xdf,
+
+ JM_APP0 = 0xe0,
+ JM_APP1 = 0xe1,
+ JM_APP2 = 0xe2,
+ JM_APP14 = 0xee,
+ JM_APP15 = 0xef,
+
+ JM_COM = 0xfe
+} JPEG_marker;
+
+typedef enum {
+ JS_APPn_JFIF,
+ JS_APPn_ADOBE,
+ JS_APPn_ICC
+} JPEG_APPn_sig;
+
+struct JPEG_APPn_JFIF /* APP0 */
+{
+ unsigned short version;
+ unsigned char units; /* 0: only aspect ratio
+ * 1: dots per inch
+ * 2: dots per cm
+ */
+ unsigned short Xdensity;
+ unsigned short Ydensity;
+ unsigned char Xthumbnail;
+ unsigned char Ythumbnail;
+ unsigned char *thumbnail; /* Thumbnail data. */
+};
+
+struct JPEG_APPn_ICC /* APP2 */
+{
+ unsigned char seq_id;
+ unsigned char num_chunks;
+ unsigned char *chunk;
+
+ /* Length of ICC profile data in this chunk. */
+ unsigned short length;
+};
+
+struct JPEG_APPn_Adobe /* APP14 */
+{
+ unsigned short version;
+ unsigned short flag0;
+ unsigned short flag1;
+ unsigned char transform; /* color transform code */
+};
+
+struct JPEG_ext
+{
+ JPEG_marker marker;
+ JPEG_APPn_sig app_sig;
+ void *app_data;
+};
+
+#define MAX_COUNT 1024
+struct JPEG_info
+{
+ unsigned short height;
+ unsigned short width;
+
+ unsigned char bits_per_component;
+ unsigned char num_components;
+
+ double xdpi;
+ double ydpi;
+
+ /* Application specific extensions */
+ int flags;
+ int num_appn, max_appn;
+ struct JPEG_ext *appn;
+
+ /* Skip chunks not necessary. */
+ char skipbits[MAX_COUNT / 8 + 1];
+};
+
+extern int check_for_jpeg(FILE *fp);
+extern int JPEG_scan_file(struct JPEG_info *info, FILE *fp);
+
+#endif /* _JPEGIMAGE_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/image/mfileio.c b/Build/source/texk/web2c/xetexdir/image/mfileio.c
new file mode 100644
index 00000000000..bcfa4ce1deb
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/mfileio.c
@@ -0,0 +1,128 @@
+/* $Header: /home/cvsroot/dvipdfmx/src/mfileio.c,v 1.3 2002/10/30 02:27:11 chofchof Exp $
+
+ This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+ Copyright (C) 2002-2015 by Jin-Hwan Cho and Shunsaku Hirata,
+ the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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.
+*/
+
+#if HAVE_CONFIG_H
+#include <w2c/config.h>
+#endif
+
+#include "mfileio.h"
+
+#ifdef IODEBUG
+static FILE *iodebug_file = NULL;
+static long event = 0;
+static void io_debug_init(void)
+{
+ if (!iodebug_file) {
+ iodebug_file = fopen ("fopen.log", "wb");
+ fprintf (stderr, "\n*** File IO debugging started ***\n");
+ }
+ if (!iodebug_file) {
+ fprintf (stderr, "\nError opening io log\n");
+ }
+}
+#endif
+
+#ifdef IODEBUG
+FILE *mfopen(const char *name, const char *mode, const char *function, int line)
+{
+ FILE *tmp;
+ io_debug_init();
+ tmp = fopen (name, mode);
+ event += 1;
+ fprintf(iodebug_file, "%p %07ld [fopen] %s:%d\n", tmp, event,
+ function, line);
+ return tmp;
+}
+int mfclose(FILE *file, const char *function, int line)
+{
+ io_debug_init();
+ event += 1;
+ fprintf(iodebug_file, "%p %07ld [fclose] %s:%d\n", file, event,
+ function, line);
+ return fclose(file);
+}
+#endif
+
+static void os_error(void)
+{
+ fprintf (stderr, "io: An OS command failed that should not have.\n");
+ exit(-1);
+}
+
+void seek_absolute (FILE *file, long pos)
+{
+ if (fseek(file, pos, SEEK_SET)) {
+ os_error();
+ }
+}
+
+void seek_relative (FILE *file, long pos)
+{
+ if (fseek(file, pos, SEEK_CUR)) {
+ os_error();
+ }
+}
+
+
+void seek_end (FILE *file)
+{
+ if (fseek(file, 0L, SEEK_END)) {
+ os_error();
+ }
+}
+
+long tell_position (FILE *file)
+{
+ long size;
+ if ((size = ftell (file)) < 0) {
+ os_error();
+ }
+ return size;
+}
+
+long file_size (FILE *file)
+{
+ long size;
+ /* Seek to end */
+ seek_end (file);
+ size = tell_position (file);
+ rewind (file);
+ return (size);
+}
+
+/* Unlike fgets, mfgets works with \r, \n, or \r\n end of lines. */
+char *mfgets (char *buffer, int length, FILE *file)
+{
+ int ch = 0, i = 0;
+ while (i < length-1 && (ch = fgetc (file)) >= 0 && ch != '\n' && ch != '\r')
+ buffer[i++] = ch;
+ buffer[i] = 0;
+ if (ch < 0 && i == 0)
+ return NULL;
+ if (ch == '\r' && (ch = fgetc (file)) >= 0 && (ch != '\n'))
+ ungetc (ch, file);
+ return buffer;
+}
+
+char work_buffer[WORK_BUFFER_SIZE];
diff --git a/Build/source/texk/web2c/xetexdir/image/mfileio.h b/Build/source/texk/web2c/xetexdir/image/mfileio.h
new file mode 100644
index 00000000000..1081120c356
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/mfileio.h
@@ -0,0 +1,59 @@
+/* $Header: /home/cvsroot/dvipdfmx/src/mfileio.h,v 1.3 2002/10/30 02:27:12 chofchof Exp $
+
+ This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+ Copyright (C) 2002-2015 by Jin-Hwan Cho and Shunsaku Hirata,
+ the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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 _MFILEIO_H_
+#define _MFILEIO_H_
+
+#include <stdio.h>
+#include "numbers.h"
+
+#ifdef IODEBUG
+FILE *mfopen (const char *name, const char *mode,
+ const char *function, int line);
+int mfclose (FILE *file, const char *function, int line);
+#define MFOPEN(name,mode) \
+ mfopen((name),(mode),__FUNCTION__,__LINE__)
+#define MFCLOSE(file) \
+ mfclose((file),__FUNCTION__,__LINE__)
+#else
+#define MFOPEN(name,mode) fopen((name),(mode))
+#define MFCLOSE(file) fclose(file)
+#endif
+
+extern void seek_absolute (FILE *file, long pos);
+extern void seek_relative (FILE *file, long pos);
+
+extern void seek_end (FILE *file);
+
+extern long tell_position (FILE *file);
+
+extern long file_size (FILE *file);
+
+extern char *mfgets (char *buffer, int length, FILE *file);
+
+extern char work_buffer[];
+
+#define WORK_BUFFER_SIZE 1024
+
+#endif /* _MFILEIO_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/image/numbers.c b/Build/source/texk/web2c/xetexdir/image/numbers.c
new file mode 100644
index 00000000000..53a3ff76460
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/numbers.c
@@ -0,0 +1,47 @@
+/* $Header: /home/cvsroot/dvipdfmx/src/numbers.c,v 1.8 2004/03/03 13:19:00 hirata Exp $
+
+ This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+ Copyright (C) 2002-2015 by Jin-Hwan Cho and Shunsaku Hirata,
+ the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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.
+*/
+
+#if HAVE_CONFIG_H
+#include <w2c/config.h>
+#endif
+
+#include "mfileio.h"
+#include "numbers.h"
+
+unsigned char get_unsigned_byte (FILE *file)
+{
+ int ch;
+ if ((ch = fgetc (file)) < 0) {
+ fprintf (stderr, "File ended prematurely\n");
+ exit(-1);
+ }
+ return (unsigned char) ch;
+}
+
+unsigned short get_unsigned_pair (FILE *file)
+{
+ unsigned short pair = get_unsigned_byte(file);
+ pair = pair*0x100u + get_unsigned_byte(file);
+ return pair;
+}
diff --git a/Build/source/texk/web2c/xetexdir/image/numbers.h b/Build/source/texk/web2c/xetexdir/image/numbers.h
new file mode 100644
index 00000000000..b7fb124e5ef
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/numbers.h
@@ -0,0 +1,59 @@
+/* $Header: /home/cvsroot/dvipdfmx/src/numbers.h,v 1.9 2005/07/20 10:41:54 hirata Exp $
+
+ This is dvipdfmx, an eXtended version of dvipdfm by Mark A. Wicks.
+
+ Copyright (C) 2002-2015 by Jin-Hwan Cho and Shunsaku Hirata,
+ the dvipdfmx project team <dvipdfmx@project.ktug.or.kr>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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 _NUMBERS_H_
+#define _NUMBERS_H_
+
+#include <stdio.h>
+#include <math.h>
+
+extern unsigned char get_unsigned_byte (FILE *);
+extern unsigned short get_unsigned_pair (FILE *);
+
+#ifndef MAX
+# define MAX(a,b) ((a)>(b)?(a):(b))
+#endif
+#ifndef MIN
+# define MIN(a,b) ((a)<(b)?(a):(b))
+#endif
+#define ISODD(n) (((n)/2)*2!=(n))
+#define ISEVEN(n) (((n)/2)*2==(n))
+
+#define ROUND(n,acc) (floor(((double)n)/(acc)+0.5)*(acc))
+
+#if defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+# define __C99__
+#endif
+
+#ifndef __C99__
+# ifndef round
+# define round(v) (floor((v) + 0.5))
+# endif
+# ifndef trunc
+# define trunc(v) ((v) > 0.0 ? floor((v)) : ceil((v)))
+# endif
+#endif
+#define round_at(v,acc) (round(((double)(v))/(acc))*(acc))
+
+#endif /* _NUMBERS_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/image/pngimage.c b/Build/source/texk/web2c/xetexdir/image/pngimage.c
new file mode 100644
index 00000000000..ee5f2212581
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/pngimage.c
@@ -0,0 +1,164 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2006 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* $Header: /home/cvsroot/dvipdfmx/src/pngimage.c,v 1.24 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>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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.
+*/
+
+#if HAVE_CONFIG_H
+#include <w2c/config.h>
+#endif
+
+/*
+ * PNG SUPPORT
+ *
+ * All bitdepth less than 16 is supported.
+ * Supported color types are: PALETTE, RGB, GRAY, RGB_ALPHA, GRAY_ALPHA.
+ * Supported ancillary chunks: tRNS, cHRM + gAMA, (sRGB), (iCCP)
+ *
+ * gAMA support is available only when cHRM exists. cHRM support is not
+ * tested well. CalRGB/CalGray colorspace is used for PNG images that
+ * have cHRM chunk (but not sRGB).
+ *
+ * LIMITATIONS
+ *
+ * Recent version of PDF (>= 1.5) support 16 bpc, but 16 bit bitdepth PNG
+ * images are automatically converted to 8 bit bitpedth image.
+ *
+ * TODO
+ *
+ * sBIT ? iTXT, tEXT and tIME as MetaData ?, pHYS (see below)
+ * 16 bpc support for PDF-1.5. JBIG compression for monochrome image.
+ * Predictor for deflate ?
+ */
+
+#define PNG_DEBUG_STR "PNG"
+#define PNG_DEBUG 3
+
+/*
+ * Write, MNG, Progressive not required.
+ */
+#define PNG_NO_WRITE_SUPPORTED
+#define PNG_NO_MNG_FEATURES
+#define PNG_NO_PROGRESSIVE_READ
+#if 0
+/* 16_TO_8 required. */
+#define PNG_NO_READ_TRANSFORMS
+#endif
+
+#include <png.h>
+#include "pngimage.h"
+
+#define PDF_TRANS_TYPE_NONE 0
+#define PDF_TRANS_TYPE_BINARY 1
+#define PDF_TRANS_TYPE_ALPHA 2
+
+static void warn(png_structp png_ptr, png_const_charp msg)
+{
+ (void)png_ptr; (void)msg; /* Make compiler happy */
+}
+
+int
+check_for_png (FILE *png_file)
+{
+ unsigned char sigbytes[4];
+
+ rewind (png_file);
+ if (fread (sigbytes, 1, sizeof(sigbytes), png_file) !=
+ sizeof(sigbytes) ||
+ (png_sig_cmp (sigbytes, 0, sizeof(sigbytes))))
+ return 0;
+ else
+ return 1;
+}
+
+int
+png_scan_file (struct png_info *info, FILE *png_file)
+{
+ /* Libpng stuff */
+ png_structp png_ptr;
+ png_infop png_info_ptr;
+ png_byte bpc;
+ png_uint_32 width, height;
+
+ rewind (png_file);
+ png_ptr = png_create_read_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, warn);
+ if (png_ptr == NULL ||
+ (png_info_ptr = png_create_info_struct (png_ptr)) == NULL) {
+ fprintf(stderr, "WARNING: %s: Creating Libpng read/info struct failed.", PNG_DEBUG_STR);
+ if (png_ptr)
+ png_destroy_read_struct(&png_ptr, NULL, NULL);
+ return -1;
+ }
+
+ /* Inititializing file IO. */
+ png_init_io (png_ptr, png_file);
+
+ /* Read PNG info-header and get some info. */
+ png_read_info(png_ptr, png_info_ptr);
+ width = png_get_image_width (png_ptr, png_info_ptr);
+ height = png_get_image_height(png_ptr, png_info_ptr);
+ bpc = png_get_bit_depth (png_ptr, png_info_ptr);
+
+ info->xdpi = png_get_x_pixels_per_meter(png_ptr, png_info_ptr) * 0.0254;
+ info->ydpi = png_get_y_pixels_per_meter(png_ptr, png_info_ptr) * 0.0254;
+
+ if (info->xdpi == 0)
+ info->xdpi = 72;
+ if (info->ydpi == 0)
+ info->ydpi = 72;
+
+ /* Values listed below will not be modified in the remaining process. */
+ info->width = width;
+ info->height = height;
+ info->bits_per_component = bpc;
+
+ /* Cleanup */
+ if (png_info_ptr)
+ png_destroy_info_struct(png_ptr, &png_info_ptr);
+ if (png_ptr)
+ png_destroy_read_struct(&png_ptr, NULL, NULL);
+
+ return 0;
+}
diff --git a/Build/source/texk/web2c/xetexdir/image/pngimage.h b/Build/source/texk/web2c/xetexdir/image/pngimage.h
new file mode 100644
index 00000000000..3286ea6ace5
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/image/pngimage.h
@@ -0,0 +1,67 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2006 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+ 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.
+\****************************************************************************/
+
+/* this file is derived from the dvipdfmx project;
+ the original header follows... */
+
+/* $Header: /home/cvsroot/dvipdfmx/src/pngimage.h,v 1.4 2004/03/11 11:50:25 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>
+
+ Copyright (C) 1998, 1999 by Mark A. Wicks <mwicks@kettering.edu>
+
+ 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 _PNGIMAGE_H_
+#define _PNGIMAGE_H_
+
+#include "mfileio.h"
+
+struct png_info {
+ int width;
+ int height;
+ double xdpi;
+ double ydpi;
+ int bits_per_component;
+ int num_components;
+};
+
+extern int png_scan_file (struct png_info *info, FILE *file);
+extern int check_for_png (FILE *file);
+
+#endif /* _PNGIMAGE_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/pdfimage.cpp b/Build/source/texk/web2c/xetexdir/pdfimage.cpp
new file mode 100644
index 00000000000..38d51d1ce61
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/pdfimage.cpp
@@ -0,0 +1,161 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2018 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include <w2c/config.h>
+
+#include "XeTeX_ext.h"
+
+#include "pdfimage.h"
+
+/*
+ * From TeX Live 2021, we use pplib by Pawe\l Jackowski instead of
+ * libpoppler
+ */
+extern "C" {
+#include "ppapi.h"
+}
+
+#include "XeTeX_ext.h"
+
+/* use our own fmin function because it seems to be missing on certain platforms */
+inline double
+my_fmin(double x, double y)
+{
+ return (x < y) ? x : y;
+}
+
+int
+pdf_get_rect(char* filename, int page_num, int pdf_box, realrect* box)
+ /* return the box converted to TeX points */
+{
+ ppdoc* doc = ppdoc_load(filename);
+
+ if (!doc) {
+ return -1;
+ }
+
+ int pages = ppdoc_page_count(doc);
+
+ if (page_num > pages)
+ page_num = pages;
+ if (page_num < 0)
+ page_num = pages + 1 + page_num;
+ if (page_num < 1)
+ page_num = 1;
+
+ ppref* page = ppdoc_page(doc, page_num);
+ ppdict* pdict = page->object.dict;
+
+ pprect Rect;
+ pprect* r;
+
+ switch (pdf_box) {
+ default:
+ case pdfbox_crop:
+ r = ppdict_get_box(pdict, "CropBox", &Rect);
+ break;
+ case pdfbox_media:
+ r = ppdict_get_box(pdict, "MediaBox", &Rect);
+ break;
+ case pdfbox_bleed:
+ r = ppdict_get_box(pdict, "BleedBox", &Rect);
+ break;
+ case pdfbox_trim:
+ r = ppdict_get_box(pdict, "TrimBox", &Rect);
+ break;
+ case pdfbox_art:
+ r = ppdict_get_box(pdict, "ArtBox", &Rect);
+ break;
+ }
+
+/*
+ * In pplib, r can be NULL. If r == NULL, we try "CropBox",
+ * "MediaBox", "BleedBox", "TrimBox", "ArtBox" in this order.
+ */
+ if (!r) {
+ r = ppdict_get_box(pdict, "CropBox", &Rect);
+ }
+ if (!r) {
+ r = ppdict_get_box(pdict, "MediaBox", &Rect);
+ }
+ if (!r) {
+ r = ppdict_get_box(pdict, "BleedBox", &Rect);
+ }
+ if (!r) {
+ r = ppdict_get_box(pdict, "TrimBox", &Rect);
+ }
+ if (!r) {
+ r = ppdict_get_box(pdict, "ArtBox", &Rect);
+ }
+
+/*
+ * If r == NULL, return error.
+ */
+ if (!r) {
+ return -1;
+ }
+
+ ppint RotAngle = 0;
+ (void)ppdict_get_int(pdict, "Rotate", &RotAngle);
+ RotAngle = RotAngle % 360;
+ if (RotAngle < 0)
+ RotAngle += 360;
+ if (RotAngle == 90 || RotAngle == 270) {
+ box->wd = 72.27 / 72 * fabs(r->ry - r->ly);
+ box->ht = 72.27 / 72 * fabs(r->rx - r->lx);
+ } else {
+ box->wd = 72.27 / 72 * fabs(r->rx - r->lx);
+ box->ht = 72.27 / 72 * fabs(r->ry - r->ly);
+ }
+ box->x = 72.27 / 72 * my_fmin(r->lx, r->rx);
+ box->y = 72.27 / 72 * my_fmin(r->ly, r->ry);
+
+ ppdoc_free(doc);
+
+ return 0;
+}
+
+int
+pdf_count_pages(char* filename)
+{
+ int pages = 0;
+ ppdoc* doc = ppdoc_load(filename);
+
+ if (!doc) {
+ return 0;
+ }
+
+ pages = ppdoc_page_count(doc);
+ if (doc) ppdoc_free(doc);
+
+ return pages;
+}
diff --git a/Build/source/texk/web2c/xetexdir/pdfimage.h b/Build/source/texk/web2c/xetexdir/pdfimage.h
new file mode 100644
index 00000000000..97c44c3d152
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/pdfimage.h
@@ -0,0 +1,50 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef __PDF_IMAGE_H__
+#define __PDF_IMAGE_H__
+
+#include "trans.h"
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern int pdf_get_rect(char* filename, int page_num, int pdf_box, realrect* box);
+
+extern int pdf_count_pages(char* filename);
+
+#ifdef __cplusplus
+};
+#endif
+
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/tests/bug73.log b/Build/source/texk/web2c/xetexdir/tests/bug73.log
new file mode 100644
index 00000000000..1cb6e810579
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/tests/bug73.log
@@ -0,0 +1,7 @@
+ restricted \write18 enabled.
+ %&-line parsing enabled.
+**bug73
+(./bug73.tex
+\everyvbox->\relax
+ )
+No pages of output.
diff --git a/Build/source/texk/web2c/xetexdir/tests/bug73.tex b/Build/source/texk/web2c/xetexdir/tests/bug73.tex
new file mode 100644
index 00000000000..dc3d2fef5f6
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/tests/bug73.tex
@@ -0,0 +1,16 @@
+% Copyright (C) 2014 Peter Breitenlohner <tex-live@tug.org>
+% You may freely use, modify and/or distribute this file.
+%
+\ifx\fmtname\undefined
+ \input basic
+ \def\fmtname{basic}
+ \expandafter\dump
+\fi
+%==================
+\begingroup % Just there to minimize tracing output
+ \tracingmacros=2
+ \tracingonline=1
+ \everyvbox{\relax} % or whatever, non-empty.
+ \setbox0=\vbox{} % no pdf output
+\endgroup
+\end
diff --git a/Build/source/texk/web2c/xetexdir/tests/filedump.log b/Build/source/texk/web2c/xetexdir/tests/filedump.log
new file mode 100644
index 00000000000..8489dae9120
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/tests/filedump.log
@@ -0,0 +1,5 @@
+ restricted \write18 enabled.
+ %&-line parsing enabled.
+**filedump
+(./filedump.tex 25C2AA0A5C636174636F6465605C7B3D310A5C63 )
+No pages of output.
diff --git a/Build/source/texk/web2c/xetexdir/tests/filedump.tex b/Build/source/texk/web2c/xetexdir/tests/filedump.tex
new file mode 100644
index 00000000000..dd5096138fd
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/tests/filedump.tex
@@ -0,0 +1,5 @@
+%ª
+\catcode`\{=1
+\catcode`\}=2
+\message{\filedump length 20{\jobname.tex}}
+\end
diff --git a/Build/source/texk/web2c/xetexdir/tex.ch0 b/Build/source/texk/web2c/xetexdir/tex.ch0
new file mode 100644
index 00000000000..ff1d4950cfe
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/tex.ch0
@@ -0,0 +1,37 @@
+% Change file to assist in creating the web2c-specific change file.
+% This one comes first, resolves inconsistencies between the generated
+% xetex.web and ../tex.ch
+% Public domain.
+
+@x [8.110] l.2422 - increase |max_halfword|
+@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
+@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
+@y
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@z
+
+@x [15.209] l.4165 - additional XeTeX commands
+@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@y
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@z
+
+@x [17.230] l.4731 - MLTeX: char_sub_code_base
+@d int_base=math_code_base+number_usvs {beginning of region 5}
+@y
+@d int_base=math_code_base+256 {beginning of region 5}
+@z
+
+@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters
+@d tex_int_pars=55 {total number of \TeX's integer parameters}
+@y
+@d int_pars=55 {total number of integer parameters}
+@z
+
+@x [36.749] l.14638 - MLTeX: avoid substitution in |make_op|
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+@y
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+@z
+
diff --git a/Build/source/texk/web2c/xetexdir/trans.c b/Build/source/texk/web2c/xetexdir/trans.c
new file mode 100644
index 00000000000..405347756b8
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/trans.c
@@ -0,0 +1,93 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#include "trans.h"
+
+void makeidentity(transform* t)
+{
+ t->a = 1.0;
+ t->b = 0.0;
+ t->c = 0.0;
+ t->d = 1.0;
+ t->x = 0.0;
+ t->y = 0.0;
+}
+
+void makescale(transform* t, double xscale, double yscale)
+{
+ t->a = xscale;
+ t->b = 0.0;
+ t->c = 0.0;
+ t->d = yscale;
+ t->x = 0.0;
+ t->y = 0.0;
+}
+
+void maketranslation(transform* t, double dx, double dy)
+{
+ t->a = 1.0;
+ t->b = 0.0;
+ t->c = 0.0;
+ t->d = 1.0;
+ t->x = dx;
+ t->y = dy;
+}
+#include <stdio.h>
+void makerotation(transform* t, double a)
+{
+ t->a = cos(a);
+ t->b = sin(a);
+ t->c = -sin(a);
+ t->d = cos(a);
+ t->x = 0.0;
+ t->y = 0.0;
+}
+
+void transformpoint(realpoint* p, const transform* t)
+{
+ realpoint r;
+ r.x = t->a * p->x + t->c * p->y + t->x;
+ r.y = t->b * p->x + t->d * p->y + t->y;
+ *p = r;
+}
+
+void transformconcat(transform* t1, const transform* t2)
+{
+ transform r;
+ r.a = t1->a * t2->a + t1->b * t2->c + 0.0 * t2->x;
+ r.b = t1->a * t2->b + t1->b * t2->d + 0.0 * t2->y;
+ r.c = t1->c * t2->a + t1->d * t2->c + 0.0 * t2->x;
+ r.d = t1->c * t2->b + t1->d * t2->d + 0.0 * t2->y;
+ r.x = t1->x * t2->a + t1->y * t2->c + 1.0 * t2->x;
+ r.y = t1->x * t2->b + t1->y * t2->d + 1.0 * t2->y;
+ *t1 = r;
+}
diff --git a/Build/source/texk/web2c/xetexdir/trans.h b/Build/source/texk/web2c/xetexdir/trans.h
new file mode 100644
index 00000000000..fa5957c62db
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/trans.h
@@ -0,0 +1,91 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+#ifndef _TRANS_H_
+#define _TRANS_H_
+
+#include <math.h>
+/* apparently M_PI isn't defined by <math.h> under VC++ */
+#ifndef M_PI
+#define M_PI 3.14159265358979323846
+#endif
+
+typedef struct {
+ double a;
+ double b;
+ double c;
+ double d;
+ double x;
+ double y;
+} transform;
+
+typedef struct {
+ float x;
+ float y;
+} realpoint;
+
+typedef struct {
+ float x;
+ float y;
+ float wd;
+ float ht;
+} realrect;
+
+#define xCoord(p) (p).x
+#define yCoord(p) (p).y
+
+#define wdField(r) (r).wd
+#define htField(r) (r).ht
+
+#define aField(t) (t).a
+#define bField(t) (t).b
+#define cField(t) (t).c
+#define dField(t) (t).d
+#define xField(t) (t).x
+#define yField(t) (t).y
+
+#define setPoint(P,X,Y) do { (P).x = X; (P).y = Y; } while (0)
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+void makeidentity(transform* t);
+void makescale(transform* t, double xscale, double yscale);
+void maketranslation(transform* t, double dx, double dy);
+void makerotation(transform* t, double a);
+void transformpoint(realpoint* p, const transform* t);
+void transformconcat(transform* t1, const transform* t2);
+#ifdef __cplusplus
+};
+#endif
+
+#endif /* _TRANS_H_ */
diff --git a/Build/source/texk/web2c/xetexdir/unicode-char-prep.pl b/Build/source/texk/web2c/xetexdir/unicode-char-prep.pl
new file mode 100644
index 00000000000..73b3b6d0ce7
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/unicode-char-prep.pl
@@ -0,0 +1,321 @@
+#!/usr/bin/perl
+
+# /****************************************************************************\
+# Part of the XeTeX typesetting system
+# Copyright (c) 1994-2008 by SIL International
+# Copyright (c) 2009 by Jonathan Kew
+#
+# SIL Author(s): Jonathan Kew
+#
+# Permission is hereby granted, free of charge, to any person obtaining
+# a copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject to
+# the following conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+# FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# Except as contained in this notice, the name of the copyright holders
+# shall not be used in advertising or otherwise to promote the sale,
+# use or other dealings in this Software without prior written
+# authorization from the copyright holders.
+# \****************************************************************************/
+
+# create unicode-letters.tex by processing Unicode data files
+# UnicodeData.txt
+# EastAsianWidth.txt
+# LineBreak.txt
+
+# The intent of unicode-letters.tex is to initialize basic properties for most
+# of the "letters" in Unicode, as follows:
+#
+# \catcode = 11 for everything with GC=L*
+# \sfcode = 999 for everything that has a to-lowercase mapping
+# \uccode, \lccode based on the case mapping fields
+# \XeTeXmathcode = (7 1 #) for BMP letters, (0 1 #) for SMP
+# \XeTeXspacingclass values based on a few of the Unicode line-break classes:
+# 'CM' => 256, # combining marks = transparent
+# 'ID' => 1, # ideograph
+# 'OP' => 2, # opener
+# 'CL' => 3, # closer
+# 'NS' => 3, # non-starter
+# 'EX' => 3, # exclamation
+# 'IS' => 3, # infix sep (comma etc)
+# 'QU' => 4, # ambiguous quote
+
+die "usage: perl $0 UnicodeData.txt EastAsianWidth.txt LineBreak.txt > unicode-letters.tex\n"
+ unless $#ARGV == 2;
+
+sub parse_unidata {
+ my (@u) = @_;
+ $lccode{$u[0]} = $u[13] if $u[13] ne '';
+ $lccode{$u[0]} = $u[0] if $u[13] eq '' and ($u[2] =~ /^L/ or $u[12] ne '');
+ $uccode{$u[0]} = $u[12] if $u[12] ne '';
+ $uccode{$u[0]} = $u[0] if $u[12] eq '' and ($u[2] =~ /^L/ or $u[13] ne '');
+ if ($u[2] =~ /^L/) {
+ push(@letters, $u[0]);
+ }
+ elsif ($u[2] =~ /^M/) {
+ push(@marks, $u[0]);
+ }
+ elsif (exists $lccode{$u[0]} or exists $uccode{$u[0]}) {
+ push(@casesym, $u[0]);
+ }
+}
+
+
+my ($start, $end);
+open Unidata, $ARGV[0] or die "can't read $ARGV[0]";
+while (<Unidata>) {
+ chomp;
+ @u = split(/;/);
+
+ my $charname = $u[1];
+ if ($charname !~ /</) {
+ parse_unidata(@u);
+ next;
+ }
+
+ if ($charname =~ /, First>/) {
+ $start = hex($u[0]);
+ } elsif ($charname =~ /, Last>/) {
+ $end = hex($u[0]);
+ shift @u;
+
+ for my $codepoint ($start .. $end) {
+ parse_unidata(sprintf("%04X", $codepoint), @u);
+ }
+ }
+}
+close Unidata;
+
+$date = `date`;
+chomp $date;
+print << "__EOT__";
+% Do not edit this file!
+% Created from UnicodeData.txt, EastAsianWidth.txt, LineBreak.txt
+% by unicode-char-prep.pl on $date.
+% In case of errors, fix the Perl script instead.
+__EOT__
+
+print << '__EOT__';
+
+\begingroup
+\catcode`\{=1 \catcode`\}=2 \catcode`\#=6
+
+\message{loading Unicode properties}
+
+% test whether xetex is new enough to set codes on supplementary-plane chars
+% (requires version > 0.996)
+\let\ifSupplementary=\iffalse
+\def\Supplementarytrue{\let\ifSupplementary=\iftrue}
+\ifnum\XeTeXversion>0 \Supplementarytrue
+\else
+ \def\getrevnumber.#1.#2-#3\end{\count255=#1 }
+ \expandafter\getrevnumber\XeTeXrevision.-\end
+ \ifnum\count255>996 \Supplementarytrue \fi
+\fi
+% definitions for classes and case mappings based on UnicodeData.txt
+\def\C #1 #2 #3 {\global\uccode"#1="#2 \global\lccode"#1="#3 } % case mappings (non-letter)
+\def\L #1 #2 #3 {\global\catcode"#1=11 % category: letter
+ \C #1 #2 #3 % with case mappings
+ \ifnum"#1="#3 \else \global\sfcode"#1=999 \fi % uppercase letters have sfcode=999
+ \ifnum"#1<"10000 \global\XeTeXmathcode"#1="7"01"#1 % BMP letters default to class 7 (var), fam 1
+ \else \global\XeTeXmathcode"#1="0"01"#1 % SMP letters class 0 (regular), fam 1
+ \fi}
+\def\l #1 {\L #1 #1 #1 } % letter without case mappings
+\let\m=\l % combining mark - treated as uncased letter
+
+__EOT__
+
+$supp = 0;
+for (@letters) {
+ if ((hex $_ > 0xffff) and ($supp == 0)) {
+ print "\\ifSupplementary\n";
+ $supp = 1;
+ }
+ if (exists $uccode{$_} or exists $lccode{$_}) {
+ if (($lccode{$_} eq $_) and ($uccode{$_} eq $_)) {
+ print "\\l $_\n";
+ }
+ else {
+ print "\\L $_ ";
+ print exists $uccode{$_} ? $uccode{$_} : "0";
+ print " ";
+ print exists $lccode{$_} ? $lccode{$_} : "0";
+ print "\n";
+ }
+ }
+ else {
+ print "\\l $_\n";
+ }
+}
+if ($supp == 1) {
+ print "\\fi % end ifSupplementary\n";
+ $supp = 0;
+}
+
+for (@casesym) {
+ if ((hex $_ > 0xffff) and ($supp == 0)) {
+ print "\\ifSupplementary\n";
+ $supp = 1;
+ }
+ print "\\C $_ ";
+ print exists $uccode{$_} ? $uccode{$_} : "0";
+ print " ";
+ print exists $lccode{$_} ? $lccode{$_} : "0";
+ print "\n";
+}
+if ($supp == 1) {
+ print "\\fi % end ifSupplementary\n";
+ $supp = 0;
+}
+
+for (@marks) {
+ if ((hex $_ > 0xffff) and ($supp == 0)) {
+ print "\\ifSupplementary\n";
+ $supp = 1;
+ }
+ print "\\m $_\n";
+}
+if ($supp == 1) {
+ print "\\fi % end ifSupplementary\n";
+ $supp = 0;
+}
+
+print << '__EOT__';
+
+% set \sfcode for Unicode closing quotes
+\sfcode"2019=0
+\sfcode"201D=0
+
+% check whether the interchar toks features are present
+\ifx\XeTeXinterchartoks\XeTeXcharclass
+ \def\next{\endgroup\endinput}
+\else
+ \let\next\relax
+\fi
+\next
+
+__EOT__
+
+open EAW, $ARGV[1] or die "can't read $ARGV[1]";
+while (<EAW>) {
+ chomp;
+ s/ *#.*//;
+ s/ +$//;
+ if (m/([0-9A-F]{4,6})(?:\.\.([0-9A-F]{4,6}))?;(.+)/) {
+ $s = $1;
+ $e = $2;
+ $w = $3;
+ $e = $s if $e eq '';
+ for ($i = hex "0x$s"; $i <= hex "0x$e"; ++$i) {
+ $width[$i] = $w;
+ }
+ }
+}
+close EAW;
+
+%lineBreakClass = (
+ 'CM' => 256, # combining marks = transparent
+ 'ID' => 1, # ideograph
+ 'OP' => 2, # opener
+ 'CL' => 3, # closer
+ 'NS' => 3, # non-starter
+ 'EX' => 3, # exclamation
+ 'IS' => 3, # infix sep (comma etc)
+);
+
+print << '__EOT__';
+\message{and character classes}
+
+% definitions for script classes based on LineBreak.txt
+__EOT__
+
+foreach (keys %lineBreakClass) {
+ print "\\def\\$_ #1 #2 {\\set{#1}{#2}{\\global\\XeTeXcharclass\\n=$lineBreakClass{$_}";
+ print " \\global\\catcode\\n=11" if m/ID/;
+ print " }}\n";
+}
+
+print << '__EOT__';
+\countdef\n=255
+\def\set#1#2#3{% execute setting "#3" with \n set to each value from #1 to #2
+ \n="#1 \loop #3 \ifnum\n<"#2 \advance\n by 1 \repeat}
+% copy \loop etc from plain.tex
+\def\loop#1\repeat{\def\body{#1}\iterate}
+\def\iterate{\body \let\next\iterate \else\let\next\relax\fi \next}
+\let\repeat=\fi % this makes \loop...\if...\repeat skippable
+
+__EOT__
+
+open LineBreak, $ARGV[2] or die "can't read $ARGV[2]";
+while (<LineBreak>) {
+ chomp;
+ s/ *#.*//;
+ s/ +$//;
+ if (m/([0-9A-F]{4,6})(?:\.\.([0-9A-F]{4,6}))?;(..)/) {
+ $s = $1;
+ $e = $2;
+ $lb = $3;
+ $e = $s if $e eq '';
+ if (exists $lineBreakClass{$lb}) {
+ if ($lineBreakClass{$lb} == 1) {
+ # ideographs: set whole range to class 1
+ print "\\$lb $s $e\n";
+ }
+ else {
+ # punctuation, etc: only set these by default for chars with EAW = W, F, H
+ for ($i = hex "0x$s"; $i <= hex "0x$e"; ++$i) {
+ if ($width[$i] =~ /^[WFH]$/) {
+ printf "\\$lb %04X %04X\n", $i, $i;
+ }
+ }
+ }
+ }
+ }
+}
+close LineBreak;
+
+print << '__EOT__';
+
+% basic line-breaking support for CJK etc; override for more sophisticated spacing,
+% automatic font changes, etc.
+
+\gdef\xtxHanGlue{\hskip0pt plus 0.1em\relax} % between ideographs
+\gdef\xtxHanSpace{\hskip0.2em plus 0.2em minus 0.1em\relax} % before/after runs of CJK
+
+\global\XeTeXinterchartoks 0 1 = {\xtxHanSpace}
+\global\XeTeXinterchartoks 0 2 = {\xtxHanSpace}
+\global\XeTeXinterchartoks 0 3 = {\nobreak\xtxHanSpace}
+
+\global\XeTeXinterchartoks 1 0 = {\xtxHanSpace}
+\global\XeTeXinterchartoks 2 0 = {\nobreak\xtxHanSpace}
+\global\XeTeXinterchartoks 3 0 = {\xtxHanSpace}
+
+\global\XeTeXinterchartoks 1 1 = {\xtxHanGlue}
+\global\XeTeXinterchartoks 1 2 = {\xtxHanGlue}
+\global\XeTeXinterchartoks 1 3 = {\nobreak\xtxHanGlue}
+
+\global\XeTeXinterchartoks 2 1 = {\nobreak\xtxHanGlue}
+\global\XeTeXinterchartoks 2 2 = {\nobreak\xtxHanGlue}
+\global\XeTeXinterchartoks 2 3 = {\xtxHanGlue}
+
+\global\XeTeXinterchartoks 3 1 = {\xtxHanGlue}
+\global\XeTeXinterchartoks 3 2 = {\xtxHanGlue}
+\global\XeTeXinterchartoks 3 3 = {\nobreak\xtxHanGlue}
+
+\endgroup
+
+__EOT__
diff --git a/Build/source/texk/web2c/xetexdir/xetex-bug73.test b/Build/source/texk/web2c/xetexdir/xetex-bug73.test
new file mode 100755
index 00000000000..6f2c1f127c9
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex-bug73.test
@@ -0,0 +1,25 @@
+#! /bin/sh -vx
+# Copyright 2017-2018 Karl Berry <tex-live@tug.org>
+# Copyright 2014-2015 Peter Breitenlohner <tex-live@tug.org>
+# You may freely use, modify and/or distribute this file.
+
+LC_ALL=C; export LC_ALL; LANGUAGE=C; export LANGUAGE
+
+TEXMFCNF=$srcdir/../kpathsea;export TEXMFCNF
+TEXINPUTS=.:$srcdir/tests; export TEXINPUTS
+TEXFORMATS=.; export TEXFORMATS
+
+# get same filename in log
+rm -f bug73.tex
+$LN_S $srcdir/xetexdir/tests/bug73.tex .
+
+#exit 77
+
+./xetex -ini bug73 || exit 1
+
+./xetex -fmt=bug73 bug73 || exit 1
+
+sed 1d bug73.log >bug73.out
+
+diff $srcdir/xetexdir/tests/bug73.log bug73.out || exit 1
+
diff --git a/Build/source/texk/web2c/xetexdir/xetex-filedump.test b/Build/source/texk/web2c/xetexdir/xetex-filedump.test
new file mode 100755
index 00000000000..1d1a2e75106
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex-filedump.test
@@ -0,0 +1,22 @@
+#! /bin/sh -vx
+# Copyright 2019 Karl Berry <tex-live@tug.org>
+# You may freely use, modify and/or distribute this file.
+
+LC_ALL=C; export LC_ALL; LANGUAGE=C; export LANGUAGE
+
+TEXMFCNF=$srcdir/../kpathsea;export TEXMFCNF
+TEXINPUTS=.:$srcdir/tests; export TEXINPUTS
+TEXFORMATS=.; export TEXFORMATS
+
+# get same filename in log
+rm -f filedump.tex
+$LN_S $srcdir/xetexdir/tests/filedump.tex .
+
+#exit 77
+
+./xetex -ini filedump || exit 1
+
+sed 1d filedump.log >filedump.out
+
+diff $srcdir/xetexdir/tests/filedump.log filedump.out || exit 1
+
diff --git a/Build/source/texk/web2c/xetexdir/xetex.ch b/Build/source/texk/web2c/xetexdir/xetex.ch
new file mode 100644
index 00000000000..05cb7dd8de5
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex.ch
@@ -0,0 +1,957 @@
+/****************************************************************************\
+ $Id$
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2021 by Jonathan Kew
+ Copyright (c) 2012 by Khaled Hosny
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+@x
+\let\maybe=\iffalse
+@y
+\let\maybe=\iftrue
+@z
+
+@x [1] m.2 l.188 - banner
+@d banner==TeX_banner
+@d banner_k==TeX_banner_k
+@y
+@d banner==XeTeX_banner
+@d banner_k==XeTeX_banner
+@z
+
+@x [2.20] l.579 - printable characters
+xchr: array [ASCII_code] of text_char;
+ { specifies conversion of output characters }
+xprn: array [ASCII_code] of ASCII_code;
+ { non zero iff character is printable }
+@y
+@!xchr: ^text_char;
+ {dummy variable so tangle doesn't complain; not actually used}
+@z
+
+@x [2.23] l.723 - Translate characters if desired, otherwise allow them all.
+{Initialize |xchr| to the identity mapping.}
+for i:=0 to @'37 do xchr[i]:=i;
+for i:=@'177 to @'377 do xchr[i]:=i;
+@y
+@z
+
+@x [2.24] l.733 - Don't reinitialize xord.
+for i:=0 to @'176 do xord[xchr[i]]:=i;
+{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.}
+for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~")));
+
+{The idea for this dynamic translation comes from the patch by
+ Libor Skarvada \.{<libor@@informatics.muni.cz>}
+ and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the
+ actual code, though, preferring a more general approach.}
+
+{This updates the |xchr|, |xord|, and |xprn| arrays from the provided
+ |translate_filename|. See the function definition in \.{texmfmp.c} for
+ more comments.}
+if translate_filename then read_tcx_file;
+@y
+@z
+
+@x [3.26] l.789 - name_of_file is no longer an array
+@!name_of_file:^text_char;
+@y
+@!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS}
+@z
+
+@x
+@!name_of_file16:array[1..file_name_size] of UTF16_code;@;@/
+@y
+@!name_of_file16:^UTF16_code;
+@z
+
+@x [3.30] l.888 - Array size of input buffer is determined at runtime.
+@!buffer:^ASCII_code; {lines of characters being read}
+@y
+@!buffer:^UnicodeScalar; {lines of characters being read}
+@z
+
+@x [3.32] l.961 - `term_in' and `term_out' are standard input and output.
+@d term_in==stdin {the terminal as an input file}
+@y
+@z
+
+@x [3.32] l.961
+@!bound_default:integer; {temporary for setup}
+@y
+@!term_in:unicode_file;
+@#
+@!bound_default:integer; {temporary for setup}
+@z
+
+@x [5.61] l.1556 - Print rest of banner, eliminate misleading `(no format preloaded)'.
+if translate_filename then begin
+ wterm(' (');
+ fputs(translate_filename, stdout);
+ wterm_ln(')');
+@y
+if translate_filename then begin
+ wterm(' (WARNING: translate-file "');
+ fputs(translate_filename, stdout);
+ wterm_ln('" ignored)');
+@z
+
+@x We add a new |history| value for failure of the output driver
+has been detected. It has four possible values: |spotless|, |warning_issued|,
+|error_message_issued|, and |fatal_error_stop|.
+@y
+has been detected. It has five possible values: |spotless|, |warning_issued|,
+|error_message_issued|, |fatal_error_stop|, and |output_failure|.
+@z
+
+@x
+@d fatal_error_stop=3 {|history| value when termination was premature}
+@y
+@d fatal_error_stop=3 {|history| value when termination was premature}
+@d output_failure=4 {|history| value when output driver returned an error}
+@z
+
+@x
+@!history:spotless..fatal_error_stop; {has the source input been clean so far?}
+@y
+@!history:spotless..output_failure; {has the source input been clean so far?}
+@z
+
+@x [6.84] l.1904 - Implement the switch-to-editor option.
+ begin edit_name_start:=str_start[edit_file.name_field];
+ edit_name_length:=str_start[edit_file.name_field+1] -
+ str_start[edit_file.name_field];
+@y
+ 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);
+@z
+
+@x [8.110] l.2423
+@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
+@y
+@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
+@z
+
+@x [15.209] l.4165
+@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@y
+@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@z
+
+@x [16.215] - e-TeX last_node_type
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+@y
+last_glue:=max_halfword; last_penalty:=0; last_kern:=0;
+last_node_type:=-1;
+@z
+
+@x [17.222] l.4523 - frozen_special, for source specials.
+@d frozen_null_font=frozen_control_sequence+11
+@y
+@d frozen_null_font=frozen_control_sequence+12+prim_size
+@z
+
+@x [17.230] l.4731
+@d char_sub_code_base=math_code_base+256 {table of character substitutions}
+@d int_base=char_sub_code_base+256 {beginning of region 5}
+@y
+@d char_sub_code_base=math_code_base+number_usvs {table of character substitutions}
+@d int_base=char_sub_code_base+number_usvs {beginning of region 5}
+@z
+
+@x [17.236] l.4960 - first web2c, then e-TeX additional integer parameters
+@d int_pars=web2c_int_pars {total number of integer parameters}
+@#
+@d etex_int_base=tex_int_pars {base for \eTeX's integer parameters}
+@y
+@d etex_int_base=web2c_int_pars {base for \eTeX's integer parameters}
+@z
+
+@x [22.304] l.6536 - texarray; additions for file:line:error style.
+@!input_file : ^alpha_file;
+@y
+@!input_file : ^unicode_file;
+@z
+
+@x [29.516] l.9992 - filenames: more_name
+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;
+@y
+begin if stop_at_space and (c=" ") and (file_name_quote_char=0) then
+ more_name:=false
+else if stop_at_space and (file_name_quote_char<>0) and (c=file_name_quote_char) then begin
+ file_name_quote_char:=0;
+ more_name:=true;
+ end
+else if stop_at_space and (file_name_quote_char=0) and ((c="""") or (c="'")) then begin
+ file_name_quote_char:=c;
+ quoted_filename:=true;
+@z
+
+@x [29.517] l.10002 - end_name: string recycling
+@!j,@!s,@!t: pool_pointer; {running indices}
+@!must_quote:boolean; {whether we need to quote a string}
+@y
+@!j: pool_pointer; {running index}
+@z
+@x [29.517] l.10002 - end_name: string recycling
+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[str_ptr];
+ t:=str_start[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[str_ptr]+area_delimiter;
+if ext_delimiter=0 then t:=pool_ptr else t:=str_start[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[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;
+@y
+@z
+
+@x [29.517] l.10011 - end_name: string recycling
+ for j:=str_start[str_ptr+1] to pool_ptr-1 do
+@y
+ for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
+@z
+
+@x [29.517] l.10016 - end_name: string recycling
+ for j:=str_start[str_ptr+1] to pool_ptr-1 do
+@y
+ for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+@d check_quoted(#) == {check if string |#| needs quoting}
+if #<>0 then begin
+ j:=str_start[#];
+ while (not must_quote) and (j<str_start[#+1]) do begin
+ must_quote:=str_pool[j]=" "; incr(j);
+@y
+@d check_quoted(#) == {check if string |#| needs quoting}
+if #<>0 then begin
+ j:=str_start_macro(#);
+ while ((not must_quote) or (quote_char=0)) and (j<str_start_macro(#+1)) do begin
+ if str_pool[j]=" " then must_quote:=true
+ else if (str_pool[j]="""") or (str_pool[j]="'") then begin
+ must_quote:=true;
+ quote_char:="""" + "'" - str_pool[j];
+ end;
+ incr(j);
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+@d print_quoted(#) == {print string |#|, omitting quotes}
+if #<>0 then
+ for j:=str_start[#] to str_start[#+1]-1 do
+ if so(str_pool[j])<>"""" then
+ print(so(str_pool[j]))
+@y
+@d print_quoted(#) == {print string |#|, omitting quotes}
+if #<>0 then
+ for j:=str_start_macro(#) to str_start_macro(#+1)-1 do begin
+ if str_pool[j]=quote_char then begin
+ print(quote_char);
+ quote_char:="""" + "'" - quote_char;
+ print(quote_char);
+ end;
+ print(str_pool[j]);
+ end
+@z
+
+@x [29.518] l.10042 - print_file_name: quote if spaces in names.
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+check_quoted(a); check_quoted(n); check_quoted(e);
+{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("""");
+print_quoted(a); print_quoted(n); print_quoted(e);
+if must_quote then print_char("""");
+@y
+@!quote_char: integer; {current quote char (single or double)}
+@!j:pool_pointer; {index into |str_pool|}
+begin
+must_quote:=false;
+quote_char:=0;
+check_quoted(a); check_quoted(n); check_quoted(e);
+if must_quote then begin
+ if quote_char=0 then quote_char:="""";
+ print_char(quote_char);
+end;
+print_quoted(a); print_quoted(n); print_quoted(e);
+if quote_char<>0 then print_char(quote_char);
+@z
+
+@x [29.519] l.10051 - have append_to_name skip quotes.
+@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end end
+@y
+@d append_to_name(#)==begin c:=#; incr(k);
+ if k<=file_name_size then begin
+ if (c < 128) then name_of_file[k]:=c
+ else if (c < @"800) then begin
+ name_of_file[k]:=@"C0 + c div @"40; incr(k);
+ name_of_file[k]:=@"80 + c mod @"40;
+ end else begin
+ name_of_file[k]:=@"E0 + c div @"1000; incr(k);
+ name_of_file[k]:=@"80 + (c mod @"1000) div @"40; incr(k);
+ name_of_file[k]:=@"80 + (c mod @"1000) mod @"40;
+ end
+ end
+ end
+@z
+
+@x [29.519] l.10047 - pack_file_name, leave room for the extra null
+name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1);
+@y
+name_of_file:= xmalloc_array (UTF8_code, (length(a)+length(n)+length(e))*3+1);
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1);
+for j:=1 to n do append_to_name(xord[ucharcast(TEX_format_default[j])]);
+@y
+name_of_file := xmalloc_array (UTF8_code, n+(b-a+1)+format_ext_length+1);
+for j:=1 to n do append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.523] l.10095 - Change to pack_buffered_name as with pack_file_name.
+ append_to_name(xord[ucharcast(TEX_format_default[j])]);
+@y
+ append_to_name(TEX_format_default[j]);
+@z
+
+@x [29.525] l.10174 - make_name_string
+ k:=1;
+ while (k<=name_length)and(more_name(name_of_file[k])) do
+@y
+ k:=0;
+ while (k<name_length16)and(more_name(name_of_file16[k])) do
+@z
+
+@x [29.526] l.10194 - stop scanning file name if we're at end-of-line.
+ {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;
+@y
+@z
+
+@x [29.536] l.10331
+ wlog(' (');
+ fputs(translate_filename, log_file);
+ wlog(')');
+@y
+ wlog(' (WARNING: translate-file "');
+ fputs(translate_filename, log_file);
+ wlog('" ignored)');
+@z
+
+@x [29.537] l.10338 - start_input
+var temp_str: str_number;
+v: pointer;
+begin scan_file_name; {set |cur_name| to desired file name}
+@y
+var temp_str: str_number;
+v: pointer;
+@!k:0..file_name_size; {index into |name_of_file16|}
+begin scan_file_name; {set |cur_name| to desired file name}
+@z
+
+@x [29.537] l.10338 - start_input
+ and a_open_in(cur_file, kpse_tex_format) then
+ goto done;
+@y
+ and u_open_in(cur_file, kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then
+ {At this point |name_of_file| contains the actual name found, as a UTF8 string.
+ We convert to UTF16, then extract the |cur_area|, |cur_name|, and |cur_ext| from it.}
+ begin
+ make_utf16_name;
+ name_in_progress:=true;
+ begin_name;
+ stop_at_space:=false;
+ k:=0;
+ while (k<name_length16)and(more_name(name_of_file16[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+ name_in_progress:=false;
+ goto done;
+ end;
+@z
+
+@x [30.549] l.10682 - texarray
+@!font_bc: ^eight_bits;
+ {beginning (smallest) character code}
+@!font_ec: ^eight_bits;
+ {ending (largest) character code}
+@y
+@!font_bc: ^UTF16_code;
+ {beginning (smallest) character code}
+@!font_ec: ^UTF16_code;
+ {ending (largest) character code}
+@z
+
+@x [30.549] l.10682 - texarray
+@!font_false_bchar: ^nine_bits;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@y
+@!font_false_bchar: ^nine_bits;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+@#
+@!font_layout_engine: ^void_pointer; {either an CFDictionaryRef or a XeTeXLayoutEngine}
+@!font_mapping: ^void_pointer; { |TECkit_Converter| or 0 }
+@!font_flags: ^char; { flags:
+ 0x01: |font_colored|
+ 0x02: |font_vertical| }
+@!font_letter_space: ^scaled; { letterspacing to be applied to the font }
+@!loaded_font_mapping: void_pointer; { used by |load_native_font| to return mapping, if any }
+@!loaded_font_flags: char; { used by |load_native_font| to return flags }
+@!loaded_font_letter_space: scaled;
+@!loaded_font_design_size: scaled;
+@!mapped_text: ^UTF16_code; { scratch buffer used while applying font mappings }
+@!xdv_buffer: ^char; { scratch buffer used in generating XDV output }
+@z
+
+@x [30.561] l.10939 - Check lengths
+else print(" not loadable: Metric (TFM) file not found");
+@y
+else print(" not loadable: Metric (TFM) file or installed font not found");
+@z
+
+@x
+@ We need a few subroutines for |new_character|.
+
+@p @t\4@>@<Declare subroutines for |new_character|@>@;
+@y
+@ The subroutines for |new_character| have been moved.
+@z
+
+@x [30.582] l.11276 - MLTeX: call |effective_char| in |new_character|
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+@y
+@p function new_character(@!f:internal_font_number;@!c:ASCII_code):pointer;
+@z
+
+@x [30.582] l.11276 - MLTeX: call |effective_char| in |new_character|
+begin ec:=effective_char(false,f,qi(c));
+@y
+begin
+if is_native_font(f) then
+ begin new_character:=new_native_character(f,c); return;
+ end;
+ec:=effective_char(false,f,qi(c));
+@z
+
+@x [32.619] l.12294 - MLTeX: substitute character in |hlist_out|
+label reswitch, move_past, fin_rule, next_p, continue, found;
+@y
+label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run;
+@z
+
+@x
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+@y
+if list_ptr(p)=null then begin
+ if upwards then cur_v:=cur_v-depth(p)-height(p) else cur_v:=cur_v+height(p)+depth(p);
+ end
+@z
+
+@x [32.645] l.12780 - use print_file_name
+ print_nl("Output written on "); print_file_name(0, output_file_name, 0);
+@.Output written on x@>
+ print(" ("); print_int(total_pages);
+ if total_pages<>1 then print(" pages")
+ else print(" page");
+ print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
+ b_close(dvi_file);
+@y
+ k:=dvi_close(dvi_file);
+ if k=0 then begin
+ print_nl("Output written on "); print(output_file_name);
+@.Output written on x@>
+ print(" ("); print_int(total_pages);
+ if total_pages<>1 then print(" pages")
+ else print(" page");
+ if no_pdf_output then begin
+ print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes).");
+ end else print(").");
+ end else begin
+ print_nl("Error "); print_int(k); print(" (");
+ if no_pdf_output then print_c_string(strerror(k))
+ else print("driver return code");
+ print(") generating output;");
+ print_nl("file "); print(output_file_name); print(" may not be valid.");
+ history:=output_failure;
+ end;
+@z
+
+@x [43.943] l.18348 - bigtrie: Larger hyphenation tries.
+@!trie_used:array[ASCII_code] of trie_opcode;
+@y
+@!trie_used:array[0..biggest_lang] of trie_opcode;
+@z
+
+@x [43.946] l.18416 - bigtrie: And larger tries again.
+for k:=0 to 255 do trie_used[k]:=min_trie_op;
+@y
+for k:=0 to biggest_lang do trie_used[k]:=min_trie_op;
+@z
+
+@xx [43.958] l.18638 - bigtrie: Larger tries.
+ begin for r:=0 to 256 do clear_trie;
+ trie_max:=256;
+@y
+ begin for r:=0 to max_hyph_char do clear_trie;
+ trie_max:=max_hyph_char;
+@z
+
+@x [49.1222] l.22833 - MLTeX: \charsubdef primitive
+else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
+@y
+else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_usv);
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
+@!n:0..15; {stream number}
+@y
+var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
+@!n:0..15; {stream number}
+@!k:0..file_name_size; {index into |name_of_file16|}
+@z
+
+@x [49.1275] l.23441 - Same stuff as for \input, this time for \openin.
+ and a_open_in(read_file[n], kpse_tex_format) then
+ read_open[n]:=just_open;
+@y
+ and u_open_in(read_file[n], kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then
+ begin
+ make_utf16_name;
+ name_in_progress:=true;
+ begin_name;
+ stop_at_space:=false;
+ k:=0;
+ while (k<name_length16)and(more_name(name_of_file16[k])) do
+ incr(k);
+ stop_at_space:=true;
+ end_name;
+ name_in_progress:=false;
+ read_open[n]:=just_open;
+ end;
+@z
+
+@x [50.1302] l.23690 - store_fmt_file
+@!format_engine: ^text_char;
+@y
+@!format_engine: ^char;
+@z
+
+@x [50.1303] l.23722 - load_fmt_file
+@!format_engine: ^text_char;
+@!dummy_xord: ASCII_code;
+@!dummy_xchr: text_char;
+@!dummy_xprn: ASCII_code;
+@y
+@!format_engine: ^char;
+@z
+
+@x [50,1307] l.23779 - texarray
+format_engine:=xmalloc_array(text_char,x+4);
+@y
+format_engine:=xmalloc_array(char,x+4);
+@z
+
+@x [50,1307] l.23779 - texarray
+@<Dump |xord|, |xchr|, and |xprn|@>;
+@y
+@z
+
+@x [50.1308] l.23793 - texarray
+format_engine:=xmalloc_array(text_char, x);
+@y
+format_engine:=xmalloc_array(char, x);
+@z
+
+@x [50.1308] l.23793 - texarray
+@<Undump |xord|, |xchr|, and |xprn|@>;
+@y
+@z
+
+@x [50.1309] l.23814 - Make dumping/undumping more efficient.
+dump_things(str_start[0], str_ptr+1);
+@y
+dump_things(str_start_macro(too_big_char), str_ptr+1-too_big_char);
+@z
+
+@x [50.1310] l.23829 - Make dumping/undumping more efficient.
+undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/
+@y
+undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_big_char);@/
+@z
+
+@x [50.1322] l.24000 - Make dumping/undumping more efficient - tfm
+ print_file_name(font_name[k],font_area[k],"");
+@y
+ if is_native_font(k) or (font_mapping[k]<>0) then
+ begin print_file_name(font_name[k],"","");
+ print_err("Can't \dump a format with native fonts or font-mappings");
+ help3("You really, really don't want to do this.")@/
+ ("It won't work, and only confuses me.")@/
+ ("(Load them at runtime, not as part of the format file.)");
+ error;
+ end
+ else print_file_name(font_name[k],font_area[k],"");
+@z
+
+@x [50.1322] l.24031 - Make dumping/undumping more efficient - tfm
+begin {Allocate the font arrays}
+@y
+begin {Allocate the font arrays}
+font_mapping:=xmalloc_array(void_pointer, font_max);
+font_layout_engine:=xmalloc_array(void_pointer, font_max);
+font_flags:=xmalloc_array(char, font_max);
+font_letter_space:=xmalloc_array(scaled, font_max);
+@z
+
+@x [50.1322] l.24031 - Make dumping/undumping more efficient - tfm
+font_bc:=xmalloc_array(eight_bits, font_max);
+font_ec:=xmalloc_array(eight_bits, font_max);
+@y
+font_bc:=xmalloc_array(UTF16_code, font_max);
+font_ec:=xmalloc_array(UTF16_code, font_max);
+@z
+
+@x [50.1322] l.24031 - Make dumping/undumping more efficient - tfm
+undump_things(font_check[null_font], font_ptr+1-null_font);
+@y
+for k:=null_font to font_ptr do font_mapping[k]:=0;
+undump_things(font_check[null_font], font_ptr+1-null_font);
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+ setup_bound_var (15000)('max_strings')(max_strings);
+@y
+ setup_bound_var (15000)('max_strings')(max_strings);
+ max_strings:=max_strings+too_big_char; {the |max_strings| value doesn't include the 64K synthetic strings}
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+ buffer:=xmalloc_array (ASCII_code, buf_size);
+@y
+ buffer:=xmalloc_array (UnicodeScalar, buf_size);
+@z
+
+@x [51.1332] l.24203 - make the main program a procedure, for eqtb hack.
+ input_file:=xmalloc_array (alpha_file, max_in_open);
+@y
+ input_file:=xmalloc_array (unicode_file, max_in_open);
+@z
+
+@x [51.1332] l.24203 (ca.) texarray
+ line_stack:=xmalloc_array (integer, max_in_open);
+@y
+ line_stack:=xmalloc_array (integer, max_in_open);
+ eof_seen:=xmalloc_array (boolean, max_in_open);
+ grp_stack:=xmalloc_array (save_pointer, max_in_open);
+ if_stack:=xmalloc_array (pointer, max_in_open);
+@z
+
+@x [51.1333] l.24254 - Print new line before termination; switch to editor if necessary.
+ print_file_name(0, log_name, 0); print_char(".");
+@y
+ print(log_name); print_char(".");
+@z
+
+@x [51.1337] l.24371 (ca.) texarray
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+@y
+ trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+ hyph_root:=0; hyph_start:=0;
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries, do char translation, MLTeX
+ {Allocate and initialize font arrays}
+@y
+ {Allocate and initialize font arrays}
+ font_mapping:=xmalloc_array(void_pointer, font_max);
+ font_layout_engine:=xmalloc_array(void_pointer, font_max);
+ font_flags:=xmalloc_array(char, font_max);
+ font_letter_space:=xmalloc_array(scaled, font_max);
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries, do char translation, MLTeX
+ font_bc:=xmalloc_array(eight_bits, font_max);
+ font_ec:=xmalloc_array(eight_bits, font_max);
+@y
+ font_bc:=xmalloc_array(UTF16_code, font_max);
+ font_ec:=xmalloc_array(UTF16_code, font_max);
+@z
+
+@x [51.1337] l.24371 - Allocate hyphenation tries, do char translation, MLTeX
+ param_base[null_font]:=-1;
+@y
+ font_mapping[null_font]:=0;
+ param_base[null_font]:=-1;
+@z
+
+@x [53.1348] (do_extension) Remove unused variables
+var k:integer; {all-purpose integers}
+@y
+var i,@!j,@!k:integer; {all-purpose integers}
+@z
+
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+ print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|}
+@y
+ print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|}
+@z
+
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+ str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]];
+ if (str_pool[str_start[str_ptr]+d]=null_code)
+@y
+ if (str_pool[str_start_macro(str_ptr)+d]=null_code)
+@z
+
+@x [53.1370] l.24779 - convert from UTF-16 to UTF-8 for system(3).
+ runsystem_ret := runsystem(conststringcast(addressof(
+ str_pool[str_start[str_ptr]])));
+@y
+ if name_of_file then libc_free(name_of_file);
+ name_of_file := xmalloc(cur_length * 3 + 2);
+ k := 0;
+ for d:=0 to cur_length-1 do
+ append_to_name(str_pool[str_start_macro(str_ptr)+d]);
+ name_of_file[k+1] := 0;
+ runsystem_ret := runsystem(conststringcast(name_of_file+1));
+@z
+
+@x [53.1370] l.24779 - system: (write_out) \write18{foo} => system(foo).
+ pool_ptr:=str_start[str_ptr]; {erase the string}
+@y
+ pool_ptr:=str_start_macro(str_ptr); {erase the string}
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
+@y
+@!init if (etex_p or(buffer[loc]="*"))and(format_ident=" (INITEX)") then
+@z
+
+@x [53a.1379] l.??? -etex command line switch
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+@y
+ if buffer[loc]="*" then incr(loc);
+ eTeX_mode:=1; {enter extended mode}
+@z
+
+@x [53a.1383] l.??? -etex command line switch
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@y
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+@!etex_p: boolean; {was the -etex option specified}
+@z
+
+@x [53a.1391] l.??? texarray
+@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
+@y
+@!eof_seen : ^boolean; {has eof been seen?}
+@z
+
+@x [53a.1506] l.??? texarray
+@!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 [54.1376] l.24903 - print_csnames
+ for c := str_start[text(h)] to str_start[text(h) + 1] - 1
+@y
+ for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1
+@z
+
+@x [54.1376] l.24903 - Dumping/Undumping
+@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always
+in the format, so a TCX file loaded during format creation can set a
+default for users of the format.
+
+@<Dump |xord|, |xchr|, and |xprn|@>=
+dump_things(xord[0], 256);
+dump_things(xchr[0], 256);
+dump_things(xprn[0], 256);
+
+@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more
+complicated, because we want to ensure that a TCX file specified on
+the command line will override whatever is in the format. Since the
+tcx file has already been loaded, that implies throwing away the data
+in the format. Also, if no |translate_filename| is given, but
+|eight_bit_p| is set we have to make all characters printable.
+
+@<Undump |xord|, |xchr|, and |xprn|@>=
+if translate_filename then begin
+ for k:=0 to 255 do undump_things(dummy_xord, 1);
+ for k:=0 to 255 do undump_things(dummy_xchr, 1);
+ for k:=0 to 255 do undump_things(dummy_xprn, 1);
+ end
+else begin
+ undump_things(xord[0], 256);
+ undump_things(xchr[0], 256);
+ undump_things(xprn[0], 256);
+ if eight_bit_p then
+ for k:=0 to 255 do
+ xprn[k]:=1;
+end;
+
+
+@y
+@z
+
+@x
+ while s>255 do {first 256 strings depend on implementation!!}
+@y
+ while s>65535 do {first 64K strings don't really exist in the pool!}
+@z
+
+@x [54/web2c.1407] - scan a bgroup/egroup-delimited file name
+ stop_at_space := false; {set |stop_at_space| to false to allow spaces in file names}
+ begin_name;
+ for i:=str_start[s] to str_start[s+1]-1 do
+ dummy := more_name(str_pool[i]); {add each read character to the current file name}
+@y
+ stop_at_space := false; {set |stop_at_space| to false to allow spaces in file names}
+ begin_name;
+ for i:=str_start_macro(s) to str_start_macro(s+1)-1 do
+ dummy := more_name(str_pool[i]); {add each read character to the current file name}
+@z
+
+@x
+@!mltex_enabled_p:boolean; {enable character substitution}
+@y
+@!mltex_enabled_p:boolean; {enable character substitution}
+@!native_font_type_flag:integer; {used by XeTeX font loading code to record which font technology was used}
+@!xtx_ligature_present:boolean; {to suppress tfm font mapping of char codes from ligature nodes (already mapped)}
+@z
+
+@x [54/web2c.???] l.??? needed earlier
+replacement, but always existing character |font_bc[f]|.
+@^inner loop@>
+
+@<Declare additional functions for ML\TeX@>=
+function effective_char(@!err_p:boolean;
+@y
+replacement, but always existing character |font_bc[f]|.
+@^inner loop@>
+
+@<Declare \eTeX\ procedures for sc...@>=
+function effective_char(@!err_p:boolean;
+@z
+
+@x
+begin result:=c; {return |c| unless it does not exist in the font}
+@y
+begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then
+ c:=apply_tfm_font_mapping(font_mapping[f],c);
+xtx_ligature_present:=false;
+result:=c; {return |c| unless it does not exist in the font}
+@z
+
+@x
+begin if not mltex_enabled_p then
+@y
+begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then
+ c:=apply_tfm_font_mapping(font_mapping[f],c);
+xtx_ligature_present:=false;
+if not mltex_enabled_p then
+@z
+
+@x
+effective_char_info:=null_character;
+exit:end;
+@y
+effective_char_info:=null_character;
+exit:end;
+@#
+@<Declare subroutines for |new_character|@>@;
+@z
diff --git a/Build/source/texk/web2c/xetexdir/xetex.defines b/Build/source/texk/web2c/xetexdir/xetex.defines
new file mode 100644
index 00000000000..c695896a454
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex.defines
@@ -0,0 +1,186 @@
+{
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 2009-2019 by Jonathan Kew
+ Copyright (c) 1994-2008 by SIL International
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+}
+
+{ xetex.defines: additions for xetex }
+
+@define @field ptr;
+@define const nullptr;
+@define type voidpointer;
+@define function getnativechar();
+@define function getnativeusv();
+@define procedure setnativechar();
+@define function getnativeglyph();
+@define procedure setnativemetrics();
+@define procedure setjustifiednativeglyphs();
+@define procedure setnativeglyphmetrics();
+@define function findnativefont();
+@define procedure releasefontengine();
+@define function sizeof();
+@define function makefontdef();
+@define function makexdvglypharraydata();
+@define function xdvbufferbyte();
+@define procedure fprintf();
+@define type unicodefile;
+@define function uopenin();
+@define function uopenout();
+@define procedure uclose();
+@define function dviopenout();
+@define function dviclose();
+@define function delcode1();
+@define procedure setdelcode1();
+@define function readcint1();
+@define procedure setcint1();
+@define procedure printutf8str();
+@define procedure setinputfileencoding();
+@define procedure terminatefontmanager;
+@define procedure checkfortfmfontmapping;
+@define function loadtfmfontmapping;
+@define function applytfmfontmapping();
+
+@define procedure initGraphiteBreaking();
+@define function findNextGraphiteBreak();
+@define function usingOpenType();
+@define function usingGraphite();
+@define procedure grprintfontname();
+@define function grfontgetnamed();
+@define function grfontgetnamed1();
+@define function isOpenTypeMathFont();
+
+@define function strerror();
+@define procedure memcpy();
+@define function glyphinfobyte();
+@define function casttoushort();
+
+@define function aatfontget();
+@define function aatfontget1();
+@define function aatfontget2();
+@define function aatfontgetnamed();
+@define function aatfontgetnamed1();
+@define procedure aatprintfontname();
+@define function otfontget();
+@define function otfontget1();
+@define function otfontget2();
+@define function otfontget3();
+@define function mapchartoglyph();
+@define function mapglyphtoindex();
+@define function getglyphbounds();
+@define procedure getnativecharheightdepth();
+@define procedure getnativecharsidebearings();
+@define function getnativeitaliccorrection();
+@define function getnativeglyphitaliccorrection();
+@define procedure printglyphname();
+@define function getfontcharrange();
+
+@define function getnativecharwd();
+@define function getnativecharht();
+@define function getnativechardp();
+@define function getnativecharic();
+
+@define function getnativemathsyparam();
+@define function getnativemathexparam();
+@define function getotmathconstant();
+@define function getotmathvariant();
+@define function getotassemblyptr();
+@define procedure freeotassembly();
+@define function getotmathitalcorr();
+@define function getotmathaccentpos();
+@define function getotmathkern();
+
+@define function otpartcount();
+@define function otpartglyph();
+@define function otpartstartconnector();
+@define function otpartendconnector();
+@define function otpartfulladvance();
+@define function otpartisextender();
+@define function otminconnectoroverlap();
+
+@define function setfamilyfield();
+@define function setclassfield();
+@define function mathfamfield();
+@define function mathclassfield();
+@define function mathcharfield();
+
+@define procedure aatgetfontmetrics();
+@define procedure otgetfontmetrics();
+
+@define function getencodingmodeandinfo();
+
+@define procedure linebreakstart();
+@define function linebreaknext;
+
+{ extra stuff used in picfile code }
+@define type realpoint;
+@define type realrect;
+@define type transform;
+
+@define function deref();
+
+@define function D2Fix();
+@define function Fix2D();
+
+@define function findpicfile();
+@define function picpathbyte();
+@define function countpdffilepages;
+
+@define procedure makeidentity();
+@define procedure makescale();
+@define procedure maketranslation();
+@define procedure makerotation();
+@define procedure transformpoint();
+@define procedure transformconcat();
+
+@define procedure setPoint();
+
+@define function xCoord();
+@define function yCoord();
+@define function aField();
+@define function bField();
+@define function cField();
+@define function dField();
+@define function xField();
+@define function yField();
+@define function wdField();
+@define function htField();
+@define function applymapping();
+
+@define procedure setcpcode();
+@define function getcpcode();
+@define function getnativewordcp();
+
+@define procedure initstarttime;
+@define procedure getcreationdate;
+@define procedure getfilemoddate();
+@define procedure getfilesize();
+@define procedure getfiledump();
+@define procedure getmd5sum();
diff --git a/Build/source/texk/web2c/xetexdir/xetex.h b/Build/source/texk/web2c/xetexdir/xetex.h
new file mode 100644
index 00000000000..2360e3920ca
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex.h
@@ -0,0 +1,131 @@
+/****************************************************************************\
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/* additional declarations we want to slip in for xetex */
+
+#define native_node_size 6
+#define native_node_text(p) ((unsigned short*)(&(mem[(p) + native_node_size])))
+
+#define getnativechar(p,i) native_node_text(p)[i]
+#define setnativechar(p,i,v) native_node_text(p)[i] = v
+
+#define getnativeusv(p,i) \
+ ((native_node_text(p)[i] >= 0xd800 && native_node_text(p)[i] < 0xdc00) ? \
+ 0x10000 + (native_node_text(p)[i] - 0xd800) * 0x400 + native_node_text(p)[(i)+1] - 0xdc00 : \
+ native_node_text(p)[i])
+
+/* p is native_word node; g is XeTeX_use_glyph_metrics flag */
+#define setnativemetrics(p,g) measure_native_node(&(mem[p]), g)
+
+#define setnativeglyphmetrics(p,g) measure_native_glyph(&(mem[p]), g)
+
+#define setjustifiednativeglyphs(p) store_justified_native_glyphs(&(mem[p]))
+
+#define getnativeitaliccorrection(p) get_native_italic_correction(&(mem[p]))
+#define getnativeglyphitaliccorrection(p) get_native_glyph_italic_correction(&(mem[p]))
+
+#define getnativeglyph(p,i) get_native_glyph(&(mem[p]), i)
+
+#define makexdvglypharraydata(p) makeXDVGlyphArrayData(&(mem[p]))
+#define xdvbufferbyte(i) xdvbuffer[i]
+
+#define getcpcode get_cp_code
+#define setcpcode set_cp_code
+#define getnativewordcp(p,s) get_native_word_cp(&(mem[p]), s)
+
+#define pic_node_size 9
+
+#define deref(p) (*(p))
+
+#define findpicfile(a,b,c,d) find_pic_file(a, b, c, d)
+
+#define picpathbyte(p,i) ((unsigned char*)&(mem[p+pic_node_size]))[i]
+
+#define dviopenout(f) open_dvi_output(&(f))
+
+#define nullptr (NULL)
+#define glyphinfobyte(p,k) ((unsigned char*)p)[k]
+#define casttoushort(x) (unsigned short)(x)
+
+/* easier to do the bit-twiddling here than in Pascal */
+/* read fields from a 32-bit math code */
+#define mathfamfield(x) (((unsigned)(x) >> 24) & 0xFF)
+#define mathclassfield(x) (((unsigned)(x) >> 21) & 0x07)
+#define mathcharfield(x) ((unsigned)(x) & 0x1FFFFF)
+/* calculate pieces to assign to a math code */
+#define setfamilyfield(x) (((unsigned)(x) & 0xFF) << 24)
+#define setclassfield(x) (((unsigned)(x) & 0x07) << 21)
+
+/* aliases */
+#define getnativemathsyparam get_native_mathsy_param
+#define getnativemathexparam get_native_mathex_param
+#define getotmathconstant get_ot_math_constant
+#define getotmathvariant get_ot_math_variant
+#define getotassemblyptr get_ot_assembly_ptr
+#define freeotassembly free_ot_assembly
+#define getotmathitalcorr get_ot_math_ital_corr
+#define getotmathaccentpos get_ot_math_accent_pos
+#define getotmathkern get_ot_math_kern
+#define otpartcount ot_part_count
+#define otpartglyph ot_part_glyph
+#define otpartisextender ot_part_is_extender
+#define otpartstartconnector ot_part_start_connector
+#define otpartendconnector ot_part_end_connector
+#define otpartfulladvance ot_part_full_advance
+#define otminconnectoroverlap ot_min_connector_overlap
+/* prototypes used in xetex.web */
+#include "XeTeXOTMath.h"
+
+/* Unicode file reading modes */
+#define AUTO 0 /* default: will become one of 1..3 at file open time, after sniffing */
+#define UTF8 1
+#define UTF16BE 2
+#define UTF16LE 3
+#define RAW 4
+#define ICUMAPPING 5
+#ifdef WIN32
+#define WIN32CONSOLE 6
+#endif
+
+/* we don't use xchr, so change the cpascal.h definition of this... */
+#undef Xchr
+#define Xchr(x) (x)
+
+#include "trans.h" /* functions for affine transform operations */
+#include <teckit/TECkit_Common.h> /* include this before XeTeX_ext.h */
+#include "XeTeX_ext.h" /* other extension functions */
+
+#include <math.h>
+/* apparently M_PI isn't defined by <math.h> under VC++ */
+#ifndef M_PI
+#define M_PI 3.14159265358979323846
+#endif
diff --git a/Build/source/texk/web2c/xetexdir/xetex.test b/Build/source/texk/web2c/xetexdir/xetex.test
new file mode 100755
index 00000000000..d1a6182ae5a
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex.test
@@ -0,0 +1,9 @@
+#! /bin/sh
+
+# Copyright (C) 2010 Peter Breitenlohner <tex-live@tug.org>
+# You may freely use, modify and/or distribute this file.
+
+# Not really a test, just making sure the program executes.
+
+./xetex -version || exit 1
+
diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web
new file mode 100644
index 00000000000..8aa90220eb4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex.web
@@ -0,0 +1,34345 @@
+% Copyright (c) 1994-2008 by SIL International
+% Copyright (c) 2009-2021 by Jonathan Kew
+% Copyright (c) 2010-2012 by Han The Thanh
+% Copyright (c) 2012-2013 by Khaled Hosny
+
+% SIL Author(s): Jonathan Kew
+
+% Part of the XeTeX typesetting system
+
+% Permission is hereby granted, free of charge, to any person obtaining a copy
+% of this software and associated documentation files (the "Software"), to deal
+% in the Software without restriction, including without limitation the rights
+% to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+% copies of the Software, and to permit persons to whom the Software is
+% furnished to do so, subject to the following conditions:
+
+% The above copyright notice and this permission notice shall be included in all
+% copies or substantial portions of the Software.
+
+% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+% IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+% FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+% COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+% IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+% CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+% Except as contained in this notice, the name of the copyright holders shall
+% not be used in advertising or otherwise to promote the sale, use or other
+% dealings in this Software without prior written authorization from the
+% copyright holders.
+
+% e-TeX is copyright (C) 1999-2012 by P. Breitenlohner (1994,98 by the NTS
+% team); all rights are reserved. Copying of this file is authorized only if
+% (1) you are P. Breitenlohner, or if (2) you make absolutely no changes to
+% your copy. (Programs such as TIE allow the application of several change
+% files to tex.web; the master files tex.web and etex.ch should stay intact.)
+
+% See etex_gen.tex for hints on how to install this program.
+% And see etripman.tex for details about how to validate it.
+
+% e-TeX and NTS are trademarks of the NTS group.
+% TeX is a trademark of the American Mathematical Society.
+% METAFONT is a trademark of Addison-Wesley Publishing Company.
+
+% 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).
+% Version 3.1415926 was a general cleanup with minor fixes (February 2008).
+% Version 3.14159265 was similar (January 2014).
+% Version 3.141592653 was similar but more extensive (January 2021).
+
+% A reward of $327.68 will be paid to the first finder of any remaining bug.
+
+% A preliminary version of TeX--XeT was released in April 1992.
+% TeX--XeT version 1.0 was released in June 1992,
+% version 1.1 prevented arith overflow in glue computation (Oct 1992).
+% A preliminary e-TeX version 0.95 was operational in March 1994.
+% Version 1.0beta was released in May 1995.
+% Version 1.01beta fixed bugs in just_copy and every_eof (December 1995).
+% Version 1.02beta allowed 256 mark classes (March 1996).
+% Version 1.1 changed \group{type,level} -> \currentgroup{type,level},
+% first public release (October 1996).
+% Version 2.0 development was started in March 1997;
+% fixed a ligature-\beginR bug in January 1998;
+% was released in March 1998.
+% Version 2.1 fixed a \marks bug (when min_halfword<>0) (January 1999).
+% Version 2.2 development was started in Feb 2003; released in Oct 2004.
+% fixed a bug in sparse array handling (0=>null), Jun 2002;
+% fixed a bug in \lastnodetype (cur_val=>cur_val_level)
+% reported by Hartmut Henkel <hartmut_henkel@@gmx.de>,
+% fix by Fabrice Popineau <Fabrice.Popineau@@supelec.fr>,
+% Jan 2004;
+% another bug in sparse array handling (cur_ptr=>cur_chr)
+% reported by Taco Hoekwater <taco@@elvenkind.com>, Jul 2004;
+% fixed a sparse array reference count bug (\let,\futurelet),
+% fix by Bernd Raichle <berd@@dante.de>, Aug 2004;
+% reorganized handling of banner, additional token list and
+% integer parameters, and similar in order to reduce the
+% interference between eTeX, pdfTeX, and web2c change files.
+% adapted to tex.web 3.141592, revised glue rounding for mixed
+% direction typesetting;
+% fixed a bug in the revised glue rounding code, detected by
+% Tigran Aivazian <tigran@@aivazian.fsnet.co.uk>, Oct 2004.
+% Version 2.3 development was started in Feb 2008; released in Apr 2011.
+% fixed a bug in hyph_code handling (\savinghyphcodes)
+% reported by Vladimir Volovich <vvv@@vsu.ru>, Feb 2008.
+% fixed the error messages for improper use of \protected,
+% reported by Heiko Oberdiek
+% <heiko.oberdiek@@googlemail.com>, May 2010.
+% some rearrangements to reduce interferences between
+% e-TeX and pTeX, in part suggested by Hironori Kitagawa
+% <h_kitagawa2001@@yahoo.co.jp>, Mar 2011.
+% Version 2.4 fixed an uninitialized line number bug, released in May 2012.
+% Version 2.5 development was started in Aug 2012; released in Feb 2013.
+% better tracing of font definitions, reported by
+% Bruno Le Floch <blflatex@@gmail.com>, Jul 2012.
+% Version 2.6 development was started in Mar 2013; released in ??? 201?.
+% enable hyphenation of text between \beginL and \endL or
+% between \beginR and \endR, problem reported by
+% Vafa Khalighi <vafalgk@@gmail.com>, Nov 2013.
+% better handling of right-to-left text -- to be done.
+
+% Although considerable effort has been expended to make the e-TeX program
+% correct and reliable, no warranty is implied; the author disclaims 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 author hopes that users enjoy it.
+
+% Here is TeX material that gets inserted after \input webmac
+\input xewebmac
+\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\mirror#1{%
+ \phantom{#1}%
+ \rlap{\special{pdf:btrans xscale -1}#1\special{pdf:etrans}}%
+}
+\def\XeTeX{X\kern-.125em\lower.5ex\hbox{\mirror{E}}\kern-.1667em\TeX}
+
+\def\eTeX{$\varepsilon$-\TeX}
+\font\revrm=xbmc10 % for right-to-left text
+% to generate xbmc10 (i.e., reflected cmbx10) use a file
+% xbmc10.mf containing:
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+% if unknown cmbase: input cmbase fi
+% extra_endchar := extra_endchar &
+% "currentpicture:=currentpicture " &
+% "reflectedabout((.5[l,r],0),(.5[l,r],1));";
+% input cmbx10
+%+++++++++++++++++++++++++++++++++++++++++++++++++
+\TeXXeTstate=1
+\def\XeT{X\kern-.125em\lower.424ex\hbox{E}\kern-.1667emT}
+\def\TeXXeT{\TeX-{}-\XeT} % for TeX--XeT
+\def\TeXeT{\TeX-{\revrm\beginR\TeX\endR}} % for TeX-XeT
+\def\PASCAL{Pascal}
+\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{\XeTeX}
+% system dependent redefinitions of \title should come later
+% and should use:
+% \toks0=\expandafter{\title}
+% \edef\title{...\the\toks0...}
+\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 \XeTeX, a program derived from and extending the capabilities of
+\TeX, a document compiler intended to produce typesetting of high
+quality.
+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
+@^Trabb Pardo, Luis Isidoro@>
+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 `\XeTeX' 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=2 { \.{\\eTeXversion} }
+@d eTeX_revision==".6" { \.{\\eTeXrevision} }
+@d eTeX_version_string=='-2.6' {current \eTeX\ version}
+@#
+@d XeTeX_version=0 { \.{\\XeTeXversion} }
+@d XeTeX_revision==".999993" { \.{\\XeTeXrevision} }
+@d XeTeX_version_string=='-0.999993' {current \XeTeX\ version}
+@#
+@d XeTeX_banner=='This is XeTeX, Version 3.141592653',eTeX_version_string,XeTeX_version_string
+ {printed when \XeTeX\ starts}
+@#
+@d banner=='This is TeX, Version 3.141592653' {printed when \TeX\ starts}
+@#
+@d TEX==XETEX {change program name into |XETEX|}
+@#
+@d TeXXeT_code=0 {the \TeXXeT\ feature is optional}
+@#
+@d XeTeX_dash_break_code=1 {non-zero to enable breaks after en- and em-dashes}
+@#
+@d XeTeX_upwards_code=2 {non-zero if the main vertical list is being built upwards}
+@d XeTeX_use_glyph_metrics_code=3 {non-zero to use exact glyph height/depth}
+@d XeTeX_inter_char_tokens_code=4 {non-zero to enable \.{\\XeTeXinterchartokens} insertion}
+@#
+@d XeTeX_input_normalization_code=5 {normalization mode:, 1 for NFC, 2 for NFD, else none}
+@#
+@d XeTeX_default_input_mode_code=6 {input mode for newly opened files}
+@d XeTeX_input_mode_auto=0
+@d XeTeX_input_mode_utf8=1
+@d XeTeX_input_mode_utf16be=2
+@d XeTeX_input_mode_utf16le=3
+@d XeTeX_input_mode_raw=4
+@d XeTeX_input_mode_icu_mapping=5
+@#
+@d XeTeX_default_input_encoding_code=7 {|str_number| of encoding name if |mode =| ICU}
+@#
+@d XeTeX_tracing_fonts_code=8 {non-zero to log native fonts used}
+@d XeTeX_interword_space_shaping_code=9 { controls shaping of space chars in context when using native fonts;
+ set to 1 for contextual adjustment of space width only,
+ and 2 for full cross-space shaping (e.g. multi-word ligatures) }
+@d XeTeX_generate_actual_text_code=10 { controls output of /ActualText for native-word nodes }
+@d XeTeX_hyphenatable_length_code=11 { sets maximum hyphenatable word length }
+@d eTeX_states=12 {number of \eTeX\ state variables in |eqtb|}
+
+@ 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 and 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.
+@:PASCAL H}{\ph@>
+@^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},
+\.{\\tracingpages}, and \.{\\tracingrestores}.
+@^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.
+@:PASCAL H}{\ph@>
+@^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!)
+@:PASCAL H}{\ph@>
+
+@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...@>=
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!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}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!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|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!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@>
+
+@ 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 mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@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 |(mem_max-mem_min)/10|}
+@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@d biggest_char=65535 {the largest allowed character number;
+ must be |<=max_quarterword|, this refers to UTF16 codepoints that we store in strings, etc;
+ actual character codes can exceed this range, up to |biggest_usv|}
+@d too_big_char=65536 {|biggest_char+1|}
+@d biggest_usv=@"10FFFF {the largest Unicode Scalar Value}
+@d too_big_usv=@"110000 {|biggest_usv+1|}
+@d number_usvs=@"110000 {|biggest_usv+1|}
+@d special_char=@"110001 {|biggest_usv+2|}
+@d biggest_reg=255 {the largest allowed register number;
+ must be |<=max_quarterword|}
+@d number_regs=256 {|biggest_reg+1|}
+@d font_biggest=255 {the real biggest font}
+@d number_fonts=font_biggest-font_base+2
+@d number_math_families=256
+@d number_math_fonts=number_math_families+number_math_families+number_math_families
+@d math_font_biggest=number_math_fonts-1
+@d text_size=0 {size code for the largest size in a family}
+@d script_size=number_math_families {size code for the medium size in a family}
+@d script_script_size=number_math_families+number_math_families {size code for the smallest size in a family}
+@d biggest_lang=255 {the largest hyphenation language}
+@d too_big_lang=256 {|biggest_lang+1|}
+@d hyphenatable_length_limit=4095 {hard limit for hyphenatable length; runtime value is |max_hyphenatable_length|}
+@^system dependencies@>
+
+@ 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?}
+
+@ Later on we will say `\ignorespaces|if mem_max>=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 (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 mem_bot+1100>mem_top then bad:=4;
+if hash_prime>hash_size then bad:=5;
+if max_in_open>=128 then bad:=6;
+if mem_top<256+11 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 == {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 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.
+
+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.
+For xetex, we rename |ASCII_code| as |UTF16_code|. But we also have a
+new type |UTF8_code|, used when we construct filenames to pass to the
+system libraries.
+
+@d ASCII_code==UTF16_code
+@d packed_ASCII_code==packed_UTF16_code
+
+@<Types...@>=
+@!ASCII_code=0..biggest_char; {16-bit numbers}
+@!UTF8_code=0..255; {8-bit numbers}
+@!UnicodeScalar=0..biggest_usv; {Unicode scalars}
+
+@ 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=biggest_char {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@>
+
+@ 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 @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[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...@>=
+for i:=0 to @'176 do 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.
+
+\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..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of 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 |name_of_file| 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
+|name_of_file|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!name_of_file:packed array[1..file_name_size] of char;@;@/
+ {on some systems this may be a \&{record} variable}
+@!name_of_file16:array[1..file_name_size] of UTF16_code;@;@/
+ {but sometimes we need a UTF16 version of the name}
+@!name_length:0..file_name_size;@/{this many characters are actually
+ relevant in |name_of_file| (the rest are blank)}
+@!name_length16:0..file_name_size;
+
+@ 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
+|name_of_file| 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,name_of_file,'/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,name_of_file,'/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,name_of_file,'/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,name_of_file,'/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,name_of_file,'/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,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+
+@ Files can be closed with the \ph\ routine `|close(f)|', which
+@:PASCAL H}{\ph@>
+@^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;
+
+@ 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
+|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 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 |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 |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 |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 |input_ln|.
+
+If the |bypass_eoln| parameter is |true|, |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 |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]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ 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|.
+@:PASCAL H}{\ph@>
+@^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:
+@:PASCAL H}{\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 write_ln(term_out,'Buffer size exceeded!'); goto final_end;
+@.Buffer size exceeded@>
+ end
+else begin cur_input.loc_field:=first; cur_input.limit_field:=last-1;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+
+@ 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 write_ln(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;
+ write_ln(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 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 `\..'; but some ASCII codes have no standard visible
+representation, and \TeX\ sometimes needs 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.
+
+Elements of the |str_pool| array must be ASCII codes that can actually
+be printed; i.e., they must have an |xchr| equivalent in the local
+character set. (This restriction applies only to preloaded strings,
+not to those generated dynamically by the user.)
+
+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.
+@^system dependencies@>
+
+@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[(#) - too_big_char]
+
+@<Types...@>=
+@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|}
+@!str_number = 0..max_strings; {for variables that point into |str_start|}
+@!packed_ASCII_code = 0..biggest_char; {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@>
+
+@p function length(s:str_number):integer;
+ {the number of characters in string number |s|}
+begin if (s>=@"10000) then length:=str_start_macro(s+1)-str_start_macro(s)
+else if (s>=@"20) and (s<@"7F) then length:=1
+else if (s<=@"7F) then length:=3
+else if (s<@"100) then length:=4
+else length:=8
+end;
+
+@ 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(#) == {make sure that the pool hasn't overflowed}
+ begin if pool_ptr+# > pool_size then
+ overflow("pool size",pool_size-init_pool_ptr);
+@:TeX capacity exceeded pool size}{\quad pool size@>
+ 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 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|.
+
+@d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr);
+ end
+
+@p procedure append_str(@!s:str_number); { append an existing string to the current string }
+var i: integer;
+ j: pool_pointer;
+begin
+ i:=length(s);
+ str_room(i);
+ j:=str_start_macro(s);
+ while (i > 0) do begin
+ append_char(str_pool[j]);
+ incr(j); decr(i);
+ end;
+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}
+@!result: boolean; {result of comparison}
+begin j:=str_start_macro(s);
+while j<str_start_macro(s+1) do
+ begin
+ if buffer[k]>=@"10000 then
+ if so(str_pool[j])<>@"D800+(buffer[k]-@"10000)div@"400 then
+ begin result:=false; goto not_found;
+ end
+ else if so(str_pool[j+1])<>@"DC00+(buffer[k]-@"10000)mod@"400 then
+ begin result:=false; goto not_found;
+ end
+ else incr(j)
+ else if so(str_pool[j])<>buffer[k] then
+ begin result:=false; goto not_found;
+ end;
+ incr(j); incr(k);
+ 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 not_found; {loop exit}
+var j,@!k: pool_pointer; {running indices}
+@!result: boolean; {result of comparison}
+begin result:=false;
+if length(s)<>length(t) then goto not_found;
+if (length(s)=1) then begin
+ if s<65536 then begin
+ if t<65536 then begin
+ if s<>t then goto not_found;
+ end
+ else begin
+ if s<>str_pool[str_start_macro(t)] then goto not_found;
+ end;
+ end
+ else begin
+ if t<65536 then begin
+ if str_pool[str_start_macro(s)]<>t then goto not_found;
+ end
+ else begin
+ if str_pool[str_start_macro(s)]<>str_pool[str_start_macro(t)] then
+ goto not_found;
+ end;
+ end;
+ end
+else begin
+ 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;
+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@>
+
+@p @!init function get_strings_started:boolean; {initializes the string pool,
+ but returns |false| if something goes wrong}
+label done,exit;
+var
+@!m,@!n:text_char; {characters input from |pool_file|}
+@!g:str_number; {garbage}
+@!a:integer; {accumulator for check sum}
+@!c:boolean; {check sum has been checked}
+begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0;
+@<Make the first 256 strings@>;
+@<Read the other strings from the \.{TEX.POOL} file and return |true|,
+ or give an error message and return |false|@>;
+exit:end;
+tini
+
+@ The first 65536 strings will consist of a single character only.
+But we don't actually make them; they're simulated on the fly.
+
+@<Make the first 256...@>=
+begin
+str_ptr:=too_big_char;
+str_start_macro(str_ptr):=pool_ptr;
+end
+
+@ 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}.
+
+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, @'136, @'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@>
+
+@ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB}
+description that you are now reading, it outputs the \PASCAL\ program
+\.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX}
+@.WEB@>@.INITEX@>
+program reads the latter file, where each string appears as a two-digit decimal
+length followed by the string itself, and the information is recorded in
+\TeX's string memory.
+
+@<Glob...@>=
+@!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}}
+tini
+
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
+ a_close(pool_file); get_strings_started:=false; return;
+ end
+@<Read the other strings...@>=
+name_of_file:=pool_name; {we needn't set |name_length|}
+if a_open_in(pool_file) then
+ begin c:=false;
+ repeat @<Read one string, but return |false| if the
+ string memory space is getting too tight for comfort@>;
+ until c;
+ a_close(pool_file); get_strings_started:=true;
+ end
+else bad_pool('! I can''t read TEX.POOL.')
+@.I can't read TEX.POOL@>
+
+@ @<Read one string...@>=
+begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.');
+@.TEX.POOL has no check sum@>
+read(pool_file,m,n); {read two digits of string length}
+if m='*' then @<Check the pool check sum@>
+else begin if (xord[m]<"0")or(xord[m]>"9")or@|
+ (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL line doesn''t begin with two digits.');
+@.TEX.POOL line doesn't...@>
+ l:=xord[m]*10+xord[n]-"0"*11; {compute the length}
+ if pool_ptr+l+string_vacancies>pool_size then
+ bad_pool('! You have to increase POOLSIZE.');
+@.You have to increase POOLSIZE@>
+ for k:=1 to l do
+ begin if eoln(pool_file) then m:=' '@+else read(pool_file,m);
+ append_char(xord[m]);
+ end;
+ read_ln(pool_file); g:=make_string;
+ end;
+end
+
+@ The \.{WEB} operation \.{@@\$} denotes the value that should be at the
+end of this \.{TEX.POOL} file; any other value means that the wrong pool
+file has been loaded.
+@^check sum@>
+
+@<Check the pool check sum@>=
+begin a:=0; k:=1;
+loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then
+ bad_pool('! TEX.POOL check sum doesn''t have nine digits.');
+@.TEX.POOL check sum...@>
+ a:=10*a+xord[n]-"0";
+ if k=9 then goto done;
+ incr(k); read(pool_file,n);
+ end;
+done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.');
+@.TEX.POOL doesn't match@>
+c:=true;
+end
+
+@* \[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}
+@!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 ASCII_code; {circular buffer for
+ pseudoprinting}
+@!trick_count: integer; {threshold for pseudoprinting, explained later}
+@!first_count: integer; {another variable for pseudoprinting}
+
+@ @<Initialize the output routines@>=
+selector:=term_only; tally:=0; term_offset:=0; 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| in this section.
+@^system dependencies@>
+
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@d wlog(#)==write(log_file,#)
+@d wlog_ln(#)==write_ln(log_file,#)
+@d wlog_cr==write_ln(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 write_ln(write_file[selector])
+endcases;@/
+end; {|tally| is not affected}
+
+@ The |print_raw_char| procedure sends one character to the desired destination,
+using the |xchr| array to map it into an external character compatible with
+|input_ln|. All printing comes through |print_ln|, |print_char| or
+|print_visible_char|. When printing a multi-byte character, the boolean
+parameter |incr_offset| is set |false| except for the very last byte, to avoid
+calling |print_ln| in the middle of such character.
+
+@<Basic printing...@>=
+procedure print_raw_char(@!s:ASCII_code;@!incr_offset:boolean); {prints a single character}
+label exit; {label is not used but nonetheless kept (for other changes?)}
+begin
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ if incr_offset then
+ begin incr(term_offset); incr(file_offset);
+ end;
+ 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 wlog(xchr[s]);
+ if incr_offset then incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]);
+ if incr_offset then 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;
+
+@ The |print_char| procedure sends one character to the desired destination.
+Control sequence names, file names and string constructed with
+\.{\\string} might contain |ASCII_code| values that can't
+be printed using |print_raw_char|. These characters will be printed
+in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}',
+unless the -8bit option is enabled.
+Output that goes to the terminal and/or log file is treated differently
+when it comes to determining whether a character is printable.
+
+@d print_visible_char(#)==print_raw_char(#, true)
+@d print_lc_hex(#)==l:=#;
+ if l<10 then print_visible_char(l+"0")@+else print_visible_char(l-10+"a")
+
+@<Basic printing...@>=
+procedure print_char(@!s:integer); {prints a single character}
+label exit;
+var l: small_number;
+begin if (selector>pseudo) and (not doing_special) then
+ {``printing'' to a new string, encode as UTF-16 rather than UTF-8}
+ begin if s>=@"10000 then
+ begin print_visible_char(@"D800 + (s - @"10000) div @"400);
+ print_visible_char(@"DC00 + (s - @"10000) mod @"400);
+ end else print_visible_char(s);
+ return;
+ end;
+if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+ if (s < 32) and (eight_bit_p = 0) and (not doing_special) then {control char: \.{\^\^X}}
+ begin print_visible_char("^"); print_visible_char("^"); print_visible_char(s+64);
+ end
+ else if s < 127 then { printable ASCII }
+ print_visible_char(s)
+ else if (s = 127) then { DEL }
+ begin if (eight_bit_p = 0) and (not doing_special) then
+ begin print_visible_char("^"); print_visible_char("^"); print_visible_char("?")
+ end else
+ print_visible_char(s)
+ end
+ else if (s < @"A0) and (eight_bit_p = 0) and (not doing_special) then {C1 controls: \.{\^\^xx}}
+ begin print_visible_char("^"); print_visible_char("^");
+ print_lc_hex((s mod @"100) div @"10); print_lc_hex(s mod @"10);
+ end
+ else if selector=pseudo then
+ print_visible_char(s) { Don't UTF8-encode text in |trick_buf|,
+ we'll handle that when printing error context. }
+ else begin
+ { |char >= 128|: encode as UTF8 }
+ if s<@"800 then begin
+ print_raw_char(@"C0 + s div @"40, false);
+ print_raw_char(@"80 + s mod @"40, true);
+ end
+ else if s<@"10000 then begin
+ print_raw_char(@"E0 + (s div @"1000), false);
+ print_raw_char(@"80 + (s mod @"1000) div @"40, false);
+ print_raw_char(@"80 + (s mod @"40), true);
+ end
+ else begin
+ print_raw_char(@"F0 + (s div @"40000), false);
+ print_raw_char(@"80 + (s mod @"40000) div @"1000, false);
+ print_raw_char(@"80 + (s mod @"1000) div @"40, false);
+ print_raw_char(@"80 + (s mod @"40), true);
+ end
+ end;
+exit:end;
+
+@ @d native_room(#)==while native_text_size <= native_len+# do begin
+ native_text_size:=native_text_size+128;
+ native_text:=xrealloc(native_text, native_text_size * sizeof(UTF16_code));
+ end
+@d append_native(#)==begin native_text[native_len]:=#; incr(native_len); end
+
+@ @<Glob...@>=
+@!doing_special: boolean;
+@!native_text: ^UTF16_code; { buffer for collecting native-font strings }
+@!native_text_size: integer; { size of buffer }
+@!native_len: integer;
+@!save_native_len: integer;
+
+@ @<Set init...@>=
+doing_special:=false;
+native_text_size:=128;
+native_text:=xmalloc(native_text_size * sizeof(UTF16_code));
+
+@ 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@>
+
+@<Basic print...@>=
+procedure print(@!s:integer); {prints string |s|}
+label exit;
+var j:pool_pointer; {current character code position}
+@!nl:integer; {new-line character to restore}
+begin if s>=str_ptr then s:="???" {this can't happen}
+@.???@>
+else if s<biggest_char then
+ if s<0 then s:="???" {can't happen}
+ else begin if 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;
+ nl:=new_line_char;
+ new_line_char:=-1;
+ print_char(s);
+ new_line_char:=nl;
+ return;
+ end;
+j:=str_start_macro(s);
+while j<str_start_macro(s+1) do begin
+ if (so(str_pool[j])>=@"D800) and (so(str_pool[j])<=@"DBFF)
+ and (j+1<str_start_macro(s+1))
+ and (so(str_pool[j+1])>=@"DC00) and (so(str_pool[j+1])<=@"DFFF) then
+ begin print_char(@"10000 + (so(str_pool[j])-@"D800) * @"400
+ + so(str_pool[j+1])-@"DC00); j:=j+2;
+ end
+ else begin print_char(so(str_pool[j])); incr(j);
+ end;
+end;
+exit:end;
+
+@ Old versions of \TeX\ needed a procedure called |slow_print| whose function
+is now subsumed by |print| and the new functionality of |print_char| and
+|print_visible_char|. We retain the old name |slow_print| here as a
+possible aid to future software arch\ae ologists.
+
+@d slow_print == print
+
+@ 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 this
+part of the program is system dependent.
+@^system dependencies@>
+
+@<Initialize the output...@>=
+wterm(banner);
+if format_ident=0 then wterm_ln(' (no format preloaded)')
+else begin slow_print(format_ident); print_ln;
+ end;
+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...@>=
+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;
+
+@ 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<=biggest_usv then print_char(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 $\vert n\vert<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
+
+@ 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|.
+
+@d prompt_input(#)==begin wake_up_terminal; print(#); term_input;
+ end {prints a string and gets a line of input}
+
+@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(#);
+ end
+
+@<Glob...@>=
+@!interaction:batch_mode..error_stop_mode; {current level of interaction}
+
+@ @<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}
+
+@<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}
+@!s1,@!s2,@!s3,@!s4:integer;
+ {used to save global variables when deleting tokens}
+begin if history<error_message_issued then history:=error_message_issued;
+print_char("."); 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: if interaction<>error_stop_mode then return;
+ 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 if input_stack[base_ptr].name_field>=256 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 if input_stack[base_ptr].name_field>=256 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 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;
+
+@ 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@>
+
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \TeX\ pause for instructions?}
+@!OK_to_interrupt:boolean; {should interrupts be observed?}
+
+@ @<Set init...@>=
+interrupt:=0; OK_to_interrupt:=true;
+
+@ 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 an instruction 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..hyphenatable_length_limit; {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}}
+\def\pdfTeX{pdf\TeX}
+
+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.
+
+Since we are assuming 32-bit integers, a halfword must contain at least
+16 bits, and a quarterword must contain at least 8 bits.
+@^system dependencies@>
+But it doesn't hurt to have more bits; for example, with enough 36-bit
+words you might be able to have |mem_max| as large as 262142, which is
+eight times as much memory as anybody had during the first four years of
+\TeX's existence.
+
+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.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
+@d min_halfword==-@"FFFFFFF {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''...@>=
+init if (mem_min<>mem_bot)or(mem_max<>mem_top) then bad:=10;@+tini@;@/
+if (mem_min>mem_bot)or(mem_max<mem_top) then bad:=10;
+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 (mem_min<min_halfword)or(mem_max>=max_halfword)or@|
+ (mem_bot-mem_min>max_halfword+1) then bad:=14;
+if (font_base<min_quarterword)or(font_max>max_quarterword) then bad:=15;
+if font_max>font_base+256 then bad:=16;
+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 = gzFile;
+
+@ 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 a large array |mem| 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==min_halfword {the null pointer}
+
+@<Glob...@>=
+@!temp_ptr:pointer; {a pointer variable for occasional emergency use}
+
+@ 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 |mem_bot| and |mem_top| may be dumped as part
+of preloaded format files, by the \.{INITEX} preprocessor.
+@.INITEX@>
+Production versions of \TeX\ may extend the memory at both ends in order to
+provide more space; locations between |mem_min| and |mem_bot| are always
+used for variable-size nodes, and 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:
+$$\advance\thickmuskip-2mu
+\hbox{|null<=mem_min<=mem_bot<lo_mem_max<
+ hi_mem_min<mem_top<=mem_end<=mem_max|.}$$
+
+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.
+
+@<Glob...@>=
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@!lo_mem_max : pointer; {the largest location of variable-size memory in use}
+@!hi_mem_min : pointer; {the smallest 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 |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(#) == mem[#].hh.rh {the |link| field of a memory word}
+@d info(#) == mem[#].hh.lh {the |info| field of a memory word}
+
+@<Glob...@>=
+@!avail : pointer; {head of the list of available one-word nodes}
+@!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 |mem_end|. If that cannot be done, i.e., if
+|mem_end=mem_max|, we try to decrease |hi_mem_min|. If that cannot be
+done, i.e., if |hi_mem_min=lo_mem_max+1|, we have to quit.
+
+@p function get_avail : pointer; {single-word node allocation}
+var p:pointer; {the new node being got}
+begin p:=avail; {get top location in the |avail| stack}
+if p<>null then avail:=link(avail) {and pop it off}
+else if mem_end<mem_max then {or go into virgin territory}
+ begin incr(mem_end); p:=mem_end;
+ end
+else begin decr(hi_mem_min); p:=hi_mem_min;
+ if hi_mem_min<=lo_mem_max then
+ begin runaway; {if memory is exhausted, display possible runaway text}
+ overflow("main memory size",mem_max+1-mem_min);
+ {quit; all one-word nodes are busy}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+ 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|.
+
+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(#) == (link(#)=empty_flag) {tests for empty node}
+@d node_size == info {the size field in empty variable-size nodes}
+@d llink(#) == info(#+1) {left link in doubly-linked list of empty nodes}
+@d rlink(#) == link(#+1) {right link in doubly-linked list of empty nodes}
+
+@<Glob...@>=
+@!rover : pointer; {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|.
+
+@p function get_node(@!s:integer):pointer; {variable-size node allocation}
+label found,exit,restart;
+var p:pointer; {the node currently under inspection}
+@!q:pointer; {the node physically after node |p|}
+@!r:integer; {the newly allocated node, or a candidate for this honor}
+@!t:integer; {temporary register}
+begin restart: p:=rover; {start at some free node in the ring}
+repeat @<Try to allocate within node |p| and its physical successors,
+ and |goto found| if allocation was possible@>;
+@^inner loop@>
+p:=rlink(p); {move to the next node in the ring}
+until p=rover; {repeat until the whole list has been traversed}
+if s=@'10000000000 then
+ begin get_node:=max_halfword; return;
+ end;
+if lo_mem_max+2<hi_mem_min then if lo_mem_max+2<=mem_bot+max_halfword then
+ @<Grow more variable-size memory and |goto restart|@>;
+overflow("main memory size",mem_max+1-mem_min);
+ {sorry, nothing satisfactory is left}
+@:TeX capacity exceeded main memory size}{\quad main memory size@>
+found: link(r):=null; {this node is now nonempty}
+@!stat var_used:=var_used+s; {maintain usage statistics}
+tats@;@/
+get_node:=r;
+exit:end;
+
+@ 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 \TeX\ is
+implemented on ``virtual memory'' systems.
+@^virtual memory@>
+
+@<Grow more variable-size memory and |goto restart|@>=
+begin if hi_mem_min-lo_mem_max>=1998 then t:=lo_mem_max+1000
+else t:=lo_mem_max+1+(hi_mem_min-lo_mem_max) div 2;
+ {|lo_mem_max+2<=t<hi_mem_min|}
+p:=llink(rover); q:=lo_mem_max; rlink(p):=q; llink(rover):=q;@/
+if t>mem_bot+max_halfword then t:=mem_bot+max_halfword;
+rlink(q):=rover; llink(q):=p; link(q):=empty_flag; node_size(q):=t-lo_mem_max;@/
+lo_mem_max:=t; link(lo_mem_max):=null; info(lo_mem_max):=null;
+rover:=q; goto restart;
+end
+
+@ Empirical tests show that the routine in this section performs a
+node-merging operation about 0.75 times per allocation, on the average,
+after which it finds that |r>p+1| about 95\pct! of the time.
+
+@<Try to allocate...@>=
+q:=p+node_size(p); {find the physical successor}
+@^inner loop@>
+while is_empty(q) do {merge node |p| with node |q|}
+ begin t:=rlink(q);
+ if q=rover then rover:=t;
+ llink(t):=llink(q); rlink(llink(q)):=t;@/
+ q:=q+node_size(q);
+ end;
+r:=q-s;
+if r>p+1 then @<Allocate from the top of node |p| and |goto found|@>;
+if r=p then if rlink(p)<>p then
+ @<Allocate entire node |p| and |goto found|@>;
+node_size(p):=q-p {reset the size in case it grew}
+
+@ @<Allocate from the top...@>=
+begin node_size(p):=r-p; {store the remaining size}
+@^inner loop@>
+rover:=p; {start searching here next time}
+goto found;
+end
+
+@ Here we delete node |p| from the ring, and let |rover| rove around.
+
+@<Allocate entire...@>=
+begin rover:=rlink(p); t:=llink(p);
+llink(rover):=t; rlink(t):=rover;
+goto found;
+end
+
+@ 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.
+@^inner loop@>
+
+@p procedure free_node(@!p:pointer; @!s:halfword); {variable-size node
+ liberation}
+var q:pointer; {|llink(rover)|}
+begin node_size(p):=s; link(p):=empty_flag;
+q:=llink(rover); llink(p):=q; rlink(p):=rover; {set both links}
+llink(rover):=p; rlink(q):=p; {insert |p| into the ring}
+@!stat var_used:=var_used-s;@+tats@;{maintain statistics}
+end;
+
+@ Just before \.{INITEX} 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.
+
+@p @!init procedure sort_avail; {sorts the available variable-size nodes
+ by location}
+var p,@!q,@!r: pointer; {indices into |mem|}
+@!old_rover:pointer; {initial |rover| setting}
+begin p:=get_node(@'10000000000); {merge adjacent free areas}
+p:=rlink(rover); rlink(rover):=max_halfword; old_rover:=rover;
+while p<>old_rover do @<Sort \(p)|p| into the list starting at |rover|
+ and advance |p| to |rlink(p)|@>;
+p:=rover;
+while rlink(p)<>max_halfword do
+ begin llink(rlink(p)):=p; p:=rlink(p);
+ end;
+rlink(p):=rover; llink(rover):=p;
+end;
+tini
+
+@ 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)|p|...@>=
+if p<rover then
+ begin q:=p; p:=rlink(q); rlink(q):=rover; rover:=q;
+ end
+else begin q:=rover;
+ while rlink(q)<p do q:=rlink(q);
+ r:=rlink(p); rlink(p):=rlink(q); rlink(q):=p; p:=r;
+ end
+
+@* \[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(#) == mem[#].hh.b0 {identifies what kind of node this is}
+@d subtype(#) == mem[#].hh.b1 {secondary identification in some cases}
+
+@ 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.
+
+@d is_char_node(#) == (#>=hi_mem_min)
+ {does the argument point to a |char_node|?}
+@d font == type {the font code in a |char_node|}
+@d character == subtype {the character code in a |char_node|}
+
+@ 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|,
+|fil|, |fill|, or |filll|). The |subtype| field is not used in \TeX.
+In \eTeX\ the |subtype| field records the box direction mode |box_lr|.
+
+@d hlist_node=0 {|type| of hlist nodes}
+@d box_node_size=7 {number of words to allocate for a box node}
+@d width_offset=1 {position of |width| field in a box node}
+@d depth_offset=2 {position of |depth| field in a box node}
+@d height_offset=3 {position of |height| field in a box node}
+@d width(#) == mem[#+width_offset].sc {width of the box, in sp}
+@d depth(#) == mem[#+depth_offset].sc {depth of the box, in sp}
+@d height(#) == mem[#+height_offset].sc {height of the box, in sp}
+@d shift_amount(#) == mem[#+4].sc {repositioning distance, in sp}
+@d list_offset=5 {position of |list_ptr| field in a box node}
+@d list_ptr(#) == link(#+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 = 6 {position of |glue_set| in a box node}
+@d glue_set(#) == mem[#+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|, for historic reasons
+that are no longer relevant.)
+
+@p function new_null_box:pointer; {creates a new box node}
+var p:pointer; {the new node}
+begin p:=get_node(box_node_size); type(p):=hlist_node;
+subtype(p):=min_quarterword;
+width(p):=0; depth(p):=0; height(p):=0; shift_amount(p):=0; list_ptr(p):=null;
+glue_sign(p):=normal; glue_order(p):=normal; set_glue_ratio_zero(glue_set(p));
+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=4 {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}
+
+@ 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:=get_node(rule_node_size); type(p):=rule_node;
+subtype(p):=0; {the |subtype| is not used}
+width(p):=null_flag; depth(p):=null_flag; height(p):=null_flag;
+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=5 {number of words to allocate for an insertion}
+@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used}
+@d ins_ptr(#)==info(#+4) {the vertical list to be inserted}
+@d split_top_ptr(#)==link(#+4) {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 small_node_size=2 {number of words to allocate for most node types}
+@d mark_ptr(#)==link(#+1) {head of the token list for a mark}
+@d mark_class(#)==info(#+1) {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_pre == subtype {|if subtype <>0| it is pre-adjustment}
+@#{|append_list| is used to append a list to |tail|}
+@d append_list(#) == begin link(tail):=link(#); append_list_end
+@d append_list_end(#) == tail:=#; end
+@d adjust_ptr(#)==mem[#+1].int
+ {vertical list to be moved out of horizontal list}
+
+@ A |ligature_node|, which occurs only in horizontal lists, specifies
+a character that was fabricated from the interaction of two or more
+actual characters. The second word of the node, which is called the
+|lig_char| word, contains |font| and |character| fields just as in a
+|char_node|. The characters that generated the ligature have not been
+forgotten, since they are needed for diagnostic messages and for
+hyphenation; 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 is 0, plus 2 and/or 1 if the original source of the
+ligature included implicit left and/or right boundaries.
+
+@d ligature_node=6 {|type| of a ligature node}
+@d lig_char(#)==#+1 {the word where the ligature is to be found}
+@d lig_ptr(#)==link(lig_char(#)) {the list of characters}
+
+@ The |new_ligature| function creates a ligature node having given
+contents of the |font|, |character|, and |lig_ptr| fields. We also have
+a |new_lig_item| function, which returns a two-word node having a given
+|character| field. Such nodes are used for temporary processing as ligatures
+are being created.
+
+@p function new_ligature(@!f,@!c:quarterword; @!q:pointer):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=ligature_node;
+font(lig_char(p)):=f; character(lig_char(p)):=c; lig_ptr(p):=q;
+subtype(p):=0; new_ligature:=p;
+end;
+@#
+function new_lig_item(@!c:quarterword):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); character(p):=c; lig_ptr(p):=null;
+new_lig_item:=p;
+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 the next
+|replace_count(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 |replace_count=0|. All three of the discretionary texts must be
+lists that consist entirely of character, kern, box, rule, and ligature nodes.
+
+If |pre_break(p)=null|, 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 replace_count==subtype {how many subsequent nodes to replace}
+@d pre_break==llink {text that precedes a discretionary break}
+@d post_break==rlink {text that follows a discretionary break}
+
+@p function new_disc:pointer; {creates an empty |disc_node|}
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=disc_node;
+replace_count(p):=0; pre_break(p):=null; post_break(p):=null;
+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}
+
+@ To support ``native'' fonts, we build |native_word_node|s, which are variable
+size whatsits. These have the same |width|, |depth|, and |height| fields as a
+|box_node|, at offsets 1-3, and then a word containing a size field for the
+node, a font number, a length, and a glyph count. Then there is a field
+containing a C pointer to a glyph info array; this and the glyph count are set
+by |set_native_metrics|. Copying and freeing of these nodes needs to take
+account of this! This is followed by |2*length| bytes, for the actual
+characters of the string (in UTF-16).
+
+So |native_node_size|, which does not include any space for the actual text, is
+6.
+
+0-3 whatsits subtypes are used for open, write, close, special; 4 is language;
+pdf\TeX\ uses up through 30-something, so we use subtypes starting from 40.
+
+There are also |glyph_node|s; these are like |native_word_node|s in having
+|width|, |depth|, and |height| fields, but then they contain a glyph ID rather
+than size and length fields, and there's no subsidiary C pointer.
+
+@d native_word_node=40 {|subtype| of whatsits that hold |native_font| words}
+@d native_word_node_AT=41 {a |native_word_node| that should output ActualText}
+@d is_native_word_subtype(#)==((subtype(#)>=native_word_node) and (subtype(#)<=native_word_node_AT))
+
+@d glyph_node=42 {|subtype| in whatsits that hold glyph numbers}
+
+@d native_node_size=6 {size of a |native_word| node (plus the actual chars) -- see also \.{xetex.h}}
+@d glyph_node_size=5
+@d native_size(#)==mem[#+4].qqqq.b0
+@d native_font(#)==mem[#+4].qqqq.b1
+@d native_length(#)==mem[#+4].qqqq.b2
+@d native_glyph_count(#)==mem[#+4].qqqq.b3
+@d native_glyph_info_ptr(#)==mem[#+5].ptr
+@d native_glyph_info_size=10 {number of bytes of info per glyph: 16-bit glyph ID, 32-bit x and y coords}
+@d native_glyph==native_length {in |glyph_node|s, we store the glyph number here}
+
+@d free_native_glyph_info(#) ==
+ begin
+ if native_glyph_info_ptr(#) <> null_ptr then begin
+ libc_free(native_glyph_info_ptr(#));
+ native_glyph_info_ptr(#):=null_ptr;
+ native_glyph_count(#):=0;
+ end
+ end
+
+@p procedure copy_native_glyph_info(src:pointer; dest:pointer);
+var glyph_count:integer;
+begin
+ if native_glyph_info_ptr(src) <> null_ptr then begin
+ glyph_count:=native_glyph_count(src);
+ native_glyph_info_ptr(dest):=xmalloc_array(char, glyph_count * native_glyph_info_size);
+ memcpy(native_glyph_info_ptr(dest), native_glyph_info_ptr(src), glyph_count * native_glyph_info_size);
+ native_glyph_count(dest):=glyph_count;
+ end
+end;
+
+@ Picture files are handled with nodes that include fields for the transform associated
+with the picture, and a pathname for the picture file itself.
+They also have
+the |width|, |depth|, and |height| fields of a |box_node| at offsets 1-3. (|depth| will
+always be zero, as it happens.)
+
+So |pic_node_size|, which does not include any space for the picture file pathname, is 7.
+
+A |pdf_node| is just like |pic_node|, but generate a different \.{XDV} file code.
+
+@d pic_node=43 {|subtype| in whatsits that hold picture file references}
+@d pdf_node=44 {|subtype| in whatsits that hold PDF page references}
+@#
+@d pic_node_size=9 {must sync with \.{xetex.h}}
+@d pic_path_length(#)==mem[#+4].hh.b0
+@d pic_page(#)==mem[#+4].hh.b1
+@d pic_transform1(#)==mem[#+5].hh.lh
+@d pic_transform2(#)==mem[#+5].hh.rh
+@d pic_transform3(#)==mem[#+6].hh.lh
+@d pic_transform4(#)==mem[#+6].hh.rh
+@d pic_transform5(#)==mem[#+7].hh.lh
+@d pic_transform6(#)==mem[#+7].hh.rh
+@d pic_pdf_box(#)==mem[#+8].hh.b0
+
+@ 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 |width| field, which represents
+the amount of surrounding space inserted by \.{\\mathsurround}.
+
+In addition a |math_node| with |subtype>after| and |width=0| will be
+(ab)used to record a regular |math_node| reinserted after being
+discarded at a line break or one of the text direction primitives (
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} ).
+
+@d math_node=9 {|type| of a math node}
+@d before=0 {|subtype| for math node that introduces a formula}
+@d after=1 {|subtype| for math node that winds up a formula}
+@#
+@d M_code=2
+@d begin_M_code=M_code+before {|subtype| for \.{\\beginM} node}
+@d end_M_code=M_code+after {|subtype| for \.{\\endM} node}
+@d L_code=4
+@d begin_L_code=L_code+begin_M_code {|subtype| for \.{\\beginL} node}
+@d end_L_code=L_code+end_M_code {|subtype| for \.{\\endL} node}
+@d R_code=L_code+L_code
+@d begin_R_code=R_code+begin_M_code {|subtype| for \.{\\beginR} node}
+@d end_R_code=R_code+end_M_code {|subtype| for \.{\\endR} node}
+@#
+@d end_LR(#)==odd(subtype(#))
+@d end_LR_type(#)==(L_code*(subtype(#) div L_code)+end_M_code)
+@d begin_LR_type(#)==(#-after+before)
+
+@p function new_math(@!w:scaled;@!s:small_number):pointer;
+var p:pointer; {the new node}
+begin p:=get_node(small_node_size); type(p):=math_node;
+subtype(p):=s; width(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|, |ligature_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 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==llink {pointer to a glue specification}
+@d leader_ptr==rlink {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|, |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_ref_count(#) == link(#) {reference count of a glue specification}
+@d stretch(#) == mem[#+2].sc {the stretchability of this glob of glue}
+@d shrink(#) == mem[#+3].sc {the shrinkability of this glob of glue}
+@d stretch_order == type {order of infinity for stretching}
+@d shrink_order == subtype {order of infinity for shrinking}
+@d fil=1 {first-order infinity}
+@d fill=2 {second-order infinity}
+@d filll=3 {third-order infinity}
+
+@<Types...@>=
+@!glue_ord=normal..filll; {infinity to the 0, 1, 2, or 3 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:=get_node(glue_spec_size);@/
+mem[q]:=mem[p]; glue_ref_count(q):=null;@/
+width(q):=width(p); stretch(q):=stretch(p); shrink(q):=shrink(p);
+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:=get_node(small_node_size); type(p):=glue_node; subtype(p):=n+1;
+leader_ptr(p):=null;@/
+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:=get_node(small_node_size); type(p):=glue_node; subtype(p):=normal;
+leader_ptr(p):=null; 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 explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}}
+@d acc_kern=2 {|subtype| of kern nodes from accents}
+@d space_adjustment=3 {|subtype| of kern nodes from \.{\\XeTeXinterwordspaceshaping} adjustment}
+
+@# {memory structure for marginal kerns}
+@d margin_kern_node = 40
+@d margin_kern_node_size = 3
+@d margin_char(#) == info(# + 2) {unused for now; relevant for font expansion}
+
+@# {|subtype| of marginal kerns}
+@d left_side == 0
+@d right_side == 1
+
+@# {base for lp/rp codes starts from 2:
+ 0 for |hyphen_char|,
+ 1 for |skew_char|}
+@d lp_code_base == 2
+@d rp_code_base == 3
+
+@d max_hlist_stack = 512 {maximum fill level for |hlist_stack|}
+{maybe good if larger than |2 * max_quarterword|, so that box nesting level would overflow first}
+
+@ 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:=get_node(small_node_size); type(p):=kern_node;
+subtype(p):=normal;
+width(p):=w;
+new_kern:=p;
+end;
+
+@ @<Glob...@>=
+@!last_leftmost_char: pointer;
+@!last_rightmost_char: pointer;
+@!hlist_stack:array[0..max_hlist_stack] of pointer; {stack for |find_protchar_left()| and |find_protchar_right()|}
+@!hlist_stack_level:0..max_hlist_stack; {fill level for |hlist_stack|}
+@!first_p: pointer; {to access the first node of the paragraph}
+@!global_prev_p: pointer; {to access |prev_p| in |line_break|; should be kept in sync with |prev_p| by |update_prev_p|}
+
+@ 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 inf_penalty=inf_bad {``infinite'' penalty value}
+@d eject_penalty=-inf_penalty {``negatively infinite'' penalty value}
+@d penalty(#) == mem[#+1].int {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:=get_node(small_node_size); type(p):=penalty_node;
+subtype(p):=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(#)==mem[#+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, locations |mem_bot| to |mem_bot+3| are always used to store the
+specification 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. Static variable-size nodes appear
+in locations |mem_bot| through |lo_mem_stat_max|, and static single-word nodes
+appear in locations |hi_mem_stat_min| through |mem_top|, inclusive. It is
+harmless to let |lig_trick| and |garbage| share the same location of |mem|.
+
+@d zero_glue==mem_bot {specification for \.{0pt plus 0pt minus 0pt}}
+@d fil_glue==zero_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 lo_mem_stat_max==fil_neg_glue+glue_spec_size-1 {largest statically
+ allocated word in the variable-size |mem|}
+@#
+@d page_ins_head==mem_top {list of insertion data for current page}
+@d contrib_head==mem_top-1 {vlist of items not yet on current page}
+@d page_head==mem_top-2 {vlist for current page}
+@d temp_head==mem_top-3 {head of a temporary list of some kind}
+@d hold_head==mem_top-4 {head of a temporary list of another kind}
+@d adjust_head==mem_top-5 {head of adjustment list returned by |hpack|}
+@d active==mem_top-7 {head of active list in |line_break|, needs two words}
+@d align_head==mem_top-8 {head of preamble list for alignments}
+@d end_span==mem_top-9 {tail of spanned-width lists}
+@d omit_template==mem_top-10 {a constant token list}
+@d null_list==mem_top-11 {permanently empty list}
+@d lig_trick==mem_top-12 {a ligature masquerading as a |char_node|}
+@d garbage==mem_top-12 {used for scrap information}
+@d backup_head==mem_top-13 {head of token list built by |scan_keyword|}
+@d pre_adjust_head==mem_top-14 {head of pre-adjustment list returned by |hpack|}
+@d hi_mem_stat_min==mem_top-14 {smallest statically allocated word in
+ the one-word |mem|}
+@d hi_mem_stat_usage=15 {the number of one-word nodes always present}
+
+@ 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...@>=
+for k:=mem_bot+1 to lo_mem_stat_max do mem[k].sc:=0;
+ {all glue dimensions are zeroed}
+@^data structure assumptions@>
+k:=mem_bot;@+while k<=lo_mem_stat_max do
+ {set first words of glue specifications}
+ begin glue_ref_count(k):=null+1;
+ stretch_order(k):=normal; shrink_order(k):=normal;
+ k:=k+glue_spec_size;
+ end;
+stretch(fil_glue):=unity; stretch_order(fil_glue):=fil;@/
+stretch(fill_glue):=unity; stretch_order(fill_glue):=fill;@/
+stretch(ss_glue):=unity; stretch_order(ss_glue):=fil;@/
+shrink(ss_glue):=unity; shrink_order(ss_glue):=fil;@/
+stretch(fil_neg_glue):=-unity; stretch_order(fil_neg_glue):=fil;@/
+rover:=lo_mem_stat_max+1;
+link(rover):=empty_flag; {now initialize the dynamic memory}
+node_size(rover):=1000; {which is a 1000-word available node}
+llink(rover):=rover; rlink(rover):=rover;@/
+lo_mem_max:=rover+1000; link(lo_mem_max):=null; info(lo_mem_max):=null;@/
+for k:=hi_mem_stat_min to mem_top do
+ mem[k]:=mem[lo_mem_max]; {clear list heads}
+@<Initialize the special list heads and constant nodes@>;
+avail:=null; mem_end:=mem_top;
+hi_mem_min:=hi_mem_stat_min; {initialize the one-word memory}
+var_used:=lo_mem_stat_max+1-mem_bot; dyn_used:=hi_mem_stat_usage;
+ {initialize statistics}
+
+@ If \TeX\ 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 \TeX's debugging routines have
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip10pt@>@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+@t\hskip10pt@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+ {previous |mem_end|, |lo_mem_max|, and |hi_mem_min|}
+@t\hskip10pt@>@!panicking:boolean; {do we want to check memory constantly?}
+gubed
+
+@ @<Set initial...@>=
+@!debug was_mem_end:=mem_min; {indicate that everything was previously free}
+was_lo_max:=mem_min; was_hi_min:=mem_max;
+panicking:=false;
+gubed
+
+@ 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.
+
+@p @!debug procedure check_mem(@!print_locs : boolean);
+label done1,done2; {loop exits}
+var p,@!q:pointer; {current locations of interest in |mem|}
+@!clobbered:boolean; {is something amiss?}
+begin for p:=mem_min to lo_mem_max do free[p]:=false; {you can probably
+ do this faster}
+for p:=hi_mem_min to mem_end do free[p]:=false; {ditto}
+@<Check single-word |avail| list@>;
+@<Check variable-size |avail| list@>;
+@<Check flags of unavailable nodes@>;
+if print_locs then @<Print newly busy locations@>;
+for p:=mem_min to lo_mem_max do was_free[p]:=free[p];
+for p:=hi_mem_min to mem_end do was_free[p]:=free[p];
+ {|was_free:=free| might be faster}
+was_mem_end:=mem_end; was_lo_max:=lo_mem_max; was_hi_min:=hi_mem_min;
+end;
+gubed
+
+@ @<Check single-word...@>=
+p:=avail; q:=null; clobbered:=false;
+while p<>null do
+ begin if (p>mem_end)or(p<hi_mem_min) then clobbered:=true
+ else if free[p] then clobbered:=true;
+ if clobbered then
+ begin print_nl("AVAIL list clobbered at ");
+@.AVAIL list clobbered...@>
+ print_int(q); goto done1;
+ end;
+ free[p]:=true; q:=p; p:=link(q);
+ end;
+done1:
+
+@ @<Check variable-size...@>=
+p:=rover; q:=null; clobbered:=false;
+repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true
+ else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true
+ else if not(is_empty(p))or(node_size(p)<2)or@|
+ (p+node_size(p)>lo_mem_max)or@| (llink(rlink(p))<>p) then clobbered:=true;
+ if clobbered then
+ begin print_nl("Double-AVAIL list clobbered at ");
+ print_int(q); goto done2;
+ end;
+for q:=p to p+node_size(p)-1 do {mark all locations free}
+ begin if free[q] then
+ begin print_nl("Doubly free location at ");
+@.Doubly free location...@>
+ print_int(q); goto done2;
+ end;
+ free[q]:=true;
+ end;
+q:=p; p:=rlink(p);
+until p=rover;
+done2:
+
+@ @<Check flags...@>=
+p:=mem_min;
+while p<=lo_mem_max do {node |p| should not be empty}
+ begin if is_empty(p) then
+ begin print_nl("Bad flag at "); print_int(p);
+@.Bad flag...@>
+ end;
+ while (p<=lo_mem_max) and not free[p] do incr(p);
+ while (p<=lo_mem_max) and free[p] do incr(p);
+ end
+
+@ @<Print newly busy...@>=
+begin print_nl("New busy locs:");
+for p:=mem_min to lo_mem_max do
+ if not free[p] and ((p>was_lo_max) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+for p:=hi_mem_min to mem_end do
+ if not free[p] and
+ ((p<was_hi_min) or (p>was_mem_end) or was_free[p]) then
+ begin print_char(" "); print_int(p);
+ end;
+end
+
+@ 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
+@^dirty \PASCAL@>
+undefined in \PASCAL, 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.
+
+@p @!debug procedure search_mem(@!p:pointer); {look for pointers to |p|}
+var q:integer; {current position being searched}
+begin for q:=mem_min to lo_mem_max do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+for q:=hi_mem_min to mem_end do
+ begin if link(q)=p then
+ begin print_nl("LINK("); print_int(q); print_char(")");
+ end;
+ if info(q)=p then
+ begin print_nl("INFO("); print_int(q); print_char(")");
+ end;
+ end;
+@<Search |eqtb| for equivalents equal to |p|@>;
+@<Search |save_stack| for equivalents that point to |p|@>;
+@<Search |hyph_list| for pointers to |p|@>;
+end;
+gubed
+
+@ Some stuff for character protrusion.
+
+@p
+procedure pdf_error(t, p: str_number);
+begin
+ normalize_selector;
+ print_err("Error");
+ if t <> 0 then begin
+ print(" (");
+ print(t);
+ print(")");
+ end;
+ print(": "); print(p);
+ succumb;
+end;
+
+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 link(p) <> e do begin
+ p:=link(p);
+ if p = null then
+ return;
+ end;
+ prev_rightmost:=p;
+end;
+
+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;
+
+@<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 short_display(@!p:integer); {prints highlights of list |p|}
+var n:integer; {for replacement counts}
+begin while p>mem_min do
+ begin if is_char_node(p) then
+ begin if p<=mem_end then
+ begin if font(p)<>font_in_short_display then
+ begin if (font(p)<font_base)or(font(p)>font_max) then
+ print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); font_in_short_display:=font(p);
+ end;
+ print_ASCII(qo(character(p)));
+ end;
+ end
+ else @<Print a short indication of the contents of node |p|@>;
+ p:=link(p);
+ end;
+end;
+
+@ @<Print a short indication of the contents of node |p|@>=
+case type(p) of
+hlist_node,vlist_node,ins_node,mark_node,adjust_node,
+ unset_node: print("[]");
+whatsit_node:
+ case subtype(p) of
+ native_word_node, native_word_node_AT: begin
+ if native_font(p)<>font_in_short_display then begin
+ print_esc(font_id_text(native_font(p)));
+ print_char(" ");
+ font_in_short_display:=native_font(p);
+ end;
+ print_native_word(p);
+ end;
+ othercases print("[]")
+ endcases;
+rule_node: print_char("|");
+glue_node: if glue_ptr(p)<>zero_glue then print_char(" ");
+math_node: if subtype(p)>=L_code then print("[]")
+ else print_char("$");
+ligature_node: short_display(lig_ptr(p));
+disc_node: begin short_display(pre_break(p));
+ short_display(post_break(p));@/
+ n:=replace_count(p);
+ while n>0 do
+ begin if link(p)<>null then p:=link(p);
+ decr(n);
+ end;
+ 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 p>mem_end then print_esc("CLOBBERED.")
+else begin if (font(p)<font_base)or(font(p)>font_max) then print_char("*")
+@.*\relax@>
+ else @<Print the font identifier for |font(p)|@>;
+ print_char(" "); print_ASCII(qo(character(p)));
+ end;
+end;
+@#
+procedure print_mark(@!p:integer); {prints token list data in braces}
+begin print_char("{");
+if (p<hi_mem_min)or(p>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;
+
+@ 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("fil");
+ while order>fil 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<mem_min)or(p>=lo_mem_max) 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}
+i:integer; {temp index for printing chars of picfile paths}
+@!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>mem_min do
+ begin print_ln; print_current_string; {display the nesting history}
+ if p>mem_end then {pointer out of range}
+ begin print("Bad link, display aborted."); return;
+@.Bad link...@>
+ end;
+ incr(n); if n>breadth_max then {time to stop}
+ begin print("etc."); return;
+@.etc@>
+ end;
+ @<Display node |p|@>;
+ p:=link(p);
+ end;
+exit:
+end;
+
+@ @<Display node |p|@>=
+if is_char_node(p) then print_font_and_char(p)
+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|@>;
+ kern_node: @<Display kern |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;
+ math_node: @<Display math node |p|@>;
+ ligature_node: @<Display ligature |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;
+ if eTeX_ex then @<Display if this box is never to be reversed@>;
+ end;
+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(mem[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@>
+ else if subtype(p)=space_adjustment then print(" (space adjustment)");
+ end
+else begin print_esc("mkern"); print_scaled(width(p)); print("mu");
+ end
+
+@ @<Display math node |p|@>=
+if subtype(p)>after then
+ begin if end_LR(p) then print_esc("end")
+ else print_esc("begin");
+ if subtype(p)>R_code then print_char("R")
+ else if subtype(p)>L_code then print_char("L")
+ else print_char("M");
+ end else
+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_font_and_char(lig_char(p)); print(" (ligature ");
+if subtype(p)>1 then print_char("|");
+font_in_short_display:=font(lig_char(p)); short_display(lig_ptr(p));
+if odd(subtype(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 replace_count(p)>0 then
+ begin print(" replacing "); print_int(replace_count(p));
+ end;
+node_list_display(pre_break(p)); {recursive call}
+append_char("|"); show_node_list(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;
+
+procedure short_display_n(@!p, m:integer); {prints highlights of list |p|}
+begin
+ breadth_max:=m;
+ depth_threshold:=pool_size-pool_ptr-1;
+ show_node_list(p); {the show starts at |p|}
+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 if token_ref_count(p)=null 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 free_node(#,glue_spec_size)
+ else decr(glue_ref_count(#));
+ end
+
+@p procedure delete_glue_ref(@!p:pointer); {|p| points to a glue specification}
+fast_delete_glue_ref(p);
+
+@ 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@>
+
+@p procedure flush_node_list(@!p:pointer); {erase list of nodes starting at |p|}
+label done; {go here when node |p| has been freed}
+var q:pointer; {successor to node |p|}
+begin while p<>null do
+@^inner loop@>
+ begin q:=link(p);
+ if is_char_node(p) then free_avail(p)
+ else begin case type(p) of
+ hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p));
+ free_node(p,box_node_size); goto done;
+ end;
+ rule_node: begin free_node(p,rule_node_size); goto done;
+ end;
+ ins_node: begin flush_node_list(ins_ptr(p));
+ delete_glue_ref(split_top_ptr(p));
+ free_node(p,ins_node_size); goto done;
+ end;
+ whatsit_node: @<Wipe out the whatsit node |p| and |goto done|@>;
+ glue_node: begin fast_delete_glue_ref(glue_ptr(p));
+ if leader_ptr(p)<>null then flush_node_list(leader_ptr(p));
+ end;
+ kern_node,math_node,penalty_node: do_nothing;
+ margin_kern_node: begin
+ free_node(p, margin_kern_node_size);
+ goto done;
+ end;
+ ligature_node: flush_node_list(lig_ptr(p));
+ mark_node: delete_token_ref(mark_ptr(p));
+ disc_node: begin flush_node_list(pre_break(p));
+ flush_node_list(post_break(p));
+ end;
+ adjust_node: flush_node_list(adjust_ptr(p));
+ @t\4@>@<Cases of |flush_node_list| that arise in mlists only@>@;
+ othercases confusion("flushing")
+@:this can't happen flushing}{\quad flushing@>
+ endcases;@/
+ free_node(p,small_node_size);
+ done:end;
+ p:=q;
+ end;
+end;
+
+@* \[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}
+
+@ The copying procedure copies words en masse without bothering
+to look at their individual fields. If the node format changes---for
+example, if the size is altered, or if some link field is moved to another
+relative position---then this code may need to be changed too.
+@^data structure assumptions@>
+
+@p function copy_node_list(@!p:pointer):pointer; {makes a duplicate of the
+ node list that starts at |p| and returns a pointer to the new list}
+var h:pointer; {temporary head of copied list}
+@!q:pointer; {previous position in new list}
+@!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+begin h:=get_avail; q:=h;
+while p<>null do
+ begin @<Make a copy of node |p| in node |r|@>;
+ link(q):=r; q:=r; p:=link(p);
+ end;
+link(q):=null; q:=link(h); free_avail(h);
+copy_node_list:=q;
+end;
+
+@ @<Make a copy of node |p|...@>=
+words:=1; {this setting occurs in more branches than any other}
+if is_char_node(p) then r:=get_avail
+else @<Case statement to copy different types and set |words| to the number
+ of initial words not yet copied@>;
+while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end
+
+@ @<Case statement to copy...@>=
+case type(p) of
+hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+ list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|}
+ words:=5;
+ end;
+rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
+ end;
+ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4];
+ add_glue_ref(split_top_ptr(p));
+ ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|}
+ words:=ins_node_size-1;
+ end;
+whatsit_node:@<Make a partial copy of the whatsit node |p| and make |r|
+ point to it; set |words| to the number of initial words not yet copied@>;
+glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
+ glue_ptr(r):=glue_ptr(p); leader_ptr(r):=copy_node_list(leader_ptr(p));
+ end;
+kern_node,math_node,penalty_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+margin_kern_node: begin
+ r:=get_node(margin_kern_node_size);
+ words:=margin_kern_node_size;
+ end;
+ligature_node: begin r:=get_node(small_node_size);
+ mem[lig_char(r)]:=mem[lig_char(p)]; {copy |font| and |character|}
+ lig_ptr(r):=copy_node_list(lig_ptr(p));
+ end;
+disc_node: begin r:=get_node(small_node_size);
+ pre_break(r):=copy_node_list(pre_break(p));
+ post_break(r):=copy_node_list(post_break(p));
+ end;
+mark_node: begin r:=get_node(small_node_size); add_token_ref(mark_ptr(p));
+ words:=small_node_size;
+ end;
+adjust_node: begin r:=get_node(small_node_size);
+ adjust_ptr(r):=copy_node_list(adjust_ptr(p));
+ end; {|words=1=small_node_size-1|}
+othercases confusion("copying")
+@:this can't happen copying}{\quad copying@>
+endcases
+
+@* \[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} )}
+ {or text direction directives ( \.{\\beginL}, etc.~)}
+@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 min_internal=68 {the smallest code that can follow \.{\\the}}
+@d char_given=68 {character code defined by \.{\\chardef}}
+@d math_given=69 {math code defined by \.{\\mathchardef}}
+@d XeTeX_math_given=70 {extended math code defined by \.{\\Umathchardef}}
+@d last_item=71 {most recent item ( \.{\\lastpenalty},
+ \.{\\lastkern}, \.{\\lastskip} )}
+@d max_non_prefixed_command=71 {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}'.
+
+@d toks_register=72 {token list register ( \.{\\toks} )}
+@d assign_toks=73 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)}
+@d assign_int=74 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)}
+@d assign_dimen=75 {user-defined length ( \.{\\hsize}, etc.~)}
+@d assign_glue=76 {user-defined glue ( \.{\\baselineskip}, etc.~)}
+@d assign_mu_glue=77 {user-defined muglue ( \.{\\thinmuskip}, etc.~)}
+@d assign_font_dimen=78 {user-defined font dimension ( \.{\\fontdimen} )}
+@d assign_font_int=79 {user-defined font integer ( \.{\\hyphenchar},
+ \.{\\skewchar} )}
+@d set_aux=80 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )}
+@d set_prev_graf=81 {specify state info ( \.{\\prevgraf} )}
+@d set_page_dimen=82 {specify state info ( \.{\\pagegoal}, etc.~)}
+@d set_page_int=83 {specify state info ( \.{\\deadcycles},
+ \.{\\insertpenalties} )}
+ {( or \.{\\interactionmode} )}
+@d set_box_dimen=84 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )}
+@d set_shape=85 {specify fancy paragraph shape ( \.{\\parshape} )}
+ {(or \.{\\interlinepenalties}, etc.~)}
+@d def_code=86 {define a character code ( \.{\\catcode}, etc.~)}
+@d XeTeX_def_code=87 {\.{\\Umathcode}, \.{\\Udelcode}}
+@d def_family=88 {declare math fonts ( \.{\\textfont}, etc.~)}
+@d set_font=89 {set current font ( font identifiers )}
+@d def_font=90 {define a font file ( \.{\\font} )}
+@d register=91 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)}
+@d max_internal=91 {the largest code that can follow \.{\\the}}
+@d advance=92 {advance a register or parameter ( \.{\\advance} )}
+@d multiply=93 {multiply a register or parameter ( \.{\\multiply} )}
+@d divide=94 {divide a register or parameter ( \.{\\divide} )}
+@d prefix=95 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )}
+ {( or \.{\\protected} )}
+@d let=96 {assign a command code ( \.{\\let}, \.{\\futurelet} )}
+@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
+@d read_to_cs=98 {read into a control sequence ( \.{\\read} )}
+ {( or \.{\\readline} )}
+@d def=99 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )}
+@d set_box=100 {set a box ( \.{\\setbox} )}
+@d hyph_data=101 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )}
+@d set_interaction=102 {define level of interaction ( \.{\\batchmode}, etc.~)}
+@d max_command=102 {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} )}
+@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.
+
+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;
+
+@ 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| and |clang|; it holds the current space factor used in
+spacing calculations, and the current language used for hyphenation.
+(The value of |clang| is undefined in restricted horizontal mode.)
+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 vertical modes it is known as |LR_save| and holds the LR stack when a
+paragraph is interrupted by a displayed formula. In display math mode
+it is known as |LR_box| and holds a pointer to a prototype box for the
+display. 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;
+ 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 LR_save==eTeX_aux {LR stack when a paragraph is interrupted}
+@d LR_box==eTeX_aux {prototype box for display}
+@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 clang==aux.hh.rh {the other 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}
+
+@<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}}
+
+@ Here is a common way to make the current list grow:
+
+@d tail_append(#)==begin link(tail):=#; tail:=link(tail);
+ 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;
+@<Start a new current page@>;
+
+@ 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:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
+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 free_avail(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 link(contrib_head)<>null then
+ print_nl("### recent contributions:");
+ end;
+ show_box(link(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 begin 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_usvs| equivalents for ``active characters''
+that act as control sequences, followed by |number_usvs| equivalents for
+single-character 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 single_base=active_base+number_usvs
+ {equivalents of one-character control sequences}
+@d null_cs=single_base+number_usvs {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 prim_size=500 {maximum number of primitives }
+@d frozen_null_font=frozen_control_sequence+10
+ {permanent `\.{\\nullfont}'}
+@d frozen_primitive=frozen_control_sequence+11
+ {permanent `\.{\\pdfprimitive}'}
+@d prim_eqtb_base=frozen_primitive+1
+@d font_id_base=frozen_null_font-font_base
+ {begins table of 257 permanent font identifiers}
+@d undefined_control_sequence=frozen_null_font+257 {dummy location}
+@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 XeTeX_linebreak_skip_code=15 {glue introduced at potential linebreak location}
+@d thin_mu_skip_code=16 {thin space in math formula}
+@d med_mu_skip_code=17 {medium space in math formula}
+@d thick_mu_skip_code=18 {thick space in math formula}
+@d glue_pars=19 {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 XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_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");
+XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip");
+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("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/
+@!@:XeTeX_linebreak_skip_}{\.{\\XeTeXlinebreakskip} 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 etex_toks_base=tex_toks {base for \eTeX's token list parameters}
+@d every_eof_loc=etex_toks_base {points to token list for \.{\\everyeof}}
+@d XeTeX_inter_char_loc=every_eof_loc+1 {not really used, but serves as a flag}
+@d etex_toks=XeTeX_inter_char_loc+1 {end of \eTeX's token list parameters}
+@#
+@d toks_base=etex_toks {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 box_base=etex_pens {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_usvs| command codes (the ``catcodes'')}
+@d lc_code_base=cat_code_base+number_usvs {table of |number_usvs| lowercase mappings}
+@d uc_code_base=lc_code_base+number_usvs {table of |number_usvs| uppercase mappings}
+@d sf_code_base=uc_code_base+number_usvs {table of |number_usvs| spacefactor mappings}
+@d math_code_base=sf_code_base+number_usvs {table of |number_usvs| math mode mappings}
+@d int_base=math_code_base+number_usvs {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 toks(#)==equiv(toks_base+#)
+@d box(#)==equiv(box_base+#)
+@d cur_font==equiv(cur_font_loc)
+@d fam_fnt(#)==equiv(math_font_base+#)
+@d cat_code(#)==equiv(cat_code_base+#)
+@d lc_code(#)==equiv(lc_code_base+#)
+@d uc_code(#)==equiv(uc_code_base+#)
+@d sf_code(#)==equiv(sf_code_base+#)
+@d math_code(#)==equiv(math_code_base+#)
+ {Note: |math_code(c)| is the true math code plus |min_halfword|}
+
+@<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@>
+
+@ @<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|@>@/
+ 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 var_fam_class = 7
+@d active_math_char = @"1FFFFF
+@d is_active_math_char(#) == math_char_field(#) = active_math_char
+@d is_var_family(#) == math_class_field(#) = 7
+
+@<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+number_regs-1 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+number_regs-1 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+number_math_fonts-1 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;@/
+for k:=cat_code_base+1 to int_base-1 do eqtb[k]:=eqtb[cat_code_base];
+for k:=0 to number_usvs-1 do
+ begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000;
+ end;
+cat_code(carriage_return):=car_ret; cat_code(" "):=spacer;
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(invalid_code):=invalid_char; cat_code(null_code):=ignore;
+for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class));
+for k:="A" to "Z" do
+ begin cat_code(k):=letter; cat_code(k+"a"-"A"):=letter;@/
+ math_code(k):=hi(k + set_family_field(1) + set_class_field(var_fam_class));
+ math_code(k+"a"-"A"):=hi(k+"a"-"A" + set_family_field(1) + set_class_field(var_fam_class));@/
+ lc_code(k):=k+"a"-"A"; lc_code(k+"a"-"A"):=k+"a"-"A";@/
+ uc_code(k):=k; uc_code(k+"a"-"A"):=k;@/
+ sf_code(k):=999;
+ end;
+
+@ @<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(info(par_shape_ptr));
+ end
+else if n<toks_base then
+ 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
+
+@ @<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 print_esc("mathcode"); print_int(n-math_code_base);
+ print_char("="); print_int(ho(equiv(n)));
+ 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 held over 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 tex_int_pars=55 {total number of \TeX's integer parameters}
+@#
+@d etex_int_base=tex_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 {suppress errors for missing fonts}
+@d XeTeX_linebreak_locale_code=etex_int_base+10 {string number of locale to use for linebreak locations}
+@d XeTeX_linebreak_penalty_code=etex_int_base+11 {penalty to use at locale-dependent linebreak locations}
+@d XeTeX_protrude_chars_code=etex_int_base+12 {protrude chars at left/right edge of paragraphs}
+@d eTeX_state_code=etex_int_base+13 {\eTeX\ state variables}
+@d etex_int_pars=eTeX_state_code+eTeX_states {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 del_code_base=count_base+number_regs {|number_usvs| delimiter code mappings}
+@d dimen_base=del_code_base+number_usvs {beginning of region 6}
+@#
+@d del_code(#)==eqtb[del_code_base+#].int
+@d count(#)==eqtb[count_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 language==int_par(language_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 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)
+@d XeTeX_linebreak_locale==int_par(XeTeX_linebreak_locale_code)
+@d XeTeX_linebreak_penalty==int_par(XeTeX_linebreak_penalty_code)
+@d XeTeX_protrude_chars==int_par(XeTeX_protrude_chars_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");
+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");
+XeTeX_linebreak_penalty_code:print_esc("XeTeXlinebreakpenalty");
+XeTeX_protrude_chars_code:print_esc("XeTeXprotrudechars");
+@/@<Cases for |print_param|@>@/
+othercases print("[unknown integer parameter!]")
+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("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("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/
+@!@:XeTeX_linebreak_penalty_}{\.{\\XeTeXlinebreakpenalty} primitive@>
+primitive("XeTeXprotrudechars",assign_int,int_base+XeTeX_protrude_chars_code);@/
+@!@:XeTeX_protrude_chars_}{\.{\\XeTeXprotrudechars} 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;
+
+@ 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 del_code_base-1 do eqtb[k].int:=0;
+mag:=1000; tolerance:=10000; hang_after:=1; max_dead_cycles:=25;
+escape_char:="\"; end_line_char:=carriage_return;
+for k:=0 to number_usvs-1 do del_code(k):=-1;
+del_code("."):=0; {this null delimiter is used in error recovery}
+
+@ 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 assumes that suitable values appear in
+the global variables \\{sys\_time}, \\{sys\_day}, \\{sys\_month}, and
+\\{sys\_year} (which are initialized to noon on 4 July 1776,
+in case the implementor is careless).
+
+@p procedure fix_date_and_time;
+begin sys_time:=12*60;
+sys_day:=4; sys_month:=7; sys_year:=1776; {self-evident truths}
+time:=sys_time; {minutes since midnight}
+day:=sys_day; {day of the month}
+month:=sys_month; {month of the year}
+year:=sys_year; {Anno Domini}
+end;
+
+@ @<Show equivalent |n|, in region 5@>=
+begin if n<count_base then print_param(n-int_base)
+else if n<del_code_base then
+ begin print_esc("count"); print_int(n-count_base);
+ end
+else begin print_esc("delcode"); print_int(n-del_code_base);
+ end;
+print_char("="); print_int(eqtb[n].int);
+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 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:=old_setting;
+end;
+
+@ Of course we had better declare a few more global variables, if the previous
+routines are going to work.
+
+@<Glob...@>=
+@!old_setting:0..max_selector;
+@!sys_time,@!sys_day,@!sys_month,@!sys_year:integer;
+ {date and time supplied by external system}
+
+@ 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 pdf_page_width_code=21 {page width of the PDF output}
+@d pdf_page_height_code=22 {page height of the PDF output}
+@d dimen_pars=23 {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 pdf_page_width == dimen_par(pdf_page_width_code)
+@d pdf_page_height == dimen_par(pdf_page_height_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");
+pdf_page_width_code: print_esc("pdfpagewidth");
+pdf_page_height_code: print_esc("pdfpageheight");
+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("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/
+@!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@>
+primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/
+@!@:pdf_page_height_}{\.{\\pdfpageheight} 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;
+
+@ When the debugging routine |search_mem| is looking for pointers having a
+given value, it is interested only in regions 1 to~3 of~|eqtb|, and in the
+first part of region~4.
+
+@<Search |eqtb| for equivalents equal to |p|@>=
+for q:=active_base to box_base+biggest_reg do
+ begin if equiv(q)=p then
+ begin print_nl("EQUIV("); print_int(q); print_char(")");
+ end;
+ end
+
+@* \[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}
+
+@<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_prime=431 {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, plus one}
+@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(eqtb[prim_eqtb_base+#]) {level of definition}
+@d prim_eq_type(#)==prim_eq_type_field(eqtb[prim_eqtb_base+#]) {command code for equivalent}
+@d prim_equiv(#)==prim_equiv_field(eqtb[prim_eqtb_base+#]) {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|}
+
+@ @<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];
+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>0| 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}
+@!ll:integer; {length in UTF16 code units}
+begin @<Compute the hash code |h|@>;
+p:=h+hash_base; {we start searching here; note that |0<=h<hash_prime|}
+ll:=l; for d:=0 to l-1 do if buffer[j+d]>=@"10000 then incr(ll);
+loop@+begin if text(p)>0 then if length(text(p))=ll 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(ll); 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 begin
+ if buffer[k]<@"10000 then append_char(buffer[k])
+ else begin
+ append_char(@"D800+(buffer[k]-@"10000)div@"400);
+ append_char(@"DC00+(buffer[k]-@"10000)mod@"400);
+ end
+end;
+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:=0;
+for k:=j 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}
+@!j,@!l:integer;
+begin
+if s<=biggest_char then begin
+ if s<0 then begin p:=undefined_primitive; goto found; end
+ else p:=(s mod prim_prime)+prim_base; {we start searching here}
+ end
+else begin
+ j:=str_start_macro(s);
+ if s = str_ptr then l:=cur_length else l:=length(s);
+ @<Compute the primitive code |h|@>;
+ p:=h+prim_base; {we start searching here; note that |0<=h<prim_prime|}
+ end;
+loop@+begin
+ if prim_text(p)>1+biggest_char then { |p| points a multi-letter primitive }
+ begin if length(prim_text(p)-1)=l then
+ if str_eq_str(prim_text(p)-1,s) then goto found;
+ end
+ else if prim_text(p)=1+s then goto found; { |p| points a single-letter primitive }
+ 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;
+found: prim_lookup:=p;
+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+1;
+end
+
+@ The value of |prim_prime| should be roughly 85\pct! of
+|prim_size|, and it should be a prime number.
+
+@<Compute the primitive code |h|@>=
+h:=str_pool[j];
+for k:=j+1 to j+l-1 do
+ begin h:=h+h+str_pool[k];
+ while h>=prim_prime do h:=h-prim_prime;
+ end
+
+@ Single-character control sequences do not need to be looked up in a hash
+table, since we can use the character code itself as a direct address.
+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.
+
+@<Basic printing...@>=
+procedure print_cs(@!p:integer); {prints a purported control sequence}
+begin if p<hash_base then {single character}
+ if p>=single_base then
+ if p=null_cs then
+ begin print_esc("csname"); print_esc("endcsname"); print_char(" ");
+ end
+ else begin print_esc(p-single_base);
+ if cat_code(p-single_base)=letter then print_char(" ");
+ end
+ else if p<active_base then print_esc("IMPOSSIBLE.")
+@.IMPOSSIBLE@>
+ else print_char(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
+ if (p>=prim_eqtb_base)and(p<frozen_null_font) then
+ print_esc(prim_text(p-prim_eqtb_base)-1) else print_esc(text(p));
+ 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<single_base then print_char(p-active_base)
+ else if p<null_cs then print_esc(p-single_base)
+ else begin print_esc("csname"); print_esc("endcsname");
+ end
+else if (p>=prim_eqtb_base)and(p<frozen_null_font) then
+ print_esc(prim_text(p-prim_eqtb_base)-1)
+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(@!s:str_number;@!c:quarterword;@!o:halfword);
+var k:pool_pointer; {index into |str_pool|}
+@!j:0..buf_size; {index into |buffer|}
+@!l:small_number; {length of the string}
+@!prim_val:integer; {needed to fill |prim_eqtb|}
+begin if s<256 then begin
+ cur_val:=s+single_base;
+ prim_val:=prim_lookup(s);
+end
+else begin 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
+ overflow("buffer size",buf_size);
+@: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);
+ end;
+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("XeTeXdelimiter",delim_num,1);@/
+primitive("Udelimiter",delim_num,1);@/
+@!@:U_delimiter_}{\.{\\Udelimiter} 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("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("mark",mark,0);@/
+@!@:mark_}{\.{\\mark} primitive@>
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("XeTeXmathaccent",math_accent,1);@/
+primitive("Umathaccent",math_accent,1);@/
+@!@:U_math_accent_}{\.{\\Umathaccent} primitive@>
+primitive("mathchar",math_char_num,0);@/
+@!@:math_char_}{\.{\\mathchar} primitive@>
+primitive("XeTeXmathcharnum",math_char_num,1);@/
+primitive("Umathcharnum",math_char_num,1);@/
+@!@:U_math_char_num_}{\.{\\Umathcharnum} primitive@>
+primitive("XeTeXmathchar",math_char_num,2);@/
+primitive("Umathchar",math_char_num,2);@/
+@!@:U_math_char_}{\.{\\Umathchar} 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("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("XeTeXradical",radical,1);@/
+primitive("Uradical",radical,1);@/
+@!@:U_radical_}{\.{\\Uradical} primitive@>
+primitive("read",read_to_cs,0);@/
+@!@:read_}{\.{\\read} primitive@>
+primitive("relax",relax,too_big_usv); {cf.\ |scan_file_name|}
+@!@:relax_}{\.{\\relax} primitive@>
+text(frozen_relax):="relax"; eqtb[frozen_relax]:=eqtb[cur_val];@/
+primitive("setbox",set_box,0);@/
+@!@:set_box_}{\.{\\setbox} primitive@>
+primitive("the",the,0);@/
+@!@:the_}{\.{\\the} primitive@>
+primitive("toks",toks_register,mem_bot);@/
+@!@: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");
+cs_name: print_esc("csname");
+def_font: print_esc("font");
+delim_num: if chr_code=1 then print_esc("Udelimiter")
+ else print_esc("delimiter");
+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 print_esc("mark");
+ if chr_code>0 then print_char("s");
+ end;
+math_accent: if chr_code=1 then print_esc("Umathaccent")
+ else print_esc("mathaccent");
+math_char_num: if chr_code=2 then print_esc("Umathchar")
+ else if chr_code=1 then print_esc("Umathcharnum")
+ else print_esc("mathchar");
+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=1 then print_esc("Uradical") else print_esc("radical");
+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: @<Cases of |toks_register| for |print_cmd_chr|@>;
+vadjust: print_esc("vadjust");
+valign: if chr_code=0 then print_esc("valign")@/
+ @<Cases of |valign| for |print_cmd_chr|@>;
+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@>
+
+Meanwhile, this is a convenient place to catch up on something we were unable
+to do before the hash table was defined:
+
+@<Print the font identifier for |font(p)|@>=
+print_esc(font_id_text(font(p)))
+
+@* \[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 five 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 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.
+
+\yskip\hang 5) If |save_type(p)=restore_sa|, then |sa_chain| points to a
+chain of sparse array entries to be restored at the end of the current
+group. Furthermore |save_index(p)| and |save_level(p)| should replace
+the values of |sa_chain| and |sa_level| respectively.
+
+@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 token 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}
+@d restore_sa=4 {|save_type| when sparse array entries should be restored}
+
+@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 max_group_code=16
+
+@<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 seven 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-7 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 five 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;
+if eTeX_ex then
+ begin saved(0):=line; incr(save_ptr);
+ end;
+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 free_node(q,info(q)+info(q)+1);
+ end; {such a block is |2n+1| words long, where |n=info(q)|}
+box_ref: flush_node_list(equiv_field(w));
+@/@<Cases for |eq_destroy|@>@/
+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 eTeX_ex and(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 eTeX_ex and(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;
+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@>
+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 if save_type(save_ptr)=restore_sa then
+ begin sa_restore; sa_chain:=p; sa_level:=save_level(save_ptr);
+ end
+ 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);
+if eTeX_ex then 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
+
+@ When looking for possible pointers to a memory location, it is helpful
+to look for references from |eqtb| that might be waiting on the
+save stack. Of course, we might find spurious pointers too; but this
+routine is merely an aid when debugging, and at such times we are
+grateful for any scraps of information, even if they prove to be irrelevant.
+@^dirty \PASCAL@>
+
+@<Search |save_stack| for equivalents that point to |p|@>=
+if save_ptr>0 then for q:=0 to save_ptr-1 do
+ begin if equiv_field(save_stack[q])=p then
+ begin print_nl("SAVE("); print_int(q); print_char(")");
+ end;
+ end
+
+@ 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=@"1FFFFFF {amount added to the |eqtb| location in a
+ token that stands for a control sequence; is a multiple of~|@"10000|, less~1}
+@d max_char_val=@"200000 {to separate char and command code}
+@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=end_match_token+1 {$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 an output routine
+will be enclosed in braces.
+
+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:integer; {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<hi_mem_min) or (p>mem_end) then
+ begin print_esc("CLOBBERED."); return;
+@.CLOBBERED@>
+ end;
+if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag)
+else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val;
+ 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_char(c);
+mac_param: begin print_char(c); print_char(c);
+ end;
+out_param: begin print_char(match_chr);
+ if c<=9 then print_char(c+"0")
+ else begin print_char("!"); return;
+ end;
+ end;
+match: begin match_chr:=c; print_char(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 if (cur_cmd=top_bot_mark)and(cur_chr<marks_code) then
+ begin print_char(":"); print_ln;
+ token_show(cur_mark[cur_chr]);
+ end;
+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(#);
+ if chr_code < @"10000 then print_ASCII(chr_code)
+ else print_char(chr_code); {non-Plane 0 Unicodes can't be sent through |print_ASCII|}
+ end
+
+@<Declare the procedure called |print_cmd_chr|@>=
+procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword);
+var n:integer; {temp variable}
+@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
+@!quote_char:UTF16_code;
+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:=link(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: halfword;
+ 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 name==cur_input.name_field {name of the current file}
+
+@ 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<=19| indicates that we are reading a pseudo file
+created by the \.{\\scantokens} 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 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_head;
+ end;
+ aligning: begin print("preamble"); p:=hold_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 backed_up_char=4 {special code for backed-up char from \\XeTeXinterchartoks hook}
+@d inserted=5 {|token_type| code for inserted texts}
+@d macro=6 {|token_type| code for defined control sequences}
+@d output_text=7 {|token_type| code for output routines}
+@d every_par_text=8 {|token_type| code for \.{\\everypar}}
+@d every_math_text=9 {|token_type| code for \.{\\everymath}}
+@d every_display_text=10 {|token_type| code for \.{\\everydisplay}}
+@d every_hbox_text=11 {|token_type| code for \.{\\everyhbox}}
+@d every_vbox_text=12 {|token_type| code for \.{\\everyvbox}}
+@d every_job_text=13 {|token_type| code for \.{\\everyjob}}
+@d every_cr_text=14 {|token_type| code for \.{\\everycr}}
+@d mark_text=15 {|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 inter_char_text=XeTeX_inter_char_loc-eTeX_text_offset
+ {|token_type| code for \.{\\XeTeXinterchartoks}}
+@#
+@d write_text=toks_base-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>19) 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 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 begin print_nl("l.");
+ if index=in_open then print_int(line)
+ else print_int(line_stack[index+1]); {input from a pseudo file}
+ 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,backed_up_char: 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> ");
+inter_char_text: print_nl("<XeTeXinterchartoks> ");
+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_visible_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}
+ 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:=eTeX_ex;
+ 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 overflow("buffer size",buf_size);
+@: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)or(name=19) then pseudo_close else
+if name>17 then u_close(cur_file); {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;
+force_eof:=false;
+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_usv); {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");
+
+@ Before getting into |get_next|, let's consider the subroutine that
+is called when an `\.{\\outer}' control sequence has been scanned or
+when the end of a file has been reached. These two cases are distinguished
+by |cur_cs|, which is zero at the end of a file.
+
+@p procedure check_outer_validity;
+var p:pointer; {points to inserted token list}
+@!q:pointer; {auxiliary pointer}
+begin if scanner_status<>normal then
+ begin deletions_allowed:=false;
+ @<Back up an outer control sequence so that it can be reread@>;
+ if scanner_status>skipping then
+ @<Tell the user what has run away and try to recover@>
+ else begin print_err("Incomplete "); print_cmd_chr(if_test,cur_if);
+@.Incomplete \\if...@>
+ print("; all text was ignored after line "); print_int(skip_line);
+ help3("A forbidden control sequence 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 cur_cs<>0 then cur_cs:=0
+ else help_line[2]:=@|
+ "The file ended while I was skipping conditional text.";
+ cur_tok:=cs_token_flag+frozen_fi; ins_error;
+ end;
+ deletions_allowed:=true;
+ end;
+end;
+
+@ An outer control sequence that occurs in a \.{\\read} will not be reread,
+since the error recovery for \.{\\read} is not very powerful.
+
+@<Back up an outer control sequence so that it can be reread@>=
+if cur_cs<>0 then
+ begin if (state=token_list)or(name<1)or(name>17) then
+ begin p:=get_avail; info(p):=cs_token_flag+cur_cs;
+ back_list(p); {prepare to read the control sequence again}
+ end;
+ cur_cmd:=spacer; cur_chr:=" "; {replace it by a space}
+ end
+
+@ @<Tell the user what has run away...@>=
+begin runaway; {print a definition, argument, or preamble}
+if cur_cs=0 then print_err("File ended")
+@.File ended while scanning...@>
+else begin cur_cs:=0; print_err("Forbidden control sequence found");
+@.Forbidden control sequence...@>
+ end;
+print(" while scanning ");
+@<Print either `\.{definition}' or `\.{use}' or `\.{preamble}' or `\.{text}',
+ and insert tokens that should lead to recovery@>;
+print(" of "); sprint_cs(warning_index);
+help4("I suspect you have forgotten a `}', 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.");@/
+error;
+end
+
+@ The recovery procedure can't be fully understood without knowing more
+about the \TeX\ routines that should be aborted, but we can sketch the
+ideas here: For a runaway definition or a runaway balanced text
+we will insert a right brace; for a
+runaway preamble, we will insert a special \.{\\cr} token and a right
+brace; and for a runaway argument, we will set |long_state| to
+|outer_call| and insert \.{\\par}.
+
+@<Print either `\.{definition}' or ...@>=
+p:=get_avail;
+case scanner_status of
+defining:begin print("definition"); info(p):=right_brace_token+"}";
+ end;
+matching:begin print("use"); info(p):=par_token; long_state:=outer_call;
+ end;
+aligning:begin print("preamble"); info(p):=right_brace_token+"}"; q:=p;
+ p:=get_avail; link(p):=q; info(p):=cs_token_flag+frozen_cr;
+ align_state:=-1000000;
+ end;
+absorbing:begin print("text"); info(p):=right_brace_token+"}";
+ end;
+end; {there are no other cases}
+ins_list(p)
+
+@ We need to mention a procedure here that may be called by |get_next|.
+
+@p procedure@?firm_up_the_line; forward;
+
+@ 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@>
+
+@d switch=25 {a label in |get_next|}
+@d start_cs=26 {another}
+@d not_exp=27
+
+@p procedure get_next; {sets |cur_cmd|, |cur_chr|, |cur_cs| to next token}
+label restart, {go here to get the next input token}
+ switch, {go here to eat the next character from a file}
+ reswitch, {go here to digest it again}
+ start_cs, {go here to start looking for a control sequence}
+ found, {go here when a control sequence has been found}
+ not_exp, {go here when ^^ turned out not to start an expanded code}
+ exit; {go here when the next input token has been got}
+var k:0..buf_size; {an index into |buffer|}
+@!t:halfword; {a token}
+@!cat:0..max_char_code; {|cat_code(cur_chr)|, usually}
+@!c:UnicodeScalar; {constituent of a possible expanded code}
+@!lower:UTF16_code; {lower surrogate of a possible UTF-16 compound}
+@!d:small_number; {number of excess characters in an expanded code}
+@!sup_count:small_number; {number of identical |sup_mark| characters}
+begin restart: cur_cs:=0;
+if state<>token_list then
+@<Input from external file, |goto restart| if no input found@>
+else @<Input from token list, |goto restart| if end of list or
+ if a parameter needs to be expanded@>;
+@<If an alignment entry has just ended, take appropriate action@>;
+exit:end;
+
+@ An alignment entry ends when a tab or \.{\\cr} occurs, provided that the
+current level of braces is the same as the level that was present at the
+beginning of that alignment entry; i.e., provided that |align_state| has
+returned to the value it had after the \<u_j> template for that entry.
+@^inner loop@>
+
+@<If an alignment entry has just ended, take appropriate action@>=
+if cur_cmd<=car_ret then if cur_cmd>=tab_mark then if align_state=0 then
+ @<Insert the \(v)\<v_j> template and |goto restart|@>
+
+@ @<Input from external file, |goto restart| if no input found@>=
+@^inner loop@>
+begin switch: if loc<=limit then {current line not yet finished}
+ begin cur_chr:=buffer[loc]; incr(loc);
+ if (cur_chr >= @"D800) and (cur_chr < @"DC00)
+ and (loc <= limit) and (buffer[loc] >= @"DC00) and (buffer[loc] < @"E000) then
+ begin
+ lower := buffer[loc] - @"DC00;
+ incr(loc);
+ cur_chr := @"10000 + (cur_chr - @"D800) * 1024 + lower;
+ end;
+ reswitch: cur_cmd:=cat_code(cur_chr);
+ @<Change state if necessary, and |goto switch| if the
+ current character should be ignored,
+ or |goto reswitch| if the current character
+ changes to another@>;
+ end
+else begin 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@>;
+ check_interrupt;
+ goto switch;
+ end;
+end
+
+@ 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.
+
+@d any_state_plus(#) == mid_line+#,skip_blanks+#,new_line+#
+
+@<Change state if necessary...@>=
+case state+cur_cmd of
+@<Cases where character is ignored@>: goto switch;
+any_state_plus(escape): @<Scan a control sequence
+ and set |state:=skip_blanks| or |mid_line|@>;
+any_state_plus(active_char): @<Process an active-character control sequence
+ and set |state:=mid_line|@>;
+any_state_plus(sup_mark): @<If this |sup_mark| starts an expanded character
+ like~\.{\^\^A} or~\.{\^\^df}, then |goto reswitch|,
+ otherwise set |state:=mid_line|@>;
+any_state_plus(invalid_char): @<Decry the invalid character and
+ |goto restart|@>;
+@t\4@>@<Handle situations involving spaces, braces, changes of state@>@;
+othercases do_nothing
+endcases
+
+@ @<Cases where character is ignored@>=
+any_state_plus(ignore),skip_blanks+spacer,new_line+spacer
+
+@ We go to |restart| instead of to |switch|, because |state| might equal
+|token_list| after the error has been dealt with
+(cf.\ |clear_for_error_prompt|).
+
+@<Decry the invalid...@>=
+begin 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.");@/
+deletions_allowed:=false; error; deletions_allowed:=true;
+goto restart;
+end
+
+@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param,
+ #+sub_mark,#+letter,#+other_char
+
+@<Handle situations involving spaces, braces, changes of state@>=
+mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>;
+mid_line+car_ret:@<Finish line, emit a space@>;
+skip_blanks+car_ret,any_state_plus(comment):
+ @<Finish line, |goto switch|@>;
+new_line+car_ret:@<Finish line, emit a \.{\\par}@>;
+mid_line+left_brace: incr(align_state);
+skip_blanks+left_brace,new_line+left_brace: begin
+ state:=mid_line; incr(align_state);
+ end;
+mid_line+right_brace: decr(align_state);
+skip_blanks+right_brace,new_line+right_brace: begin
+ state:=mid_line; decr(align_state);
+ end;
+add_delims_to(skip_blanks),add_delims_to(new_line): state:=mid_line;
+
+@ 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.
+
+@<Finish line, emit a space@>=
+begin loc:=limit+1; cur_cmd:=spacer; cur_chr:=" ";
+end
+
+@ The following code is performed only when |cur_cmd=spacer|.
+
+@<Enter |skip_blanks| state, emit a space@>=
+begin state:=skip_blanks; cur_chr:=" ";
+end
+
+@ @<Finish line, |goto switch|@>=
+begin loc:=limit+1; goto switch;
+end
+
+@ @<Finish line, emit a \.{\\par}@>=
+begin loc:=limit+1; cur_cs:=par_loc; cur_cmd:=eq_type(cur_cs);
+cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ Notice that a code like \.{\^\^8} becomes \.x if not followed by a hex digit.
+
+@d is_hex(#)==(((#>="0")and(#<="9"))or((#>="a")and(#<="f")))
+@d hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10
+@d long_hex_to_cur_chr==
+ if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10;
+ if cc<="9" then cur_chr:=16*cur_chr+cc-"0"
+ else cur_chr:=16*cur_chr+cc-"a"+10;
+ if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0"
+ else cur_chr:=16*cur_chr+ccc-"a"+10;
+ if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0"
+ else cur_chr:=16*cur_chr+cccc-"a"+10
+
+@<If this |sup_mark| starts an expanded character...@>=
+begin if cur_chr=buffer[loc] then if loc<limit then
+ begin sup_count:=2;
+ {we have |^^| and another char; check how many |^|s we have altogether, up to a max of 6}
+ while (sup_count<6) and (loc+2*sup_count-2<=limit) and (cur_chr=buffer[loc+sup_count-1]) do
+ incr(sup_count);
+ {check whether we have enough hex chars for the number of |^|s}
+ for d:=1 to sup_count do
+ if not is_hex(buffer[loc+sup_count-2+d]) then {found a non-hex char, so do single |^^X| style}
+ begin c:=buffer[loc+1];
+ if c<@'200 then
+ begin loc:=loc+2;
+ if c<@'100 then cur_chr:=c+@'100 @+else cur_chr:=c-@'100;
+ goto reswitch;
+ end;
+ goto not_exp;
+ end;
+ {there were the right number of hex chars, so convert them}
+ cur_chr:=0;
+ for d:=1 to sup_count do
+ begin c:=buffer[loc+sup_count-2+d];
+ if c<="9" then cur_chr:=16*cur_chr+c-"0"
+ else cur_chr:=16*cur_chr+c-"a"+10;
+ end;
+ {check the resulting value is within the valid range}
+ if cur_chr>biggest_usv then
+ begin cur_chr:=buffer[loc];
+ goto not_exp;
+ end;
+ loc:=loc+2*sup_count-1;
+ goto reswitch;
+ end;
+not_exp:
+state:=mid_line;
+end
+
+@ @<Process an active-character...@>=
+begin cur_cs:=cur_chr+active_base;
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); state:=mid_line;
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ 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.
+
+@<Scan a control...@>=
+begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case}
+else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
+ incr(k);
+ if cat=letter then state:=skip_blanks
+ else if cat=spacer then state:=skip_blanks
+ else state:=mid_line;
+ if (cat=letter)and(k<=limit) then
+ @<Scan ahead in the buffer until finding a nonletter;
+ if an expanded code is encountered, reduce it
+ and |goto start_cs|; otherwise if a multiletter control
+ sequence is found, adjust |cur_cs| and |loc|, and
+ |goto found|@>
+ else @<If an expanded code is present, reduce it and |goto start_cs|@>;
+ {At this point, we have a single-character cs name in the buffer.
+ But if the character code is ${}>|@"FFFF|$, we treat it like a multiletter name
+ for string purposes, because we use UTF-16 in the string pool.}
+ if buffer[loc]>@"FFFF then begin
+ cur_cs:=id_lookup(loc,1); incr(loc); goto found;
+ end;
+ cur_cs:=single_base+buffer[loc]; incr(loc);
+ end;
+found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>=outer_call then check_outer_validity;
+end
+
+@ Whenever we reach the following piece of code, we will have
+|cur_chr=buffer[k-1]| and |k<=limit+1| and |cat=cat_code(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.
+
+@<If an expanded...@>=
+begin if (cat=sup_mark) and (buffer[k]=cur_chr) and (k<limit) then
+ begin sup_count:=2;
+ {we have |^^| and another char; check how many |^|s we have altogether, up to a max of 6}
+ while (sup_count<6) and (k+2*sup_count-2<=limit) and (buffer[k+sup_count-1]=cur_chr) do
+ incr(sup_count);
+ {check whether we have enough hex chars for the number of |^|s}
+ for d:=1 to sup_count do
+ if not is_hex(buffer[k+sup_count-2+d]) then {found a non-hex char, so do single |^^X| style}
+ begin c:=buffer[k+1];
+ if c<@'200 then
+ begin if c<@'100 then buffer[k-1]:=c+@'100 @+else buffer[k-1]:=c-@'100;
+ d:=2; limit:=limit-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ else sup_count:=0;
+ end;
+ if sup_count>0 then {there were the right number of hex chars, so convert them}
+ begin cur_chr:=0;
+ for d:=1 to sup_count do
+ begin c:=buffer[k+sup_count-2+d];
+ if c<="9" then cur_chr:=16*cur_chr+c-"0"
+ else cur_chr:=16*cur_chr+c-"a"+10;
+ end;
+ {check the resulting value is within the valid range}
+ if cur_chr>biggest_usv then cur_chr:=buffer[k]
+ else begin buffer[k-1]:=cur_chr;
+ d:=2*sup_count-1;
+ {shift the rest of the buffer left by |d| chars}
+ limit:=limit-d;
+ while k<=limit do
+ begin buffer[k]:=buffer[k+d]; incr(k);
+ end;
+ goto start_cs;
+ end
+ end
+ end
+end
+
+@ @<Scan ahead in the buffer...@>=
+begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k);
+until (cat<>letter)or(k>limit);
+@<If an expanded...@>;
+if cat<>letter then decr(k);
+ {now |k| points to first nonletter}
+if k>loc+1 then {multiletter control sequence has been scanned}
+ begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found;
+ end;
+end
+
+@ Let's consider now what happens when |get_next| is looking at a token list.
+
+@<Input from token list, |goto restart| if end of list or
+ if a parameter needs to be expanded@>=
+if loc<>null then {list not exhausted}
+@^inner loop@>
+ begin t:=info(loc); loc:=link(loc); {move to next}
+ if t>=cs_token_flag then {a control sequence token}
+ begin cur_cs:=t-cs_token_flag;
+ cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+ if cur_cmd>=outer_call then
+ if cur_cmd=dont_expand then
+ @<Get the next token, suppressing expansion@>
+ else check_outer_validity;
+ end
+ else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val;
+ case cur_cmd of
+ left_brace: incr(align_state);
+ right_brace: decr(align_state);
+ out_param: @<Insert macro parameter and |goto restart|@>;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+else begin {we are done with this token list}
+ end_token_list; goto restart; {resume previous level}
+ end
+
+@ 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|.
+
+@d no_expand_flag=special_char {this characterizes a special variant of |relax|}
+
+@<Get the next token, suppressing expansion@>=
+begin cur_cs:=info(loc)-cs_token_flag; loc:=null;@/
+cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
+if cur_cmd>max_command then
+ begin cur_cmd:=relax; cur_chr:=no_expand_flag;
+ end;
+end
+
+@ @<Insert macro parameter...@>=
+begin begin_token_list(param_stack[param_start+cur_chr-1],parameter);
+goto restart;
+end
+
+@ All of the easy branches of |get_next| have now been taken care of.
+There is one more branch.
+
+@d end_line_char_inactive == (end_line_char<0)or(end_line_char>255)
+
+@<Move to next line of file, or |goto restart|...@>=
+if name>17 then @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>
+else begin if not terminal_input then {\.{\\read} line has ended}
+ begin cur_cmd:=0; cur_chr:=0; return;
+ end;
+ if input_ptr>0 then {text was inserted during error recovery}
+ begin end_file_reading; goto restart; {resume previous level}
+ end;
+ if selector<log_only then open_log_file;
+ if interaction>nonstop_mode then
+ begin if end_line_char_inactive then incr(limit);
+ if limit=start then {previous line was empty}
+ print_nl("(Please type a command or say `\end')");
+@.Please type...@>
+ print_ln; first:=start;
+ prompt_input("*"); {input on-line into |buffer|}
+@.*\relax@>
+ limit:=last;
+ if end_line_char_inactive then decr(limit)
+ else buffer[limit]:=end_line_char;
+ first:=limit+1;
+ loc:=start;
+ end
+ else fatal_error("*** (job aborted, no legal \end found)");
+@.job aborted@>
+ {nonstop mode, which is intended for overnight batch processing,
+ never waits for on-line input}
+ end
+
+@ 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?}
+
+@ @<Read next line of file into |buffer|, or
+ |goto restart| if the file has ended@>=
+begin incr(line); first:=start;
+if not force_eof then
+ if name<=19 then
+ begin if pseudo_input then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end
+ else
+ begin if input_ln(cur_file,true) then {not end of file}
+ firm_up_the_line {this sets |limit|}
+ else if (every_eof<>null)and not eof_seen[index] then
+ begin limit:=first-1; eof_seen[index]:=true; {fake one empty line}
+ begin_token_list(every_eof,every_eof_text); goto restart;
+ end
+ else force_eof:=true;
+ end;
+if force_eof then
+ begin if tracing_nesting>0 then
+ if (grp_stack[in_open]<>cur_boundary)or@|
+ (if_stack[in_open]<>cond_ptr) then file_warning;
+ {give warning for some unfinished groups and/or conditionals}
+ if name>=19 then
+ begin print_char(")"); decr(open_parens);
+ update_terminal; {show user that file has been read}
+ end;
+ force_eof:=false;
+ end_file_reading; {resume previous level}
+ check_outer_validity; goto restart;
+ end;
+if end_line_char_inactive then decr(limit)
+else buffer[limit]:=end_line_char;
+first:=limit+1; loc:=start; {ready to read}
+end
+
+@ 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 almost every use of |get_next|.
+
+@ 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_next; no_new_control_sequence:=true;
+@^inner loop@>
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+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}
+
+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''}
+@!b:boolean; {keep track of nested csnames}
+@!p,@!q,@!r:pointer; {for list manipulation}
+@!j:0..buf_size; {index into |buffer|}
+@!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 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;
+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)@>
+
+Simply pushing back a token that matches the correct internal command
+does not work, because approach would not survive roundtripping to a
+temporary file.
+
+@<Implement \.{\\primitive}@>=
+begin save_scanner_status:=scanner_status; scanner_status:=normal;
+get_token; scanner_status:=save_scanner_status;
+if cur_cs < hash_base then
+ cur_cs:=prim_lookup(cur_cs-single_base)
+else
+ cur_cs:=prim_lookup(text(cur_cs));
+if cur_cs<>undefined_primitive then begin
+ t:=prim_eq_type(cur_cs);
+ if t>max_command then begin
+ cur_cmd:=t;
+ cur_chr:=prim_equiv(cur_cs);
+ cur_tok:=(cur_cmd*max_char_val)+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
+
+@ This block deals with unexpandable \.{\\primitive} appearing at a spot where
+an integer or an internal values should have been found. It fetches the
+next token then resets |cur_cmd|, |cur_cs|, and |cur_tok|, based on the
+primitive value of that token. No expansion takes place, because the
+next token may be all sorts of things. This could trigger further
+expansion creating new errors.
+
+@<Reset |cur_tok| for unexpandable primitives, goto restart @>=
+begin
+get_token;
+if cur_cs < hash_base then
+ cur_cs := prim_lookup(cur_cs-single_base)
+else
+ cur_cs := prim_lookup(text(cur_cs));
+if cur_cs<>undefined_primitive then begin
+ cur_cmd := prim_eq_type(cur_cs);
+ cur_chr := prim_equiv(cur_cs);
+ cur_cs := prim_eqtb_base+cur_cs;
+ cur_tok := cs_token_flag+cur_cs;
+ end
+else begin
+ cur_cmd := relax;
+ cur_chr := 0;
+ cur_tok := cs_token_flag+frozen_relax;
+ cur_cs := frozen_relax;
+ end;
+goto restart;
+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}
+b:=is_in_csname; 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:=b;
+@<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_usv);
+ {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+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
+ end;
+if (j>first+1) or (buffer[first]>@"FFFF) 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}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ 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_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*max_char_val)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ The |get_x_token| procedure is essentially 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_next;
+ end;
+if cur_cs=0 then cur_tok:=(cur_cmd*max_char_val)+cur_chr
+else cur_tok:=cs_token_flag+cur_cs;
+end;
+
+@ 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 a
+global array of five pointers; we refer to the individual entries of this
+array by symbolic names |top_mark|, etc. The value of |top_mark| is either
+|null| or a pointer to the reference count of a token list.
+
+@d marks_code==5 {add this for \.{\\topmarks} etc.}
+@#
+@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==cur_mark[top_mark_code]
+@d first_mark==cur_mark[first_mark_code]
+@d bot_mark==cur_mark[bot_mark_code]
+@d split_first_mark==cur_mark[split_first_mark_code]
+@d split_bot_mark==cur_mark[split_bot_mark_code]
+
+@<Glob...@>=
+@!cur_mark:array[top_mark_code..split_bot_mark_code] of pointer;
+ {token lists for marks}
+
+@ @<Set init...@>=
+top_mark:=null; first_mark:=null; bot_mark:=null;
+split_first_mark:=null; split_bot_mark:=null;
+
+@ @<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@>
+
+@ @<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_register_num@+else cur_val:=0;
+if cur_val=0 then cur_ptr:=cur_mark[t]
+else @<Compute the mark pointer for mark type |t| and class |cur_val|@>;
+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;
+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_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_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;
+goto continue;
+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_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) then
+ begin link(rbrace_ptr):=null; free_avail(p);
+ p:=link(temp_head); pstack[n]:=link(p); free_avail(p);
+ end
+else pstack[n]:=link(temp_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;
+
+@ @<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|}
+@!save_cur_cs:pointer; {to save |cur_cs|}
+begin p:=backup_head; link(p):=null;
+if s<too_big_char then begin
+ while true do
+ begin get_x_token; {recursion is possible here}
+@^recursion@>
+ if (cur_cs=0)and@|
+ ((cur_chr=s)or(cur_chr=s-"a"+"A")) then
+ begin store_new_token(cur_tok);
+ flush_list(link(backup_head)); scan_keyword:=true; return;
+ end
+ else if (cur_cmd<>spacer)or(p<>backup_head) then
+ begin back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ scan_keyword:=false; return;
+ end;
+ end;
+ end;
+k:=str_start_macro(s);
+save_cur_cs:=cur_cs;
+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 back_input;
+ if p<>backup_head then back_list(link(backup_head));
+ cur_cs:=save_cur_cs;
+ scan_keyword:=false; return;
+ end;
+ end;
+flush_list(link(backup_head)); scan_keyword:=true;
+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@>
+
+@ \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. Six levels are distinguished, namely |int_val|,
+|dimen_val|, |glue_val|, |mu_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 dimen_val=1 {dimension values}
+@d glue_val=2 {glue specifications}
+@d mu_val=3 {math glue specifications}
+@d ident_val=4 {font identifier}
+@d tok_val=5 {token lists}
+@d inter_char_val=6 {inter-character (class) token lists}
+
+@<Glob...@>=
+@!cur_val:integer; {value returned by numeric scanners}
+@!cur_val1:integer; {value returned by numeric scanners}
+@!cur_val_level:int_val..tok_val; {the ``level'' of this value}
+
+@ The hash table is initialized with `\.{\\count}', `\.{\\dimen}', `\.{\\skip}',
+and `\.{\\muskip}' all having |register| as their command code; they are
+distinguished by the |chr_code|, which is either |int_val|, |dimen_val|,
+|glue_val|, or |mu_val| more than |mem_bot| (dynamic variable-size nodes
+cannot have these values)
+
+@<Put each...@>=
+primitive("count",register,mem_bot+int_val);
+@!@:count_}{\.{\\count} primitive@>
+primitive("dimen",register,mem_bot+dimen_val);
+@!@:dimen_}{\.{\\dimen} primitive@>
+primitive("skip",register,mem_bot+glue_val);
+@!@:skip_}{\.{\\skip} primitive@>
+primitive("muskip",register,mem_bot+mu_val);
+@!@:mu_skip_}{\.{\\muskip} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+register: @<Cases of |register| for |print_cmd_chr|@>;
+
+@ 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
+
+@d char_class_limit = @"1000
+@d char_class_ignored == char_class_limit
+@d char_class_boundary == (char_class_ignored - 1)
+
+@p procedure scan_something_internal(@!level:small_number;@!negative:boolean);
+ {fetch an internal parameter}
+label exit, restart;
+var m:halfword; {|chr_code| part of the operand token}
+ n, k, kk: integer; {accumulators}
+@!q,@!r:pointer; {general purpose indices}
+@!tx:pointer; {effective tail node}
+@!i:four_quarters; {character info}
+@!p:0..nest_size; {index into |nest|}
+begin restart: m:=cur_chr;
+case cur_cmd of
+def_code: @<Fetch a character code from some table@>;
+XeTeX_def_code:
+ begin
+ scan_usv_num;
+ if m=sf_code_base then begin
+ scanned_result(ho(sf_code(cur_val) div @"10000))(int_val)
+ end
+ else if m=math_code_base then begin
+ scanned_result(ho(math_code(cur_val)))(int_val)
+ end
+ else if m=math_code_base+1 then begin
+ print_err("Can't use \Umathcode as a number (try \Umathcodenum)");
+ help2("\Umathcode is for setting a mathcode from separate values;")@/
+ ("use \Umathcodenum to access them as single values."); error;
+ scanned_result(0)(int_val)
+ end
+ else if m=del_code_base then begin
+ scanned_result(ho(del_code(cur_val)))(int_val)
+ end else begin
+ print_err("Can't use \Udelcode as a number (try \Udelcodenum)");
+ help2("\Udelcode is for setting a delcode from separate values;")@/
+ ("use \Udelcodenum to access them as single values."); error;
+ scanned_result(0)(int_val);
+ end;
+ end;
+toks_register,assign_toks,def_family,set_font,def_font: @<Fetch a token list or
+ font identifier, provided that |level=tok_val|@>;
+assign_int: scanned_result(eqtb[m].int)(int_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,XeTeX_math_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@>;
+ignore_spaces: {trap unexpandable primitives}
+ if cur_chr=1 then @<Reset |cur_tok| for unexpandable primitives, goto restart@>;
+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;
+
+@ @<Fetch a character code from some table@>=
+begin scan_usv_num;
+if m=math_code_base then begin
+ cur_val1:=ho(math_code(cur_val));
+ if is_active_math_char(cur_val1) then
+ cur_val1:=@"8000
+ else if (math_class_field(cur_val1)>7) or
+ (math_fam_field(cur_val1)>15) or
+ (math_char_field(cur_val1)>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:=(math_class_field(cur_val1)*@"1000) +
+ (math_fam_field(cur_val1)*@"100) +
+ math_char_field(cur_val1);
+ scanned_result(cur_val1)(int_val)
+ end
+else if m=del_code_base then begin
+ cur_val1:=del_code(cur_val);
+ if cur_val1>=@"40000000 then begin
+ print_err("Extended delcode used as delcode");
+@.Bad delcode@>
+ help2("A delimiter code must be between 0 and ""7FFFFFF.")@/
+ ("I changed this one to zero."); error;
+ scanned_result(0)(int_val);
+ end else begin
+ scanned_result(cur_val1)(int_val);
+ end
+end
+else if m<sf_code_base then scanned_result(equiv(m+cur_val))(int_val)
+else if m<math_code_base then scanned_result(equiv(m+cur_val) mod @"10000)(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|}
+ if m=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then cur_val:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end;
+ end
+ else cur_val:=sa_ptr(m)
+ else if cur_chr=XeTeX_inter_char_loc then begin
+ scan_char_class_not_ignored; cur_ptr:=cur_val;
+ scan_char_class_not_ignored;
+ find_sa_element(inter_char_val, cur_ptr*char_class_limit + cur_val, false);
+ if cur_ptr=null then cur_val:=null
+ else cur_val:=sa_ptr(cur_ptr);
+ end else cur_val:=equiv(m);
+ cur_val_level:=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|.
+\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 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 elapsed_time_code = pdftex_first_rint_code + 10 {code for \.{\\elapsedtime}}
+@d pdf_shell_escape_code = pdftex_first_rint_code + 11 {code for \.{\\shellescape}}
+@d random_seed_code = pdftex_first_rint_code + 12 {code for \.{\\randomseed}}
+@d pdftex_last_item_codes = pdftex_first_rint_code + 12 {end of \pdfTeX's command codes}
+@#
+@d eTeX_int=pdftex_last_item_codes + 1 {first of \eTeX\ codes for integers}
+@#
+@d XeTeX_int = eTeX_int + 8 {base for \XeTeX's command codes}
+@d XeTeX_version_code = XeTeX_int + 0 {code for \.{\\XeTeXversion}}
+@d XeTeX_count_glyphs_code = XeTeX_int + 1 {code for \.{\\XeTeXcountglyphs}}
+@d XeTeX_count_variations_code = XeTeX_int + 2 {Deprecated}
+@d XeTeX_variation_code = XeTeX_int + 3 {Deprecated}
+@d XeTeX_find_variation_by_name_code = XeTeX_int + 4 {Deprecated}
+@d XeTeX_variation_min_code = XeTeX_int + 5 {Deprecated}
+@d XeTeX_variation_max_code = XeTeX_int + 6 {Deprecated}
+@d XeTeX_variation_default_code = XeTeX_int + 7 {Deprecated}
+@d XeTeX_count_features_code = XeTeX_int + 8 {code for \.{\\XeTeXcountfeatures}}
+@d XeTeX_feature_code_code = XeTeX_int + 9 {code for \.{\\XeTeXfeaturecode}}
+@d XeTeX_find_feature_by_name_code = XeTeX_int + 10 {code for \.{\\XeTeXfindfeaturebyname}}
+@d XeTeX_is_exclusive_feature_code = XeTeX_int + 11 {code for \.{\\XeTeXisexclusivefeature}}
+@d XeTeX_count_selectors_code = XeTeX_int + 12 {code for \.{\\XeTeXcountselectors}}
+@d XeTeX_selector_code_code = XeTeX_int + 13 {code for \.{\\XeTeXselectorcode}}
+@d XeTeX_find_selector_by_name_code = XeTeX_int + 14 {code for \.{\\XeTeXfindselectorbyname}}
+@d XeTeX_is_default_selector_code = XeTeX_int + 15 {code for \.{\\XeTeXisdefaultselector}}
+@d XeTeX_OT_count_scripts_code = XeTeX_int + 16 {code for \.{\\XeTeXOTcountscripts}}
+@d XeTeX_OT_count_languages_code = XeTeX_int + 17 {code for \.{\\XeTeXOTcountlanguages}}
+@d XeTeX_OT_count_features_code = XeTeX_int + 18 {code for \.{\\XeTeXOTcountfeatures}}
+@d XeTeX_OT_script_code = XeTeX_int + 19 {code for \.{\\XeTeXOTscripttag}}
+@d XeTeX_OT_language_code = XeTeX_int + 20 {code for \.{\\XeTeXOTlanguagetag}}
+@d XeTeX_OT_feature_code = XeTeX_int + 21 {code for \.{\\XeTeXOTfeaturetag}}
+@d XeTeX_map_char_to_glyph_code = XeTeX_int + 22 {code for \.{\\XeTeXcharglyph}}
+@d XeTeX_glyph_index_code = XeTeX_int + 23 {code for \.{\\XeTeXglyphindex}}
+@d XeTeX_font_type_code = XeTeX_int + 24 {code for \.{\\XeTeXfonttype}}
+@d XeTeX_first_char_code = XeTeX_int + 25 {code for \.{\\XeTeXfirstfontchar}}
+@d XeTeX_last_char_code = XeTeX_int + 26 {code for \.{\\XeTeXlastfontchar}}
+@d XeTeX_pdf_page_count_code = XeTeX_int + 27 {code for \.{\\XeTeXpdfpagecount}}
+@d XeTeX_last_item_codes = XeTeX_int + 27 {end of \XeTeX's command codes}
+@#
+@d XeTeX_dim = XeTeX_last_item_codes + 1 {first of \XeTeX\ codes for dimensions}
+@d XeTeX_glyph_bounds_code = XeTeX_dim + 0 {code for \.{\\XeTeXglyphbounds}}
+@d XeTeX_last_dim_codes = XeTeX_dim + 0 {end of \XeTeX's command codes}
+@#
+@d eTeX_dim=XeTeX_last_dim_codes+1 {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("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("elapsedtime",last_item,elapsed_time_code);
+@!@:elapsed_time_}{\.{\\elapsedtime} primitive@>
+primitive("shellescape",last_item,pdf_shell_escape_code);
+@!@:pdf_shell_escape_}{\.{\\shellescape} primitive@>
+primitive("randomseed",last_item,random_seed_code);
+@!@:random_seed_}{\.{\\randomseed} 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|@>@/
+ pdf_last_x_pos_code: print_esc("pdflastxpos");
+ pdf_last_y_pos_code: print_esc("pdflastypos");
+ elapsed_time_code: print_esc("elapsedtime");
+ pdf_shell_escape_code: print_esc("shellescape");
+ random_seed_code: print_esc("randomseed");
+ 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 scanned_result(prev_depth)(dimen_val)
+else scanned_result(space_factor)(int_val)
+
+@ @<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; fetch_box(q);
+if q=null then cur_val:=0 @+else cur_val:=mem[q+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:=info(par_shape_ptr);
+cur_val_level:=int_val;
+end
+
+@ Here is where \.{\\lastpenalty}, \.{\\lastkern}, \.{\\lastskip}, and
+\.{\\lastnodetype} 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.
+
+The macro |find_effective_tail_eTeX| sets |tx| to the last non-\.{\\endM}
+node of the current list.
+
+@d find_effective_tail_eTeX==
+tx:=tail;
+if not is_char_node(tx) then
+ if (type(tx)=math_node)and(subtype(tx)=end_M_code) then
+ begin r:=head;
+ repeat q:=r; r:=link(q);
+ until r=tx;
+ tx:=q;
+ end
+@#
+@d find_effective_tail==find_effective_tail_eTeX
+
+@<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>=XeTeX_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;
+ elapsed_time_code: cur_val := get_microinterval;
+ random_seed_code: cur_val := random_seed;
+ pdf_shell_escape_code:
+ begin
+ if shellenabledp then begin
+ if restrictedshell then cur_val:=2
+ else cur_val:=1;
+ end
+ else cur_val:=0;
+ end;
+ @/@<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;
+ find_effective_tail;
+ if cur_chr=last_node_type_code then
+ begin cur_val_level:=int_val;
+ if (tx=head)or(mode=0) then cur_val:=-1;
+ end
+ else cur_val_level:=cur_chr;
+ if not is_char_node(tx)and(mode<>0) then
+ case cur_chr of
+ int_val: if type(tx)=penalty_node then cur_val:=penalty(tx);
+ dimen_val: if type(tx)=kern_node then cur_val:=width(tx);
+ glue_val: if type(tx)=glue_node then
+ begin cur_val:=glue_ptr(tx);
+ if subtype(tx)=mu_glue then cur_val_level:=mu_val;
+ end;
+ last_node_type_code: if type(tx)<=unset_node then cur_val:=type(tx)+1
+ else cur_val:=unset_node+2;
+ end {there are no other cases}
+ else if (mode=vmode)and(tx=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@>=
+begin find_font_dimen(false); font_info[fmem_ptr].sc:=0;
+scanned_result(font_info[cur_val].sc)(dimen_val);
+end
+
+@ @<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 begin
+ n:=cur_val;
+ if is_native_font(n) then scan_glyph_number(n)
+ else scan_char_num;
+ k:=cur_val;
+ case m of
+ lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val);
+ rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val);
+ end;
+end;
+end
+
+@ @<Fetch a register@>=
+begin if (m<mem_bot)or(m>lo_mem_stat_max) then
+ begin cur_val_level:=sa_type(m);
+ if cur_val_level<glue_val then cur_val:=sa_int(m)
+ else cur_val:=sa_ptr(m);
+ end
+else begin scan_register_num; cur_val_level:=m-mem_bot;
+ if cur_val>255 then
+ begin find_sa_element(cur_val_level,cur_val,false);
+ if cur_ptr=null then
+ if cur_val_level<glue_val then cur_val:=0
+ else cur_val:=zero_glue
+ else if cur_val_level<glue_val then cur_val:=sa_int(cur_ptr)
+ else cur_val:=sa_ptr(cur_ptr);
+ end
+ else
+ case cur_val_level of
+int_val:cur_val:=count(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}
+ end;
+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
+
+@ 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|.
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+
+procedure scan_glyph_number(f: internal_font_number);
+{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number }
+begin
+ if scan_keyword("/") then {set cp value by glyph name}
+ begin
+ scan_and_pack_name; {result is in |nameoffile|}
+ scanned_result(map_glyph_to_index(f))(int_val);
+ end else if scan_keyword("u") then {set cp value by unicode}
+ begin
+ scan_char_num;
+ scanned_result(map_char_to_glyph(f,cur_val))(int_val);
+ end else
+ scan_int;
+end;
+
+procedure scan_char_class;
+begin scan_int;
+if (cur_val<0)or(cur_val>char_class_limit) then
+ begin print_err("Bad character class");
+@.Bad character code@>
+ help2("A character class must be between 0 and 4096.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_char_class_not_ignored;
+begin scan_int;
+if (cur_val<0)or(cur_val>char_class_limit) then
+ begin print_err("Bad character class");
+@.Bad character code@>
+ help2("A class for inter-character transitions must be between 0 and 4095.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_eight_bit_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>255) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2("A register code or char class must be 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_usv_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>biggest_usv) then
+ begin print_err("Bad character code");
+@.Bad character code@>
+ help2("A Unicode scalar value must be between 0 and ""10FFFF.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+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 65535.")@/
+ ("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_xetex_math_char_int;
+begin scan_int;
+ if is_active_math_char(cur_val) then begin
+ if cur_val <> active_math_char then begin
+ print_err("Bad active XeTeX math code");
+ help2("Since I ignore class and family for active math chars,")@/
+ ("I changed this one to ""1FFFFF."); int_error(cur_val);
+ cur_val:=active_math_char;
+ end
+ end else if math_char_field(cur_val)>biggest_usv then begin
+ print_err("Bad XeTeX math character code");
+ help2("Since I expected a character number between 0 and ""10FFFF,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_math_class_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>7) then
+ begin print_err("Bad math class");
+@.Bad number@>
+ help2("Since I expected to read a number between 0 and 7,")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+procedure scan_math_fam_int;
+begin scan_int;
+if (cur_val<0)or(cur_val>number_math_families-1) then
+ begin print_err("Bad math family");
+@.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;
+
+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;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+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;
+end;
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_delimiter_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;
+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:=normal;
+
+@ 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, restart;
+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@>;
+restart:
+if cur_tok=alpha_token then @<Scan an alphabetic character code into |cur_val|@>
+else if cur_tok=cs_token_flag+frozen_primitive then
+ @<Reset |cur_tok| for unexpandable primitives, goto restart@>
+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+single_base then
+ cur_val:=cur_tok-cs_token_flag-active_base
+else cur_val:=cur_tok-cs_token_flag-single_base;
+if cur_val>biggest_usv 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 xetex_scan_dimen(@!mu,@!inf,@!shortcut,@!requires_units: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;
+if requires_units then begin
+@<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@>;
+end else begin
+ if cur_val>=@'40000 then arith_error:=true
+ else cur_val:=cur_val*unity+f;
+end;
+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;
+
+procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean);
+begin
+ xetex_scan_dimen(mu,inf,shortcut,true);
+end;
+
+@ For XeTeX, we have an additional version |scan_decimal|, like |scan_dimen|
+but without any scanning of units.
+
+@p procedure scan_decimal;
+ {sets |cur_val| to a quantity expressed as a decimal fraction}
+begin
+ xetex_scan_dimen(false, false, false, false);
+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:
+
+@ A specification like `\.{filllll}' or `\.{fill L L L}' will lead to two
+error messages (one for each additional keyword \.{"l"}).
+
+@<Scan for \(f)\.{fil} units...@>=
+if scan_keyword("fil") then
+@.fil@>
+ begin cur_order:=fil;
+ while scan_keyword("l") do
+ begin if cur_order=filll then
+ begin print_err("Illegal unit of measure (");
+@.Illegal unit of measure@>
+ print("replaced by filll)");
+ help1("I dddon't go any higher than filll."); error;
+ end
+ else incr(cur_order);
+ end;
+ 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 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 sum 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).
+
+@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("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, 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 width(q):=default_rule
+else begin height(q):=default_rule; depth(q):=0;
+ 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_head)| and ends
+at the value |p| that is returned. (If |p=temp_head|, the list is empty.)
+
+The |str_toks_cat| function is the same, except that the catcode |cat| is
+stamped on all the characters, unless zero is passed in which case it
+chooses |spacer| or |other_char| automatically.
+
+@p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
+function str_toks_cat(@!b:pool_pointer;@!cat:small_number):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 str_room(1);
+p:=temp_head; link(p):=null; k:=b;
+while k<pool_ptr do
+ begin t:=so(str_pool[k]);
+ if (t=" ") and (cat=0) then t:=space_token
+ else begin if (t >= @"D800) and (t <= @"DBFF) and (k+1 < pool_ptr)
+ and (so(str_pool[k+1]) >= @"DC00) and (so(str_pool[k+1]) <= @"DFFF) then
+ begin
+ incr(k);
+ t := @"10000 + (t - @"D800) * @"400 + (so(str_pool[k]) - @"DC00);
+ end;
+ if cat=0 then t := other_token + t
+ else if cat=active_char then t := cs_token_flag + active_base + t
+ else t := max_char_val * cat + t;
+ end;
+ fast_store_new_token(t);
+ incr(k);
+ end;
+pool_ptr:=b; str_toks_cat:=p;
+end;
+
+function str_toks(@!b:pool_pointer):pointer;
+begin str_toks:=str_toks_cat(b,0); 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 @<Copy the token list@>
+else begin old_setting:=selector; selector:=new_string; b:=pool_ptr;
+ case cur_val_level of
+ int_val:print_int(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;
+
+@ @<Copy the token list@>=
+begin p:=temp_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;
+the_toks:=p;
+end
+
+@ Here's part of the |expand| subroutine that we are now ready to complete:
+
+@p procedure ins_the_toks;
+begin link(garbage):=the_toks; ins_list(link(temp_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.
+
+@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_convert_base=5 {base for \eTeX's command codes}
+@d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}}
+@d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes}
+@d expanded_code=etex_convert_codes {command code for \.{\\expanded}}
+@d pdftex_first_expand_code = expanded_code + 1 {base for \pdfTeX's command codes}
+@d left_margin_kern_code = pdftex_first_expand_code + 9 {command code for \.{\\leftmarginkern}}
+@d right_margin_kern_code = pdftex_first_expand_code + 10 {command code for \.{\\rightmarginkern}}
+@d pdf_strcmp_code = pdftex_first_expand_code + 11 {command code for \.{\\strcmp}}
+@d pdf_creation_date_code = pdftex_first_expand_code + 15 {command code for \.{\\creationdate}}
+@d pdf_file_mod_date_code = pdftex_first_expand_code + 16 {command code for \.{\\filemoddate}}
+@d pdf_file_size_code = pdftex_first_expand_code + 17 {command code for \.{\\filesize}}
+@d pdf_mdfive_sum_code = pdftex_first_expand_code + 18 {command code for \.{\\mdfivesum}}
+@d pdf_file_dump_code = pdftex_first_expand_code + 19 {command code for \.{\\filedump}}
+@d uniform_deviate_code = pdftex_first_expand_code + 22 {command code for \.{\\uniformdeviate}}
+@d normal_deviate_code = pdftex_first_expand_code + 23 {command code for \.{\\normaldeviate}}
+@d pdftex_convert_codes = pdftex_first_expand_code + 26 {end of \pdfTeX's command codes}
+@d XeTeX_first_expand_code = pdftex_convert_codes {base for \XeTeX's command codes}
+@d XeTeX_revision_code = XeTeX_first_expand_code + 0 {command code for \.{\\XeTeXrevision}}
+@d XeTeX_variation_name_code = XeTeX_first_expand_code + 1 {command code for \.{\\XeTeXvariationname}}
+@d XeTeX_feature_name_code = XeTeX_first_expand_code + 2 {command code for \.{\\XeTeXfeaturename}}
+@d XeTeX_selector_name_code = XeTeX_first_expand_code + 3 {command code for \.{\\XeTeXselectornamename}}
+@d XeTeX_glyph_name_code = XeTeX_first_expand_code + 4 {command code for \.{\\XeTeXglyphname}}
+@d XeTeX_Uchar_code = XeTeX_first_expand_code + 5 {command code for \.{\\Uchar}}
+@d XeTeX_Ucharcat_code = XeTeX_first_expand_code + 6 {command code for \.{\\Ucharcat}}
+@d XeTeX_convert_codes = XeTeX_first_expand_code + 7 {end of \XeTeX's command codes}
+@d job_name_code=XeTeX_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("fontname",convert,font_name_code);@/
+@!@:font_name_}{\.{\\fontname} primitive@>
+@#
+@#
+primitive("expanded",convert,expanded_code);@/
+@!@:expanded_}{\.{\\expanded} 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("creationdate",convert,pdf_creation_date_code);@/
+@!@:pdf_creation_date_}{\.{\\creationdate} primitive@>
+primitive("filemoddate",convert,pdf_file_mod_date_code);@/
+@!@:pdf_file_mod_date_}{\.{\\filemoddate} primitive@>
+primitive("filesize",convert,pdf_file_size_code);@/
+@!@:pdf_file_size_}{\.{\\filesize} primitive@>
+primitive("mdfivesum",convert,pdf_mdfive_sum_code);@/
+@!@:pdf_mdfive_sum_}{\.{\\mdfivesum} primitive@>
+primitive("filedump",convert,pdf_file_dump_code);@/
+@!@:pdf_file_dump_}{\.{\\filedump} primitive@>
+primitive("strcmp",convert,pdf_strcmp_code);@/
+@!@:pdf_strcmp_}{\.{\\strcmp} primitive@>
+primitive("uniformdeviate",convert,uniform_deviate_code);@/
+@!@:uniform_deviate_}{\.{\\uniformdeviate} primitive@>
+primitive("normaldeviate",convert,normal_deviate_code);@/
+@!@:normal_deviate_}{\.{\\normaldeviate} primitive@>
+
+@#
+primitive("jobname",convert,job_name_code);@/
+@!@:job_name_}{\.{\\jobname} primitive@>
+
+primitive("Uchar",convert,XeTeX_Uchar_code);@/
+@!@:XeTeX_Uchar_}{\.{\\Uchar} primitive@>
+primitive("Ucharcat",convert,XeTeX_Ucharcat_code);@/
+@!@:XeTeX_Ucharcat_}{\.{\\Ucharcat} 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");
+ font_name_code: print_esc("fontname");
+ eTeX_revision_code: print_esc("eTeXrevision");
+ expanded_code: print_esc("expanded");
+ left_margin_kern_code: print_esc("leftmarginkern");
+ right_margin_kern_code: print_esc("rightmarginkern");
+ pdf_creation_date_code: print_esc("creationdate");
+ pdf_file_mod_date_code: print_esc("filemoddate");
+ pdf_file_size_code: print_esc("filesize");
+ pdf_mdfive_sum_code: print_esc("mdfivesum");
+ pdf_file_dump_code: print_esc("filedump");
+ pdf_strcmp_code: print_esc("strcmp");
+ uniform_deviate_code: print_esc("uniformdeviate");
+ normal_deviate_code: print_esc("normaldeviate");
+ @/@<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_macro(str_ptr)<pool_ptr then u:=make_string else u:=0
+@d restore_cur_string==if u<>0 then decr(str_ptr)
+
+@p procedure conv_toks;
+var old_setting:0..max_selector; {holds |selector| setting}
+@!save_warning_index, @!save_def_ref:pointer;
+@!boolvar: boolean; {temp boolean}
+@!s: str_number;
+@!u: str_number;
+@!j: integer;
+@!c:small_number; {desired type of conversion}
+@!save_scanner_status:small_number; {|scanner_status| upon entry}
+@!b:pool_pointer; {base of temporary string}
+@!fnt,@!arg1,@!arg2:integer; {args for \XeTeX\ extensions}
+@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
+@!i:small_number;
+@!quote_char:UTF16_code;
+@!cat:small_number; {desired catcode, or 0 for automatic |spacer|/|other_char| selection}
+@!saved_chr:UnicodeScalar;
+p, q: pointer;
+begin cat:=0; c:=cur_chr; @<Scan the argument for command |c|@>;
+old_setting:=selector; selector:=new_string; b:=pool_ptr;
+@<Print the result of command |c|@>;
+selector:=old_setting; link(garbage):=str_toks_cat(b,cat); ins_list(link(temp_head));
+end;
+
+@ Not all catcode values are allowed by \.{\\Ucharcat}:
+@d illegal_Ucharcat_catcode(#)==(#<left_brace)or(#>active_char)or(#=out_param)or(#=ignore)
+
+@<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;
+font_name_code: scan_font_ident;
+eTeX_revision_code: do_nothing;
+expanded_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ scan_pdf_ext_toks;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ ins_list(link(def_ref));
+ free_avail(def_ref);
+ def_ref := save_def_ref;
+ restore_cur_string;
+ return;
+ end;
+left_margin_kern_code, right_margin_kern_code: begin
+ scan_register_num;
+ fetch_box(p);
+ if (p = null) or (type(p) <> hlist_node) then
+ pdf_error("marginkern", "a non-empty hbox expected")
+end;
+pdf_creation_date_code:
+ begin
+ b := pool_ptr;
+ getcreationdate;
+ link(garbage) := str_toks(b);
+ ins_list(link(temp_head));
+ return;
+ end;
+pdf_file_mod_date_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ scan_pdf_ext_toks;
+
+ 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(def_ref),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s:=make_string;
+
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfilemoddate(s);
+ link(garbage) := str_toks(b);
+
+ if flushable(s) then
+ flush_string;
+
+ ins_list(link(temp_head));
+ restore_cur_string;
+ return;
+ end;
+pdf_file_size_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ scan_pdf_ext_toks;
+
+ 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(def_ref),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s:=make_string;
+
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfilesize(s);
+ link(garbage) := str_toks(b);
+
+ if flushable(s) then
+ flush_string;
+
+ ins_list(link(temp_head));
+ restore_cur_string;
+ return;
+ end;
+pdf_mdfive_sum_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ boolvar := scan_keyword("file");
+ scan_pdf_ext_toks;
+
+ 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(def_ref),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s:=make_string;
+
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getmd5sum(s, boolvar);
+ link(garbage) := str_toks(b);
+
+ if flushable(s) then
+ flush_string;
+
+ ins_list(link(temp_head));
+ restore_cur_string;
+ return;
+ end;
+pdf_file_dump_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ {scan offset}
+ cur_val := 0;
+ if (scan_keyword("offset")) then begin
+ scan_int;
+ if (cur_val < 0) then begin
+ print_err("Bad file offset");
+@.Bad file offset@>
+ help2("A file offset must be between 0 and 2^{31}-1,")@/
+ ("I changed this one to zero.");
+ int_error(cur_val);
+ cur_val := 0;
+ end;
+ end;
+ i := cur_val;
+ {scan length}
+ cur_val := 0;
+ if (scan_keyword("length")) then begin
+ scan_int;
+ if (cur_val < 0) then begin
+ print_err("Bad dump length");
+@.Bad dump length@>
+ help2("A dump length must be between 0 and 2^{31}-1,")@/
+ ("I changed this one to zero.");
+ int_error(cur_val);
+ cur_val := 0;
+ end;
+ end;
+ j := cur_val;
+ {scan file name}
+ scan_pdf_ext_toks;
+
+ 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(def_ref),null,pool_size-pool_ptr);
+ selector:=old_setting;
+ s:=make_string;
+
+ delete_token_ref(def_ref);
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ b := pool_ptr;
+ getfiledump(s, i, j);
+ link(garbage) := str_toks(b);
+
+ if flushable(s) then
+ flush_string;
+
+ ins_list(link(temp_head));
+ restore_cur_string;
+ return;
+ end;
+pdf_strcmp_code:
+ begin
+ save_scanner_status:=scanner_status;
+ save_warning_index:=warning_index;
+ save_def_ref:=def_ref;
+ save_cur_string;
+ compare_strings;
+ def_ref:=save_def_ref;
+ warning_index:=save_warning_index;
+ scanner_status:=save_scanner_status;
+ restore_cur_string;
+ end;
+XeTeX_Uchar_code: scan_usv_num;
+XeTeX_Ucharcat_code:
+ begin
+ scan_usv_num;
+ saved_chr:=cur_val;
+ scan_int;
+ if illegal_Ucharcat_catcode(cur_val) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ print("), should be in the ranges 1..4, 6..8, 10..13");
+ help1("I'm going to use 12 instead of that illegal code value.");@/
+ error; cat:=12;
+ end else
+ cat:=cur_val;
+ cur_val:=saved_chr;
+ end;
+@/@<Cases of `Scan the argument for command |c|'@>@/
+job_name_code: if job_name=0 then open_log_file;
+uniform_deviate_code: scan_int;
+normal_deviate_code: do_nothing;
+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_char(cur_chr);
+meaning_code: print_meaning;
+font_name_code: begin
+ font_name_str:=font_name[cur_val];
+ if is_native_font(cur_val) then begin
+ quote_char:="""";
+ for i:=0 to length(font_name_str) - 1 do
+ if str_pool[str_start_macro(font_name_str) + i] = """" then quote_char:="'";
+ print_char(quote_char);
+ print(font_name_str);
+ print_char(quote_char);
+ end else
+ print(font_name_str);
+ if font_size[cur_val]<>font_dsize[cur_val] then
+ begin print(" at "); print_scaled(font_size[cur_val]);
+ print("pt");
+ end;
+ end;
+eTeX_revision_code: print(eTeX_revision);
+left_margin_kern_code: begin
+ p:=list_ptr(p);
+ while (p <> null) and
+ (cp_skipable(p) or
+ ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1)))
+ do
+ p:=link(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(p);
+ p:=prev_rightmost(q, null);
+ while (p <> null) and
+ (cp_skipable(p) or
+ ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1)))
+ do
+ p:=prev_rightmost(q, p);
+ 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_strcmp_code: print_int(cur_val);
+uniform_deviate_code: print_int(unif_rand(cur_val));
+normal_deviate_code: print_int(norm_rand);
+XeTeX_Uchar_code,
+XeTeX_Ucharcat_code: print_char(cur_val);
+@/@<Cases of `Print the result of command |c|'@>@/
+job_name_code: print_file_name(job_name, 0, 0);
+end {there are no other cases}
+
+@ 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,continue,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; def_ref:=get_avail; token_ref_count(def_ref):=null;
+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 continue: 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_tok<left_brace_limit 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...@>
+ help2("I'm going to ignore the # sign you just used,")@/
+ ("as well as the token that followed it."); error; goto continue;
+ 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_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_head)<>null then
+ begin link(p):=link(temp_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 unicode_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 read_open[k]:=closed;
+
+@ 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;
+def_ref:=get_avail; token_ref_count(def_ref):=null;
+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 |input_ln|
+must be told not to start with |get|.
+@^system dependencies@>
+
+@<Input the first line of |read_file[m]|@>=
+if input_ln(read_file[m],false) then read_open[m]:=normal
+else begin u_close(read_file[m]); read_open[m]:=closed;
+ 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 input_ln(read_file[m],true) then
+ begin u_close(read_file[m]); 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; limit:=0; 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@>
+
+@ @<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_size=2 {number of words in stack entry for conditionals}
+@d if_line_field(#)==mem[#+1].int
+@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 the current level 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_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:=get_node(if_node_size); link(p):=cond_ptr; type(p):=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:=subtype(p); if_limit:=type(p); cond_ptr:=link(p);
+free_node(p,if_node_size);
+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 link(q)=p then
+ begin type(q):=l; return;
+ end;
+ q:=link(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?}
+@!e:boolean; {keep track of nested csnames}
+@!r:"<"..">"; {relation to be evaluated}
+@!m,@!n: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 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_next;
+ scanner_status:=save_scanner_status;
+ if cur_cs < hash_base then
+ m:=prim_lookup(cur_cs-single_base)
+ else
+ m:=prim_lookup(text(cur_cs));
+ b :=((cur_cmd<>undefined_cs) and
+ (m<>undefined_primitive) and
+ (cur_cmd=prim_eq_type(m)) and
+ (cur_chr=prim_equiv(m)));
+ end;
+end {there are no other cases}
+
+@ @<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);
+end;
+end
+
+@ @<Test if an integer is odd@>=
+begin scan_int; b:=odd(cur_val);
+end
+
+@ @<Test box register status@>=
+begin scan_register_num; fetch_box(p);
+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.
+
+@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;
+ end;
+ end
+
+@<Test if two characters match@>=
+begin get_x_token_or_active_char;
+if (cur_cmd>active_char)or(cur_chr>biggest_usv) then {not a character}
+ begin m:=relax; n:=too_big_usv;
+ 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_usv) then
+ begin cur_cmd:=relax; cur_chr:=too_big_usv;
+ 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_next; n:=cur_cs; p:=cur_cmd; q:=cur_chr;
+get_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.
+
+@ 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}
+@!file_name_quote_char:UTF16_code;
+
+@ 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|. 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@>
+
+@ 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;
+file_name_quote_char:=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 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 |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(#)==begin c:=#; incr(k);
+ if k<=file_name_size then name_of_file[k]:=xchr[c];
+ end
+
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!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 name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[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 |name_of_file|
+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:small_number;@!a,@!b:integer);
+var k:integer; {number of positions filled in |name_of_file|}
+@!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(xord[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(xord[TEX_format_default[j]]);
+if k<=file_name_size then name_length:=k@+else name_length:=file_name_size;
+for k:=name_length+1 to file_name_size do name_of_file[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 |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 in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@p function make_name_string:str_number;
+var k:0..file_name_size; {index into |name_of_file|}
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+ make_name_string:="?"
+else begin
+ make_utf16_name;
+ for k:=0 to name_length16-1 do append_char(name_of_file16[k]);
+ make_name_string:=make_string;
+ end;
+end;
+function u_make_name_string(var f:unicode_file):str_number;
+begin u_make_name_string:=make_name_string;
+end;
+function a_make_name_string(var f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+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"|, |output_file_extension|, 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 |name_of_file| 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(output_file_extension);
+ while not dvi_open_out(dvi_file) do
+ prompt_file_name("file name for output",output_file_extension);
+ output_file_name:=b_make_name_string(dvi_file);
+ end
+
+@<Glob...@>=
+@!output_file_extension: str_number;
+@!no_pdf_output: boolean;
+@!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;
+ if no_pdf_output then output_file_extension:=".xdv"
+ else output_file_extension:=".pdf";
+
+@ 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 a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only; log_opened:=true;
+@<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);
+for k:=1 to l do print(buffer[k]);
+print_ln; {now the transcript file contains the first line of input}
+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(sys_day); print_char(" ");
+months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC';
+for k:=3*sys_month-2 to 3*sys_month do wlog(months[k]);
+print_char(" "); print_int(sys_year); print_char(" ");
+print_two(sys_time div 60); print_char(":"); print_two(sys_time mod 60);
+if eTeX_ex then
+ begin; wlog_cr; wlog('entering extended mode');
+ end;
+end
+
+@ Let's turn now to the procedure that is used to initiate file reading
+when an `\.{\\input}' command is being processed.
+Beware: For historic reasons, this code foolishly conserves a tiny bit
+of string pool space; but that can confuse the interactive `\.E' option.
+@^system dependencies@>
+
+@p procedure start_input; {\TeX\ will \.{\\input} something}
+label done;
+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 a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name",".tex");
+ end;
+done: 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 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("("); incr(open_parens); slow_print(name); update_terminal;
+state:=new_line;
+if name=str_ptr-1 then {conserve string pool space (but see note above)}
+ begin flush_string; name:=cur_name;
+ end;
+@<Read the first line of the new file@>;
+end;
+
+@ Here we have to remember to tell the |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 input_ln(cur_file,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.
+\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@>
+
+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.
+
+@<Glob...@>=
+@!tfm_file:byte_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|,
+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 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 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.
+
+@!@^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|.
+
+@ 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|.
+
+@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 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 boundary character at the
+left, 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
+or kerning command is performed.
+
+@d stop_flag==qi(128) {value indicating `\.{STOP}' in a lig/kern program}
+@d kern_flag==qi(128) {op code for a kern step}
+@d skip_byte(#)==#.b0
+@d next_char(#)==#.b1
+@d op_byte(#)==#.b2
+@d rem_byte(#)==#.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(#)==#.b0 {|top| piece in a recipe}
+@d ext_mid(#)==#.b1 {|mid| piece in a recipe}
+@d ext_bot(#)==#.b2 {|bot| piece in a recipe}
+@d ext_rep(#)==#.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'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.
+
+@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. Since \TeX\ has to absorb such information
+about lots of fonts, it stores most of the data in a large array called
+|font_info|. Each item of |font_info| is a |memory_word|; the |fix_word|
+data gets converted into |scaled| entries, while everything else goes into
+words of type |four_quarters|.
+
+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=font_base..font_max; {|font| in a |char_node|}
+@!font_index=0..font_mem_size; {index into |font_info|}
+
+@ Here now is the (rather formidable) array of font arrays.
+
+@d otgr_font_flag=@"FFFE
+@d aat_font_flag=@"FFFF
+@d is_aat_font(#)==(font_area[#]=aat_font_flag)
+@d is_ot_font(#)==((font_area[#]=otgr_font_flag) and (usingOpenType(font_layout_engine[#])))
+@d is_gr_font(#)==((font_area[#]=otgr_font_flag) and (usingGraphite(font_layout_engine[#])))
+@d is_otgr_font(#)==(font_area[#]=otgr_font_flag)
+@d is_native_font(#)==(is_aat_font(#) or is_otgr_font(#))
+ {native fonts have |font_area| = 65534 or 65535,
+ which would be a string containing an invalid Unicode character}
+@d is_new_mathfont(#)==((font_area[#]=otgr_font_flag) and (isOpenTypeMathFont(font_layout_engine[#])))
+
+@d non_char==qi(too_big_char) {a |halfword| code that can't match a real character}
+@d non_address=0 {a spurious |bchar_label|}
+
+@<Glob...@>=
+@!font_info:array[font_index] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:font_index; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of font_index; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@!bchar_label:array[internal_font_number] of font_index;
+ {start of |lig_kern| program for left boundary character,
+ |non_address| if there is none}
+@!font_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {boundary character, |non_char| if there is none}
+@!font_false_bchar:array[internal_font_number] of min_quarterword..non_char;
+ {|font_bchar| if it doesn't exist in the font, otherwise |non_char|}
+
+@ Besides the arrays just enumerated, we have directory arrays that make it
+easy to get at the individual entries in |font_info|. For example, the
+|char_info| data for character |c| in font |f| will be in
+|font_info[char_base[f]+c].qqqq|; and if |w| is the |width_index|
+part of this word (the |b0| field), the width of the character is
+|font_info[width_base[f]+w].sc|. (These formulas assume that
+|min_quarterword| has already been added to |c| and to |w|, since \TeX\
+stores its quarterwords that way.)
+
+@<Glob...@>=
+@!char_base:array[internal_font_number] of integer;
+ {base addresses for |char_info|}
+@!width_base:array[internal_font_number] of integer;
+ {base addresses for widths}
+@!height_base:array[internal_font_number] of integer;
+ {base addresses for heights}
+@!depth_base:array[internal_font_number] of integer;
+ {base addresses for depths}
+@!italic_base:array[internal_font_number] of integer;
+ {base addresses for italic corrections}
+@!lig_kern_base:array[internal_font_number] of integer;
+ {base addresses for ligature/kerning programs}
+@!kern_base:array[internal_font_number] of integer;
+ {base addresses for kerns}
+@!exten_base:array[internal_font_number] of integer;
+ {base addresses for extensible recipes}
+@!param_base:array[internal_font_number] of integer;
+ {base addresses for font parameters}
+
+@ @<Set init...@>=
+for k:=font_base to font_max do font_used[k]:=false;
+
+@ \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...@>=
+font_ptr:=null_font; fmem_ptr:=7;
+font_name[null_font]:="nullfont"; font_area[null_font]:="";
+hyphen_char[null_font]:="-"; skew_char[null_font]:=-1;
+bchar_label[null_font]:=non_address;
+font_bchar[null_font]:=non_char; font_false_bchar[null_font]:=non_char;
+font_bc[null_font]:=1; font_ec[null_font]:=0;
+font_size[null_font]:=0; font_dsize[null_font]:=0;
+char_base[null_font]:=0; width_base[null_font]:=0;
+height_base[null_font]:=0; depth_base[null_font]:=0;
+italic_base[null_font]:=0; lig_kern_base[null_font]:=0;
+kern_base[null_font]:=0; exten_base[null_font]:=0;
+font_glue[null_font]:=null; font_params[null_font]:=7;
+param_base[null_font]:=-1;
+for k:=0 to 6 do font_info[k].sc:=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];
+
+@ Of course we want to define macros that suppress the detail of how font
+information is actually packed, so that we don't have to write things like
+$$\hbox{|font_info[width_base[f]+font_info[char_base[f]+c].qqqq.b0].sc|}$$
+too often. The \.{WEB} definitions here make |char_info(f)(c)| the
+|four_quarters| word of font information corresponding to character
+|c| of font |f|. If |q| is such a word, |char_width(f)(q)| will be
+the character's width; hence the long formula above is at least
+abbreviated to
+$$\hbox{|char_width(f)(char_info(f)(c))|.}$$
+Usually, of course, we will fetch |q| first and look at several of its
+fields at the same time.
+
+The italic correction of a character will be denoted by
+|char_italic(f)(q)|, so it is analogous to |char_width|. But we will get
+at the height and depth in a slightly different way, since we usually want
+to compute both height and depth if we want either one. The value of
+|height_depth(q)| will be the 8-bit quantity
+$$b=|height_index|\times16+|depth_index|,$$ and if |b| is such a byte we
+will write |char_height(f)(b)| and |char_depth(f)(b)| for the height and
+depth of the character |c| for which |q=char_info(f)(c)|. Got that?
+
+The tag field will be called |char_tag(q)|; the remainder byte will be
+called |rem_byte(q)|, using a macro that we have already defined above.
+
+Access to a character's |width|, |height|, |depth|, and |tag| fields is
+part of \TeX's inner loop, so we want these macros to produce code that is
+as fast as possible under the circumstances.
+@^inner loop@>
+
+@d char_info_end(#)==#].qqqq
+@d char_info(#)==font_info[char_base[#]+char_info_end
+@d char_width_end(#)==#.b0].sc
+@d char_width(#)==font_info[width_base[#]+char_width_end
+@d char_exists(#)==(#.b0>min_quarterword)
+@d char_italic_end(#)==(qo(#.b2)) div 4].sc
+@d char_italic(#)==font_info[italic_base[#]+char_italic_end
+@d height_depth(#)==qo(#.b1)
+@d char_height_end(#)==(#) div 16].sc
+@d char_height(#)==font_info[height_base[#]+char_height_end
+@d char_depth_end(#)==(#) mod 16].sc
+@d char_depth(#)==font_info[depth_base[#]+char_depth_end
+@d char_tag(#)==((qo(#.b2)) mod 4)
+
+@ The global variable |null_character| is set up to be a word of
+|char_info| for a character that doesn't exist. Such a word provides a
+convenient way to deal with erroneous situations.
+
+@<Glob...@>=
+@!null_character:four_quarters; {nonexistent character information}
+
+@ @<Set init...@>=
+null_character.b0:=min_quarterword; null_character.b1:=min_quarterword;
+null_character.b2:=min_quarterword; null_character.b3:=min_quarterword;
+
+@ Here are some macros that help process ligatures and kerns.
+We write |char_kern(f)(j)| to find the amount of kerning specified by
+kerning command~|j| in font~|f|. If |j| is the |char_info| for a character
+with a ligature/kern program, the first instruction of that program is either
+|i=font_info[lig_kern_start(f)(j)]| or |font_info[lig_kern_restart(f)(i)]|,
+depending on whether or not |skip_byte(i)<=stop_flag|.
+
+The constant |kern_base_offset| should be simplified, for \PASCAL\ compilers
+that do not do local optimization.
+@^system dependencies@>
+
+@d char_kern_end(#)==256*op_byte(#)+rem_byte(#)].sc
+@d char_kern(#)==font_info[kern_base[#]+char_kern_end
+@d kern_base_offset==256*(128+min_quarterword)
+@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program}
+@d lig_kern_restart_end(#)==256*op_byte(#)+rem_byte(#)+32768-kern_base_offset
+@d lig_kern_restart(#)==lig_kern_base[#]+lig_kern_restart_end
+
+@ Font parameters are referred to as |slant(f)|, |space(f)|, etc.
+
+@d param_end(#)==param_base[#]].sc
+@d param(#)==font_info[#+param_end
+@d slant==param(slant_code) {slant to the right, per unit distance upward}
+@d space==param(space_code) {normal space between words}
+@d space_stretch==param(space_stretch_code) {stretch between words}
+@d space_shrink==param(space_shrink_code) {shrink between words}
+@d x_height==param(x_height_code) {one ex}
+@d quad==param(quad_code) {one em}
+@d extra_space==param(extra_space_code) {additional space at end of sentence}
+
+@<The em width for |cur_font|@>=quad(cur_font)
+
+@ @<The x-height for |cur_font|@>=x_height(cur_font)
+
+@ \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}
+
+@p function read_font_info(@!u:pointer;@!nom,@!aire:str_number;
+ @!s:scaled):internal_font_number; {input a \.{TFM} file}
+label done,bad_tfm,not_found;
+var k:font_index; {index into |font_info|}
+@!file_opened:boolean; {was |tfm_file| successfully opened?}
+@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np:halfword;
+ {sizes of subfiles}
+@!f:internal_font_number; {the new font's number}
+@!g:internal_font_number; {the number to return}
+@!a,@!b,@!c,@!d:eight_bits; {byte variables}
+@!qw:four_quarters;@!sw:scaled; {accumulators}
+@!bch_label:integer; {left boundary start location, or infinity}
+@!bchar:0..256; {boundary character, or 256}
+@!z:scaled; {the design size or the ``at'' size}
+@!alpha:integer;@!beta:1..16;
+ {auxiliary quantities used in fixed-point multiplication}
+begin g:=null_font;@/
+file_opened:=false;
+pack_file_name(nom,aire,cur_ext);
+if XeTeX_tracing_fonts_state>0 then begin
+ begin_diagnostic;
+ print_nl("Requested font """);
+ print_c_string(stringcast(name_of_file+1));
+ print('"');
+ if s < 0 then begin
+ print(" scaled ");
+ print_int(-s);
+ end else begin
+ print(" at ");
+ print_scaled(s);
+ print("pt");
+ end;
+ end_diagnostic(false);
+end;
+if quoted_filename then begin
+ { quoted name, so try for a native font }
+ g:=load_native_font(u,nom,aire,s);
+ if g<>null_font then goto done;
+end;
+{ it was an unquoted name, or not found as an installed font, so try for a TFM file }
+@<Read and check the font data if file exists;
+ |abort| if the \.{TFM} file is
+ malformed; if there's no room for this font, say so and |goto
+ done|; otherwise |incr(font_ptr)| and |goto done|@>;
+if g<>null_font then goto done;
+if not quoted_filename then begin
+ { we failed to find a TFM file, so try for a native font }
+ g:=load_native_font(u,nom,aire,s);
+ if g<>null_font then goto done
+end;
+bad_tfm:
+if suppress_fontnotfound_error=0 then begin
+ @<Report that the font won't be loaded@>;
+ end;
+done: if file_opened then b_close(tfm_file);
+if XeTeX_tracing_fonts_state>0 then begin
+ if g=null_font then begin
+ begin_diagnostic;
+ print_nl(" -> font not found, using ""nullfont""");
+ end_diagnostic(false);
+ end else if file_opened then begin
+ begin_diagnostic;
+ print_nl(" -> ");
+ print_c_string(stringcast(name_of_file+1));
+ end_diagnostic(false);
+ end;
+end;
+read_font_info:=g;
+end;
+
+@ 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.
+@.TFtoPL@> @.PLtoTF@>
+
+@d start_font_error_message==print_err("Font "); sprint_cs(u);
+ print_char("=");
+ if file_name_quote_char<>0 then print_char(file_name_quote_char);
+ print_file_name(nom,aire,cur_ext);
+ if file_name_quote_char<>0 then print_char(file_name_quote_char);
+ if s>=0 then
+ begin print(" at "); print_scaled(s); print("pt");
+ end
+ else if s<>-1000 then
+ begin print(" scaled "); print_int(-s);
+ end
+
+@<Report that the font won't be loaded@>=
+start_font_error_message;
+@.Font x=xx not loadable...@>
+if file_opened then print(" not loadable: Bad metric (TFM) file")
+else print(" not loadable: Metric (TFM) file not found");
+help5("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>'.");
+error
+
+@ @<Read and check...@>=
+@<Open |tfm_file| for input and |begin|@>;
+@<Read the {\.{TFM}} size fields@>;
+@<Use size fields to allocate font information@>;
+@<Read the {\.{TFM}} header@>;
+@<Read character data@>;
+@<Read box dimensions@>;
+@<Read ligature/kern program@>;
+@<Read extensible character recipes@>;
+@<Read font parameters@>;
+@<Make final adjustments and |goto done|@>;
+end
+
+@ @<Open |tfm_file| for input...@>=
+if aire="" then pack_file_name(nom,TEX_font_area,".tfm")
+else pack_file_name(nom,aire,".tfm");
+check_for_tfm_font_mapping;
+if b_open_in(tfm_file) then begin
+ file_opened:=true
+
+@ 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@>
+
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@d read_sixteen(#)==begin #:=fbyte;
+ if #>127 then abort;
+ fget; #:=#*@'400+fbyte;
+ end
+@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a);
+ fget; b:=fbyte; qw.b1:=qi(b);
+ fget; c:=fbyte; qw.b2:=qi(c);
+ fget; d:=fbyte; qw.b3:=qi(d);
+ #:=qw;
+ end
+
+@ @<Read the {\.{TFM}} size fields@>=
+begin read_sixteen(lf);
+fget; read_sixteen(lh);
+fget; read_sixteen(bc);
+fget; read_sixteen(ec);
+if (bc>ec+1)or(ec>255) then abort;
+if bc>255 then {|bc=256| and |ec=255|}
+ begin bc:=1; ec:=0;
+ end;
+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);
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort;
+if (nw=0)or(nh=0)or(nd=0)or(ni=0) then abort;
+end
+
+@ The preliminary settings of the index-offset variables |char_base|,
+|width_base|, |lig_kern_base|, |kern_base|, and |exten_base| will be
+corrected later by subtracting |min_quarterword| from them; and we will
+subtract 1 from |param_base| too. It's best to forget about such anomalies
+until later.
+
+@<Use size fields to allocate font information@>=
+lf:=lf-6-lh; {|lf| words should be loaded into |font_info|}
+if np<7 then lf:=lf+7-np; {at least seven parameters will appear}
+if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then
+ @<Apologize for not loading the font, |goto done|@>;
+f:=font_ptr+1;
+char_base[f]:=fmem_ptr-bc;
+width_base[f]:=char_base[f]+ec+1;
+height_base[f]:=width_base[f]+nw;
+depth_base[f]:=height_base[f]+nh;
+italic_base[f]:=depth_base[f]+nd;
+lig_kern_base[f]:=italic_base[f]+ni;
+kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset;
+exten_base[f]:=kern_base[f]+kern_base_offset+nk;
+param_base[f]:=exten_base[f]+ne
+
+@ @<Apologize for not loading...@>=
+begin start_font_error_message;
+print(" not loaded: Not enough room left");
+@.Font x=xx not loaded...@>
+help4("I'm afraid I won't be able to make use of this font,")@/
+("because my memory for character-size data is too small.")@/
+("If you're really stuck, ask a wizard to enlarge me.")@/
+("Or maybe try `I\font<same font id>=<name of loaded font>'.");
+error; goto done;
+end
+
+@ Only the first two words of the header are needed by \TeX82.
+
+@<Read the {\.{TFM}} header@>=
+begin if lh<2 then abort;
+store_four_quarters(font_check[f]);
+fget; read_sixteen(z); {this rejects a negative design size}
+fget; z:=z*@'400+fbyte; fget; z:=(z*@'20)+(fbyte div@'20);
+if z<unity then abort;
+while lh>2 do
+ begin fget;fget;fget;fget;decr(lh); {ignore the rest of the header}
+ end;
+font_dsize[f]:=z;
+if s<>-1000 then
+ if s>=0 then z:=s
+ else z:=xn_over_d(z,-s,1000);
+font_size[f]:=z;
+end
+
+@ @<Read character data@>=
+for k:=fmem_ptr to width_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if (a>=nw)or(b div @'20>=nh)or(b mod @'20>=nd)or
+ (c div 4>=ni) then abort;
+ case c mod 4 of
+ lig_tag: if d>=nl then abort;
+ ext_tag: if d>=ne then abort;
+ list_tag: @<Check for charlist cycle@>;
+ othercases do_nothing {|no_tag|}
+ endcases;
+ end
+
+@ 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.
+
+@d check_byte_range(#)==begin if (#<bc)or(#>ec) then abort@+end
+@d current_character_being_worked_on==k+bc-fmem_ptr
+
+@<Check for charlist cycle@>=
+begin check_byte_range(d);
+while d<current_character_being_worked_on do
+ begin qw:=char_info(f)(d);
+ {N.B.: not |qi(d)|, since |char_base[f]| hasn't been adjusted yet}
+ if char_tag(qw)<>list_tag then goto not_found;
+ d:=qo(rem_byte(qw)); {next character on the list}
+ end;
+if d=current_character_being_worked_on then abort; {yes, there's a cycle}
+not_found:end
+
+@ 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.
+
+@d store_scaled(#)==begin fget; a:=fbyte; fget; b:=fbyte;
+ fget; c:=fbyte; fget; d:=fbyte;@/
+ sw:=(((((d*z)div@'400)+(c*z))div@'400)+(b*z))div beta;
+ if a=0 then #:=sw@+else if a=255 then #:=sw-alpha@+else abort;
+ end
+
+@<Read box dimensions@>=
+begin @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=width_base[f] to lig_kern_base[f]-1 do
+ store_scaled(font_info[k].sc);
+if font_info[width_base[f]].sc<>0 then abort; {\\{width}[0] must be zero}
+if font_info[height_base[f]].sc<>0 then abort; {\\{height}[0] must be zero}
+if font_info[depth_base[f]].sc<>0 then abort; {\\{depth}[0] must be zero}
+if font_info[italic_base[f]].sc<>0 then abort; {\\{italic}[0] must be zero}
+end
+
+@ @<Replace |z|...@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+@ @d check_existence(#)==@t@>@;@/
+ begin check_byte_range(#);
+ qw:=char_info(f)(#); {N.B.: not |qi(#)|}
+ if not char_exists(qw) then abort;
+ end
+
+@<Read ligature/kern program@>=
+bch_label:=@'77777; bchar:=256;
+if nl>0 then
+ begin for k:=lig_kern_base[f] to kern_base[f]+kern_base_offset-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a>128 then
+ begin if 256*c+d>=nl then abort;
+ if a=255 then if k=lig_kern_base[f] then bchar:=b;
+ end
+ else begin if b<>bchar then check_existence(b);
+ if c<128 then check_existence(d) {check ligature}
+ else if 256*(c-128)+d>=nk then abort; {check kern}
+ if a<128 then if k-lig_kern_base[f]+a+1>=nl then abort;
+ end;
+ end;
+ if a=255 then bch_label:=256*c+d;
+ end;
+for k:=kern_base[f]+kern_base_offset to exten_base[f]-1 do
+ store_scaled(font_info[k].sc);
+
+@ @<Read extensible character recipes@>=
+for k:=exten_base[f] to param_base[f]-1 do
+ begin store_four_quarters(font_info[k].qqqq);
+ if a<>0 then check_existence(a);
+ if b<>0 then check_existence(b);
+ if c<>0 then check_existence(c);
+ check_existence(d);
+ end
+
+@ 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.
+
+@<Read font parameters@>=
+begin for k:=1 to np do
+ if k=1 then {the |slant| parameter is a pure number}
+ begin fget; sw:=fbyte; if sw>127 then sw:=sw-256;
+ fget; sw:=sw*@'400+fbyte; fget; sw:=sw*@'400+fbyte;
+ fget; font_info[param_base[f]].sc:=
+ (sw*@'20)+(fbyte div@'20);
+ end
+ else store_scaled(font_info[param_base[f]+k-1].sc);
+if eof(tfm_file) then abort;
+for k:=np+1 to 7 do font_info[param_base[f]+k-1].sc:=0;
+end
+
+@ 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.
+
+@d adjust(#)==#[f]:=qo(#[f])
+ {correct for the excess |min_quarterword| that was added}
+
+@<Make final adjustments...@>=
+if np>=7 then font_params[f]:=np@+else font_params[f]:=7;
+hyphen_char[f]:=default_hyphen_char; skew_char[f]:=default_skew_char;
+if bch_label<nl then bchar_label[f]:=bch_label+lig_kern_base[f]
+else bchar_label[f]:=non_address;
+font_bchar[f]:=qi(bchar);
+font_false_bchar[f]:=qi(bchar);
+if bchar<=ec then if bchar>=bc then
+ begin qw:=char_info(f)(bchar); {N.B.: not |qi(bchar)|}
+ if char_exists(qw) then font_false_bchar[f]:=non_char;
+ end;
+font_name[f]:=nom;
+font_area[f]:=aire;
+font_bc[f]:=bc; font_ec[f]:=ec; font_glue[f]:=null;
+adjust(char_base); adjust(width_base); adjust(lig_kern_base);
+adjust(kern_base); adjust(exten_base);
+decr(param_base[f]);
+fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f;
+font_mapping[f]:=load_tfm_font_mapping;
+goto done
+
+@ 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 then f:=cur_font
+else if cur_cmd=set_font then f:=cur_chr
+else if cur_cmd=def_family then
+ begin m:=cur_chr; scan_math_fam_int; f:=equiv(m+cur_val);
+ 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 find_font_dimen(@!writing:boolean);
+ {sets |cur_val| to |font_info| location}
+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 cur_val:=fmem_ptr
+else begin if writing and(n<=space_shrink_code)and@|
+ (n>=space_code)and(font_glue[f]<>null) then
+ begin delete_glue_ref(font_glue[f]);
+ font_glue[f]:=null;
+ end;
+ if n>font_params[f] then
+ if f<font_ptr then cur_val:=fmem_ptr
+ else @<Increase the number of parameters in the last font@>
+ else cur_val:=n+param_base[f];
+ end;
+@<Issue an error message if |cur_val=fmem_ptr|@>;
+end;
+
+@ @<Issue an error message if |cur_val=fmem_ptr|@>=
+if cur_val=fmem_ptr then
+ 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;
+ end
+
+@ @<Increase the number of parameters...@>=
+begin repeat if fmem_ptr=font_mem_size then
+ overflow("font memory",font_mem_size);
+@:TeX capacity exceeded font memory}{\quad font memory@>
+font_info[fmem_ptr].sc:=0; incr(fmem_ptr); incr(font_params[f]);
+until n=font_params[f];
+cur_val:=fmem_ptr-1; {this equals |param_base[f]+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.
+
+@<Declare subroutines for |new_character|@>=
+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 eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1;
+ begin begin_diagnostic;
+ print_nl("Missing character: There is no ");
+@.Missing character@>
+ if c < @"10000 then print_ASCII(c)
+ else print_char(c); {non-Plane 0 Unicodes can't be sent through |print_ASCII|}
+ print(" in font ");
+ slow_print(font_name[f]); print_char("!"); end_diagnostic(false);
+ end;
+ tracing_online:=old_setting;
+ end;
+end;
+
+@ We need a few subroutines for |new_character|.
+
+@p @t\4@>@<Declare subroutines for |new_character|@>@;
+
+@ Here is a function that returns a pointer to a character node for a
+given character in a given font. If that character doesn't exist,
+|null| is returned instead.
+
+@p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer;
+label exit;
+var p:pointer; {newly allocated node}
+begin if font_bc[f]<=c then if font_ec[f]>=c then
+ if char_exists(char_info(f)(qi(c))) then
+ begin p:=get_avail; font(p):=f; character(p):=qi(c);
+ new_character:=p; return;
+ end;
+char_warning(f,c);
+new_character:=null;
+exit: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.
+
+\XeTeX\ extends the format of \.{DVI} with its own commands, and thus produced
+``extended device independent'' (\.{XDV}) files.
+
+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 \.{XDV} 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 in normal \.{DVI} files, but
+the following commands are used in \.{XDV} files.
+
+\yskip\hang\vbox{\halign{#&#\hfil\cr
+|define_native_font| 252 & |k[4]| |s[4]| |flags[2]| |l[1]| |n[l]| |i[4]|\cr
+& |if (flags and COLORED) then| |rgba[4]|\cr
+& |if (flags and EXTEND) then| |extend[4]|\cr
+& |if (flags and SLANT) then| |slant[4]|\cr
+& |if (flags and EMBOLDEN) then| |embolden[4]|\cr
+}}
+
+\yskip\hang|set_glyphs| 253 |w[4]| |k[2]| |xy[8k]| |g[2k]|.
+
+\yskip\hang|set_text_and_glyphs| 254 |l[2]| |t[2l]| |w[4]| |k[2]| |xy[8k]| |g[2k]|.
+
+\yskip\noindent Commands 250 and 255 are undefined in normal \.{XDV} files.
+
+@ @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 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 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 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}
+
+@d define_native_font=252 {define native font}
+@d set_glyphs=253 {sequence of glyphs with individual x-y coordinates}
+@d set_text_and_glyphs=254 {run of Unicode (UTF16) text followed by positioned glyphs}
+
+@ 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; in \XeTeX\ this byte is set to~7, as we
+have new \.{DVI} opcodes, while in \TeX82 it is always set to~2. (The value
+|i=3| is used for an extended format that allows a mixture of right-to-left and
+left-to-right typesetting. Older versions of \XeTeX\ used |i=4|, |i=5| and |i=6|.)
+
+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=7 {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:quarterword; {character and font in current |char_node|}
+@!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 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;
+
+procedure dvi_two(s: UTF16_code);
+begin
+ dvi_out(s div @'400);
+ dvi_out(s 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. Since \TeX82 uses at
+most 256 different fonts per job, |fnt_def1| is always used as the command code.
+
+@p procedure dvi_native_font_def(@!f:internal_font_number);
+var
+ font_def_length, i: integer;
+begin
+ dvi_out(define_native_font);
+ dvi_four(f-font_base-1);
+ font_def_length:=make_font_def(f);
+ for i:=0 to font_def_length - 1 do dvi_out(xdv_buffer[i]);
+end;
+
+procedure dvi_font_def(@!f:internal_font_number);
+var k:pool_pointer; {index into |str_pool|}
+l:integer; {length of name without mapping option}
+begin if is_native_font(f) then dvi_native_font_def(f) else
+begin dvi_out(fnt_def1);
+dvi_out(f-font_base-1);@/
+dvi_out(qo(font_check[f].b0));
+dvi_out(qo(font_check[f].b1));
+dvi_out(qo(font_check[f].b2));
+dvi_out(qo(font_check[f].b3));@/
+dvi_four(font_size[f]);
+dvi_four(font_dsize[f]);@/
+dvi_out(length(font_area[f]));
+@<Output the font name whose internal number is |f|@>;
+end;
+
+@ @<Output the font name whose internal number is |f|@>=
+l:=0; k:=str_start_macro(font_name[f]);
+{search for colon; we will truncate the name there}
+while (l=0) and (k<str_start_macro(font_name[f]+1)) do begin
+ if so(str_pool[k]) = ":" then l:=k-str_start_macro(font_name[f]);
+ incr(k);
+end;
+if l=0 then l:=length(font_name[f]); {no colon found}
+dvi_out(l);
+for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do
+ dvi_out(so(str_pool[k]));
+for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f])+l-1 do
+ dvi_out(so(str_pool[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 |link| field points to the next item below this one
+on the stack; and the |info| field encodes the options for possible change
+in the \.{DVI} command.
+
+@d movement_node_size=3 {number of words per entry in the down and right stacks}
+@d location(#)==mem[#+2].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|.
+
+@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 q:=get_node(movement_node_size); {new node for the top of the stack}
+width(q):=w; location(q):=dvi_offset+dvi_ptr;
+if o=down1 then
+ begin link(q):=down_ptr; down_ptr:=q;
+ end
+else begin link(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''@>;
+@<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 |info| 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 {|info| when the movement entry points to a |y| command}
+@d z_here=2 {|info| when the movement entry points to a |z| command}
+@d yz_OK=3 {|info| corresponding to an unconstrained \\{down} command}
+@d y_OK=4 {|info| corresponding to a \\{down} that can't become a |z|}
+@d z_OK=5 {|info| corresponding to a \\{down} that can't become a |y|}
+@d d_fixed=6 {|info| corresponding to a \\{down} that can't change}
+
+@ When the |movement| procedure gets to the label |found|, the value of
+|info(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 |info| fields between |q| and |p| so that |y| is not OK in that range.
+
+@<Generate a |y0| or |z0| command...@>=
+info(q):=info(p);
+if info(q)=y_here then
+ begin dvi_out(o+y0-down1); {|y0| or |w0|}
+ while link(q)<>p do
+ begin q:=link(q);
+ case info(q) of
+ yz_OK: info(q):=z_OK;
+ y_OK: info(q):=d_fixed;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+else begin dvi_out(o+z0-down1); {|z0| or |x0|}
+ while link(q)<>p do
+ begin q:=link(q);
+ case info(q) of
+ yz_OK: info(q):=y_OK;
+ z_OK: info(q):=d_fixed;
+ othercases do_nothing
+ endcases;
+ end;
+ end
+
+@ @<Generate a |down| or |right|...@>=
+info(q):=yz_OK;
+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:=link(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+info(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:=link(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+info(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;
+info(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;
+info(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 |info|'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:=link(p); free_node(p,movement_node_size);
+ end;
+done: while right_ptr<>null do
+ begin if location(right_ptr)<l then return;
+ p:=right_ptr; right_ptr:=link(p); free_node(p,movement_node_size);
+ 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.
+
+For mixed direction text (\TeXXeT) the current text direction is called
+|cur_dir|. As the box being shipped out will never be used again and
+soon be recycled, we can simply reverse any R-text (i.e., right-to-left)
+segments of hlist nodes as well as complete hlist nodes embedded in such
+segments. Moreover this can be done iteratively rather than recursively.
+There are, however, two complications related to leaders that require
+some additional bookkeeping: (1)~One and the same hlist node might be
+used more than once (but never inside both L- and R-text); and
+(2)~leader boxes inside hlists must be aligned with respect to the left
+edge of the original hlist.
+
+A math node is changed into a kern node whenever the text direction
+remains the same, it is replaced by an |edge_node| if the text direction
+changes; the subtype of an an |hlist_node| inside R-text is changed to
+|reversed| once its hlist has been reversed.
+@!@^data structure assumptions@>
+
+@d reversed=1 {subtype for an |hlist_node| whose hlist has been reversed}
+@d dlist=2 {subtype for an |hlist_node| from display math mode}
+@d box_lr(#) == (qo(subtype(#))) {direction mode of a box}
+@d set_box_lr(#) == subtype(#):=set_box_lr_end
+@d set_box_lr_end(#) == qi(#)
+@#
+@d left_to_right=0
+@d right_to_left=1
+@d reflected==1-cur_dir {the opposite of |cur_dir|}
+@#
+@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$}
+
+@ @<Initialize variables as |ship_out| begins@>=
+dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font;
+@<Calculate 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(" XeTeX 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|}
+
+@d check_next=1236
+@d end_node_run=1237
+
+@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
+procedure hlist_out; {output an |hlist_node| box}
+label reswitch, move_past, fin_rule, next_p;
+var base_line: scaled; {the baseline coordinate for this box}
+@!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: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}
+@!prev_p:pointer; {one step behind |p|}
+@!len: integer; {length of scratch string for native word output}
+@!q,@!r: pointer;
+@!k,@!j: integer;
+@!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);
+if XeTeX_interword_space_shaping_state > 1 then begin
+ @<Merge sequences of words using native fonts and inter-word spaces into single nodes@>;
+end;
+p:=list_ptr(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; base_line:=cur_v;
+prev_p:=this_box+list_offset;
+@<Initialize |hlist_out| for mixed direction typesetting@>;
+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|@>;
+@<Finish |hlist_out| for mixed direction typesetting@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+end;
+
+@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces.
+
+@d is_native_word_node(#) == (((#)<>null)
+ and (not is_char_node(#))
+ and (type(#) = whatsit_node)
+ and (is_native_word_subtype(#)))
+@d is_glyph_node(#) == (((#)<>null and (not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = glyph_node)))
+
+@d node_is_invisible_to_interword_space(#)==
+ not is_char_node(#) and
+ ((type(#) = penalty_node) or
+ (type(#) = ins_node) or
+ (type(#) = mark_node) or
+ (type(#) = adjust_node) or
+ ((type(#) = whatsit_node) and (subtype(#) <= 4)))
+ { This checks for |subtype|s in the range open/write/close/special/language,
+ but the definitions haven't appeared yet in the .web file so we cheat. }
+
+@<Merge sequences of words using native fonts and inter-word spaces into single nodes@>=
+p:=list_ptr(this_box);
+prev_p:=this_box+list_offset;
+while p<>null do begin
+ if link(p) <> null then begin {not worth looking ahead at the end}
+ if is_native_word_node(p) and (font_letter_space[native_font(p)] = 0) then begin
+ {got a word in an AAT font, might be the start of a run}
+ r:=p; {|r| is start of possible run}
+ k:=native_length(r);
+ q:=link(p);
+check_next:
+ @<Advance |q| past ignorable nodes@>;
+ if (q <> null) and not is_char_node(q) then begin
+ if (type(q) = glue_node) and (subtype(q) = normal) then begin
+ if (glue_ptr(q) = font_glue[native_font(r)]) then begin
+ {found a normal space; if the next node is another word in the same font, we'll merge}
+ q:=link(q);
+ @<Advance |q| past ignorable nodes@>;
+ if is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
+ p:=q; {record new tail of run in |p|}
+ k:=k + 1 + native_length(q);
+ q:=link(q);
+ goto check_next;
+ end
+ end else q:=link(q);
+ {we'll also merge if if space-adjustment was applied at this glue,
+ even if it wasn't the font's standard inter-word space}
+ if (q <> null) and not is_char_node(q) and (type(q) = kern_node) and
+ (subtype(q) = space_adjustment) then begin
+ q:=link(q);
+ @<Advance |q| past ignorable nodes@>;
+ if is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
+ p:=q; {record new tail of run in |p|}
+ k:=k + 1 + native_length(q);
+ q:=link(q);
+ goto check_next;
+ end
+ end;
+ goto end_node_run;
+ end;
+ if is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
+ p:=q; {record new tail of run in |p|}
+ q:=link(q);
+ goto check_next;
+ end
+ end;
+end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last}
+ if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|}
+ str_room(k);
+ k:=0; {now we'll use this as accumulator for total width}
+ q:=r;
+ loop begin
+ if type(q) = whatsit_node then begin
+ if (is_native_word_subtype(q)) then begin
+ for j:=0 to native_length(q)-1 do
+ append_char(get_native_char(q, j));
+ k:=k + width(q);
+ end
+ end else if type(q) = glue_node then begin
+ append_char(" ");
+ g:=glue_ptr(q);
+ k:=k + width(g);
+ if g_sign <> normal then begin
+ if g_sign = stretching then begin
+ if stretch_order(g) = g_order then begin
+ k:=k + round(float(glue_set(this_box)) * stretch(g))
+ end
+ end else begin
+ if shrink_order(g) = g_order then begin
+ k:=k - round(float(glue_set(this_box)) * shrink(g))
+ end
+ end
+ end
+ end else if type(q) = kern_node then begin
+ k:=k + width(q);
+ end;
+ {discretionary and deleted nodes can be discarded here}
+ if q = p then break
+ else q:=link(q);
+ end;
+ { create the new merged node |q| }
+ q:=new_native_word_node(native_font(r), cur_length);
+ subtype(q):=subtype(r);
+ for j:=0 to cur_length - 1 do
+ set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]);
+ { impose the required width on |q|, and shape its text accordingly }
+ width(q):=k;
+ set_justified_native_glyphs(q);
+ { link |q| into the list in place of |r|..|p| }
+ link(prev_p):=q;
+ link(q):=link(p);
+ link(p):=null;
+ { Extract any "invisible" nodes from the old list and insert them after the new node,
+ so we don't lose them altogether. Note that the first node cannot be one of these,
+ as we always start merging at a |native_word| node. }
+ prev_p := r;
+ p := link(r);
+ while p <> null do begin
+ if node_is_invisible_to_interword_space(p) then begin
+ link(prev_p) := link(p);
+ link(p) := link(q);
+ link(q) := p;
+ q := p;
+ end;
+ prev_p := p;
+ p := link(p);
+ end;
+ { discard the remains of the old list }
+ flush_node_list(r);
+ { clean up and prepare for the next round }
+ pool_ptr:=str_start_macro(str_ptr); {flush the temporary string data}
+ p:=q;
+ end
+ end;
+ prev_p:=p;
+ end;
+ p:=link(p);
+end
+
+@ @<Advance |q| past ignorable nodes@>=
+while (q <> null) and node_is_invisible_to_interword_space(q) do
+ q:=link(q)
+
+@ 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|...@>=
+reswitch: if is_char_node(p) then
+ begin synch_h; synch_v;
+ repeat f:=font(p); c:=character(p);
+ if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ if c>=qi(128) then dvi_out(set1);
+ dvi_out(qo(c));@/
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ prev_p:=link(prev_p); {N.B.: not |prev_p:=p|, |p| might be |lig_trick|}
+ p:=link(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); font_used[f]:=true;
+ end;
+if f<=64+font_base then dvi_out(f-font_base-1+fnt_num_0)
+else begin dvi_out(fnt1); dvi_out(f-font_base-1);
+ end;
+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 rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in an hlist@>;
+glue_node: @<Move right or output leaders@>;
+margin_kern_node: begin
+ cur_h:=cur_h+width(p);
+end;
+kern_node:cur_h:=cur_h+width(p);
+math_node: @<Handle a math node in |hlist_out|@>;
+ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
+@/@<Cases of |hlist_out| that arise in mixed direction text only@>@;
+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:prev_p:=p; p:=link(p);
+end
+
+@ @<Output a box in an hlist@>=
+if list_ptr(p)=null then cur_h:=cur_h+width(p)
+else begin save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line+shift_amount(p); {shift the box down}
+ temp_ptr:=p; edge:=cur_h+width(p);
+ if cur_dir=right_to_left then cur_h:=edge;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge; cur_v:=base_line;
+ 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;
+ dvi_out(set_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ 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
+@#
+@d round_glue==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
+
+@<Move right or output leaders@>=
+begin round_glue;
+if eTeX_ex then @<Handle a glue node for mixed direction typesetting@>;
+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;
+leader_wd:=width(leader_box);
+if (leader_wd>0)and(rule_wd>0) then
+ begin rule_wd:=rule_wd+10; {compensate for floating-point rounding}
+ if cur_dir=right_to_left then cur_h:=cur_h-10;
+ 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|@>;
+ if cur_dir=right_to_left then cur_h:=edge
+ else 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 cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/
+synch_h; save_h:=dvi_h; temp_ptr:=leader_box;
+if cur_dir=right_to_left then cur_h:=cur_h+leader_wd;
+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_v:=save_v; dvi_h:=save_h; cur_v:=base_line;
+cur_h:=save_h+leader_wd+lx;
+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}
+@!upwards:boolean; {whether we're stacking upwards}
+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);
+upwards:=(subtype(this_box)=min_quarterword+1);
+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;
+if upwards then cur_v:=cur_v+depth(this_box) else 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|@>;
+prune_movements(save_loc);
+if cur_s>0 then dvi_pop(save_loc);
+decr(cur_s);
+end;
+
+@ @<Output node |p| for |vlist_out|...@>=
+begin if is_char_node(p) then confusion("vlistout")
+@:this can't happen vlistout}{\quad vlistout@>
+else @<Output the non-|char_node| |p| for |vlist_out|@>;
+next_p:p:=link(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 rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
+ goto fin_rule;
+ end;
+whatsit_node: @<Output the whatsit node |p| in a vlist@>;
+glue_node: @<Move down or output leaders@>;
+kern_node:if upwards then cur_v:=cur_v-width(p) else 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: if upwards then cur_v:=cur_v-rule_ht else 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@>=
+if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
+else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); synch_v;
+ save_h:=dvi_h; save_v:=dvi_v;
+ if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p)
+ else cur_h:=left_edge+shift_amount(p); {shift the box right}
+ temp_ptr:=p;
+ if type(p)=vlist_node then vlist_out@+else hlist_out;
+ dvi_h:=save_h; dvi_v:=save_v;
+ if upwards then cur_v:=save_v-height(p) else cur_v:=save_v+depth(p); cur_h:=left_edge;
+ 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}
+if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht;
+if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
+ begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
+ synch_h; synch_v;
+ dvi_out(put_rule); dvi_four(rule_ht); dvi_four(rule_wd);
+ cur_h:=left_edge;
+ 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;
+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
+ @<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 cur_dir=right_to_left then
+ cur_h:=left_edge-shift_amount(leader_box)
+ else cur_h:=left_edge+shift_amount(leader_box);
+synch_h; save_h:=dvi_h;@/
+cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v;
+temp_ptr:=leader_box;
+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_v:=save_v; dvi_h:=save_h; cur_h:=left_edge;
+cur_v:=save_v-height(leader_box)+leader_ht+lx;
+end
+
+@ The |hlist_out| and |vlist_out| procedures are now complete, so we are
+ready for the |ship_out| routine that gets them started in the first place.
+
+@p procedure 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}
+begin
+if job_name=0 then open_log_file;
+if tracing_output>0 then
+ begin print_nl(""); print_ln;
+ print("Completed box being shipped out");
+@.Completed box...@>
+ end;
+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;
+update_terminal;
+if tracing_output>0 then
+ begin print_char("]");
+ begin_diagnostic; show_box(p); end_diagnostic(true);
+ end;
+@<Ship box |p| out@>;
+if eTeX_ex then @<Check for LR anomalies at the end of |ship_out|@>;
+if tracing_output<=0 then print_char("]");
+dead_cycles:=0;
+update_terminal; {progress report}
+@<Flush the box from memory, showing statistics if requested@>;
+end;
+
+@ @<Flush the box from memory, showing statistics if requested@>=
+@!stat if tracing_stats>1 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 then
+ begin print(" after: ");
+ print_int(var_used); print_char("&");
+ print_int(dyn_used); print("; still untouched: ");
+ print_int(hi_mem_min-lo_mem_max-1); 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;
+{ generate a pagesize special at start of page }
+old_setting:=selector; selector:=new_string;
+print("pdf:pagesize ");
+if (pdf_page_width > 0) and (pdf_page_height > 0) then begin
+ print("width"); print(" ");
+ print_scaled(pdf_page_width);
+ print("pt"); print(" ");
+ print("height"); print(" ");
+ print_scaled(pdf_page_height);
+ print("pt");
+end else
+ print("default");
+selector:=old_setting;
+dvi_out(xxx1); 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); {erase the string}
+cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? }
+temp_ptr:=p;
+if type(p)=vlist_node then vlist_out@+else hlist_out;
+dvi_out(eop); incr(total_pages); cur_s:=-1;
+if not no_pdf_output then fflush(dvi_file);
+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. And if
+|max_push>=65536|, the user deserves whatever chaos might ensue.
+
+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 print_nl("No pages of output.")
+@.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|@>;
+ 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).");
+ b_close(dvi_file);
+ end
+
+@ @<Output the font definitions...@>=
+while font_ptr>font_base do
+ begin if font_used[font_ptr] then dvi_font_def(font_ptr);
+ decr(font_ptr);
+ end
+
+@* \[32b] \pdfTeX\ output low-level subroutines (equivalents).
+
+@<Glob...@>=
+@!epochseconds: integer;
+@!microseconds: integer;
+
+@* \[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|}
+
+@ 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;
+var @!s:integer; {temporarily saved value}
+@!spec_code:exactly..additional;
+begin if three_codes then s:=saved(0);
+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; incr(save_ptr);
+ end;
+saved(0):=spec_code; saved(1):=cur_val; save_ptr:=save_ptr+2;
+new_save_level(c); scan_left_brace;
+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;
+
+@ Some stuff for character protrusion.
+
+@d left_pw(#) == char_pw(#, left_side)
+@d right_pw(#) == char_pw(#, right_side)
+
+@p
+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;
+
+ { native word }
+ if is_native_word_node(p) then begin
+ if native_glyph_info_ptr(p) <> null_ptr then begin
+ f:=native_font(p);
+ char_pw:=round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000);
+ end;
+ return;
+ end;
+
+ { glyph node }
+ if is_glyph_node(p) then begin
+ f:=native_font(p);
+ char_pw:=round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000);
+ return;
+ end;
+
+ { char node or ligature; same like pdftex }
+ if not is_char_node(p) then begin
+ if type(p) = ligature_node then
+ p:=lig_char(p)
+ else
+ return;
+ end;
+ f:=font(p);
+ c:=get_cp_code(f, character(p), side);
+ case side of
+ left_side:
+ last_leftmost_char:=p;
+ right_side:
+ last_rightmost_char:=p;
+ endcases;
+ 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: pointer;
+begin
+ k:=get_node(margin_kern_node_size);
+ type(k):=margin_kern_node;
+ subtype(k):=side;
+ width(k):=w;
+ new_margin_kern:=k;
+end;
+
+@ Here now is |hpack|, which contains few if any surprises.
+
+@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
+label reswitch, common_ending, exit, restart;
+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|}
+@!i:four_quarters; {font information about a |char_node|}
+@!hd:eight_bits; {height and depth indices for a character}
+@!pp,@!ppp: pointer;
+@!total_chars, @!k: integer;
+begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
+subtype(r):=min_quarterword; shift_amount(r):=0;
+q:=r+list_offset; link(q):=p;@/
+h:=0; @<Clear dimensions to zero@>;
+if TeXXeT_en then @<Initialize the LR stack@>;
+while p<>null do @<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@>;
+if adjust_tail<>null then link(adjust_tail):=null;
+if pre_adjust_tail<>null then link(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 TeXXeT_en then @<Check for LR anomalies at the end of |hpack|@>;
+hpack:=r;
+end;
+
+@ @<Clear dimensions to zero@>=
+d:=0; x:=0;
+total_stretch[normal]:=0; total_shrink[normal]:=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 reswitch: 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: if (adjust_tail<>null) or (pre_adjust_tail<> null) then
+ @<Transfer node |p| to the adjustment list@>;
+ whatsit_node:@<Incorporate a whatsit node into an hbox@>;
+ glue_node:@<Incorporate glue into the horizontal totals@>;
+ kern_node: x:=x+width(p);
+ margin_kern_node: x:=x+width(p);
+ math_node: begin x:=x+width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
+ end;
+ ligature_node: @<Make node |p| look like a |char_node|
+ and |goto reswitch|@>;
+ othercases do_nothing
+ endcases;@/
+ p:=link(p);
+ end;
+end
+
+
+@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
+begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p);
+p:=lig_trick; xtx_ligature_present:=true; goto reswitch;
+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 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
+
+@ 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@>
+
+@<Incorporate character dimensions into the dimensions of the hbox...@>=
+begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i);
+x:=x+char_width(f)(i);@/
+s:=char_height(f)(hd);@+if s>h then h:=s;
+s:=char_depth(f)(hd);@+if s>d then d:=s;
+p:=link(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
+ if # = null then
+ confusion("pre vadjust");
+ link(#):=adjust_ptr(p);
+ while link(#) <> null do
+ #:=link(#);
+end
+
+@<Transfer node |p| to the adjustment list@>=
+begin while link(q)<>p do q:=link(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:=link(p); free_node(link(q), small_node_size);
+ end
+else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
+ end;
+link(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|}@>
+
+@ @<Determine horizontal 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 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 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@>;
+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 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 link(q)<>null do q:=link(q);
+ link(q):=new_rule;
+ width(link(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; r:=get_node(box_node_size); type(r):=vlist_node;
+if XeTeX_upwards then subtype(r):=min_quarterword+1 else 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;
+
+@ @<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:=link(p);
+end
+
+@ @<Incorporate box dimensions into the dimensions of the vbox...@>=
+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
+
+@ @<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 node}
+@!upwards:boolean;
+begin upwards:=XeTeX_upwards;
+ if prev_depth>ignore_depth then
+ begin if upwards 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;
+ link(tail):=p; tail:=p;
+ end;
+link(tail):=b; tail:=b; if upwards 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, ligature 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 four or more words long. The first word contains the |type|
+and |subtype| and |link| fields that are already so familiar to us; the
+second, third, and fourth words are called the noad's |nucleus|, |subscr|,
+and |supscr| fields.
+
+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 |info(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 |info(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 |info(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 evidently wasteful of space,
+since a halfword 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.
+
+@d noad_size=4 {number of words in a normal noad}
+@d nucleus(#)==#+1 {the |nucleus| field of a noad}
+@d supscr(#)==#+2 {the |supscr| field of a noad}
+@d subscr(#)==#+3 {the |subscr| field of a noad}
+@d math_type==link {a |halfword| in |mem|}
+@d plane_and_fam_field==font {a |quarterword| in |mem|}
+@d fam(#) == (plane_and_fam_field(#) mod @"100)
+@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, Open,
+Close, Punct, or Inner, 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 Open}
+@d close_noad=ord_noad+5 {|type| of a noad classified Close}
+@d punct_noad=ord_noad+6 {|type| of a noad classified Punct}
+@d inner_noad=ord_noad+7 {|type| of a noad classified Inner}
+@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(#)==#+4 {first delimiter field of a noad}
+@d right_delimiter(#)==#+5 {second delimiter field of a fraction noad}
+@d radical_noad=inner_noad+1 {|type| of a noad for square roots}
+@d radical_noad_size=5 {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=6 {number of |mem| words in a fraction noad}
+@d small_fam(#)==(mem[#].qqqq.b0 mod @"100) {|fam| for ``small'' delimiter}
+@d small_char(#)==(mem[#].qqqq.b1 + (mem[#].qqqq.b0 div @"100) * @"10000) {|character| for ``small'' delimiter}
+@d large_fam(#)==(mem[#].qqqq.b2 mod @"100) {|fam| for ``large'' delimiter}
+@d large_char(#)==(mem[#].qqqq.b3 + (mem[#].qqqq.b2 div @"100) * @"10000) {|character| for ``large'' delimiter}
+@d small_plane_and_fam_field(#)==mem[#].qqqq.b0
+@d small_char_field(#)==mem[#].qqqq.b1
+@d large_plane_and_fam_field(#)==mem[#].qqqq.b2
+@d large_char_field(#)==mem[#].qqqq.b3
+@d thickness==width {|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:=get_node(noad_size);
+type(p):=ord_noad; subtype(p):=normal;
+mem[nucleus(p)].hh:=empty_field;
+mem[subscr(p)].hh:=empty_field;
+mem[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 |character(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 fixed_acc=1 {|subtype| for non growing math accents}
+@d bottom_acc=2 {|subtype| for bottom math accents}
+@d is_bottom_acc(#)==((subtype(#)=bottom_acc) or (subtype(#)=bottom_acc+fixed_acc))
+@d accent_noad_size=5 {number of |mem| words in an accent noad}
+@d accent_chr(#)==#+4 {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=3 {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:=get_node(style_node_size); type(p):=style_node;
+subtype(p):=s; width(p):=0; depth(p):=0; {the |width| and |depth| are not used}
+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(#)==info(#+1) {mlist to be used in display style}
+@d text_mlist(#)==link(#+1) {mlist to be used in text style}
+@d script_mlist(#)==info(#+2) {mlist to be used in script style}
+@d script_script_mlist(#)==link(#+2) {mlist to be used in scriptscript style}
+
+@p function new_choice:pointer; {create a choice node}
+var p:pointer; {the new node}
+begin p:=get_node(style_node_size); type(p):=choice_node;
+subtype(p):=0; {the |subtype| is not used}
+display_mlist(p):=null; text_mlist(p):=null; script_mlist(p):=null;
+script_script_mlist(p):=null;
+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}
+var c:integer;
+begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" ");
+c:=(cast_to_ushort(character(p)) + ((plane_and_fam_field(p) div @"100) * @"10000));
+if c < @"10000 then print_ASCII(c)
+else print_char(c); {non-Plane 0 Unicodes can't be sent through |print_ASCII|}
+end;
+@#
+procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value}
+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(info(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 info(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(info(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 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(delimiter(p));
+ end;
+right_noad: begin if subtype(p)=normal then print_esc("right")
+ else print_esc("middle");
+ print_delimiter(delimiter(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
+
+@ That which can be displayed can also be destroyed.
+
+@<Cases of |flush_node_list| that arise...@>=
+style_node: begin free_node(p,style_node_size); goto done;
+ end;
+choice_node:begin 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));
+ free_node(p,style_node_size); goto done;
+ end;
+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:@t@>@;@/
+ begin if math_type(nucleus(p))>=sub_box then
+ flush_node_list(info(nucleus(p)));
+ if math_type(supscr(p))>=sub_box then
+ flush_node_list(info(supscr(p)));
+ if math_type(subscr(p))>=sub_box then
+ flush_node_list(info(subscr(p)));
+ if type(p)=radical_noad then free_node(p,radical_noad_size)
+ else if type(p)=accent_noad then free_node(p,accent_noad_size)
+ else free_node(p,noad_size);
+ goto done;
+ end;
+left_noad,right_noad: begin free_node(p,noad_size); goto done;
+ end;
+fraction_noad: begin flush_node_list(info(numerator(p)));
+ flush_node_list(info(denominator(p)));
+ free_node(p,fraction_noad_size); goto done;
+ 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=text_size 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@>
+
+NB: the access functions here must all put the font \# into /f/ for mathsy().
+
+The accessors are defined with
+|define_mathsy_accessor(NAME)(fontdimen-number)(NAME)|
+because I can't see how to only give the name once, with WEB's limited
+macro capabilities. This seems a bit ugly, but it works.
+
+@d total_mathsy_params=22
+
+{the following are OpenType MATH constant indices for use with OT math fonts}
+@d scriptPercentScaleDown = 0
+@d scriptScriptPercentScaleDown = 1
+@d delimitedSubFormulaMinHeight = 2
+@d displayOperatorMinHeight = 3
+@d mathLeading = 4
+@d firstMathValueRecord = mathLeading
+@d axisHeight = 5
+@d accentBaseHeight = 6
+@d flattenedAccentBaseHeight = 7
+@d subscriptShiftDown = 8
+@d subscriptTopMax = 9
+@d subscriptBaselineDropMin = 10
+@d superscriptShiftUp = 11
+@d superscriptShiftUpCramped = 12
+@d superscriptBottomMin = 13
+@d superscriptBaselineDropMax = 14
+@d subSuperscriptGapMin = 15
+@d superscriptBottomMaxWithSubscript = 16
+@d spaceAfterScript = 17
+@d upperLimitGapMin = 18
+@d upperLimitBaselineRiseMin = 19
+@d lowerLimitGapMin = 20
+@d lowerLimitBaselineDropMin = 21
+@d stackTopShiftUp = 22
+@d stackTopDisplayStyleShiftUp = 23
+@d stackBottomShiftDown = 24
+@d stackBottomDisplayStyleShiftDown = 25
+@d stackGapMin = 26
+@d stackDisplayStyleGapMin = 27
+@d stretchStackTopShiftUp = 28
+@d stretchStackBottomShiftDown = 29
+@d stretchStackGapAboveMin = 30
+@d stretchStackGapBelowMin = 31
+@d fractionNumeratorShiftUp = 32
+@d fractionNumeratorDisplayStyleShiftUp = 33
+@d fractionDenominatorShiftDown = 34
+@d fractionDenominatorDisplayStyleShiftDown = 35
+@d fractionNumeratorGapMin = 36
+@d fractionNumDisplayStyleGapMin = 37
+@d fractionRuleThickness = 38
+@d fractionDenominatorGapMin = 39
+@d fractionDenomDisplayStyleGapMin = 40
+@d skewedFractionHorizontalGap = 41
+@d skewedFractionVerticalGap = 42
+@d overbarVerticalGap = 43
+@d overbarRuleThickness = 44
+@d overbarExtraAscender = 45
+@d underbarVerticalGap = 46
+@d underbarRuleThickness = 47
+@d underbarExtraDescender = 48
+@d radicalVerticalGap = 49
+@d radicalDisplayStyleVerticalGap = 50
+@d radicalRuleThickness = 51
+@d radicalExtraAscender = 52
+@d radicalKernBeforeDegree = 53
+@d radicalKernAfterDegree = 54
+@d lastMathValueRecord = radicalKernAfterDegree
+@d radicalDegreeBottomRaisePercent = 55
+@d lastMathConstant = radicalDegreeBottomRaisePercent
+
+
+@d mathsy(#)==font_info[#+param_base[f]].sc
+
+@d define_mathsy_end(#)==
+ #:=rval;
+ end
+@d define_mathsy_body(#)==
+ var
+ f: integer;
+ rval: scaled;
+ begin
+ f:=fam_fnt(2 + size_code);
+ if is_new_mathfont(f) then
+ rval:=get_native_mathsy_param(f, #)
+ else
+ rval:=mathsy(#);
+ define_mathsy_end
+@d define_mathsy_accessor(#)==function #(size_code: integer): scaled; define_mathsy_body
+
+@p define_mathsy_accessor(math_x_height)(5)(math_x_height);
+define_mathsy_accessor(math_quad)(6)(math_quad);
+define_mathsy_accessor(num1)(8)(num1);
+define_mathsy_accessor(num2)(9)(num2);
+define_mathsy_accessor(num3)(10)(num3);
+define_mathsy_accessor(denom1)(11)(denom1);
+define_mathsy_accessor(denom2)(12)(denom2);
+define_mathsy_accessor(sup1)(13)(sup1);
+define_mathsy_accessor(sup2)(14)(sup2);
+define_mathsy_accessor(sup3)(15)(sup3);
+define_mathsy_accessor(sub1)(16)(sub1);
+define_mathsy_accessor(sub2)(17)(sub2);
+define_mathsy_accessor(sup_drop)(18)(sup_drop);
+define_mathsy_accessor(sub_drop)(19)(sub_drop);
+define_mathsy_accessor(delim1)(20)(delim1);
+define_mathsy_accessor(delim2)(21)(delim2);
+define_mathsy_accessor(axis_height)(22)(axis_height);
+
+@ 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 total_mathex_params=13
+
+@d mathex(#)==font_info[#+param_base[f]].sc
+
+@d define_mathex_end(#)==
+ #:=rval;
+ end
+@d define_mathex_body(#)==
+ var
+ f: integer;
+ rval: scaled;
+ begin
+ f:=fam_fnt(3 + cur_size);
+ if is_new_mathfont(f) then
+ rval:=get_native_mathex_param(f, #)
+ else
+ rval:=mathex(#);
+ define_mathex_end
+@d define_mathex_accessor(#)==function #:scaled; define_mathex_body
+
+@p define_mathex_accessor(default_rule_thickness)(8)(default_rule_thickness);
+define_mathex_accessor(big_op_spacing1)(9)(big_op_spacing1);
+define_mathex_accessor(big_op_spacing2)(10)(big_op_spacing2);
+define_mathex_accessor(big_op_spacing3)(11)(big_op_spacing3);
+define_mathex_accessor(big_op_spacing4)(12)(big_op_spacing4);
+define_mathex_accessor(big_op_spacing5)(13)(big_op_spacing5);
+
+@ Native font support requires these additional subroutines.
+
+|new_native_word_node| creates the node, but does not actually set its metrics;
+call |set_native_metrics(node)| if that is required.
+
+@<Declare subroutines for |new_character|@>=
+function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer;
+var
+ l: integer;
+ q: pointer;
+begin
+ l:=native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word);
+
+ q:=get_node(l);
+ type(q):=whatsit_node;
+ if XeTeX_generate_actual_text_en then subtype(q):=native_word_node_AT
+ else subtype(q):=native_word_node;
+
+ native_size(q):=l;
+ native_font(q):=f;
+ native_length(q):=n;
+
+ native_glyph_count(q):=0;
+ native_glyph_info_ptr(q):=null_ptr;
+
+ new_native_word_node:=q;
+end;
+
+function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer;
+var
+ p: pointer;
+ i, len: integer;
+begin
+ if font_mapping[f] <> 0 then begin
+ if c > @"FFFF then begin
+ str_room(2);
+ append_char((c - @"10000) div 1024 + @"D800);
+ append_char((c - @"10000) mod 1024 + @"DC00);
+ end
+ else begin
+ str_room(1);
+ append_char(c);
+ end;
+ len:=apply_mapping(font_mapping[f], addressof(str_pool[str_start_macro(str_ptr)]), cur_length);
+ pool_ptr:=str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead }
+
+ i:=0;
+ while i < len do begin
+ if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin
+ c:=(mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000;
+ if map_char_to_glyph(f, c) = 0 then begin
+ char_warning(f, c);
+ end;
+ i:=i + 2;
+ end
+ else begin
+ if map_char_to_glyph(f, mapped_text[i]) = 0 then begin
+ char_warning(f, mapped_text[i]);
+ end;
+ i:=i + 1;
+ end;
+ end;
+
+ p:=new_native_word_node(f, len);
+ for i:=0 to len-1 do begin
+ set_native_char(p, i, mapped_text[i]);
+ end
+ end
+ else begin
+ if tracing_lost_chars > 0 then
+ if map_char_to_glyph(f, c) = 0 then begin
+ char_warning(f, c);
+ end;
+
+ p:=get_node(native_node_size + 1);
+ type(p):=whatsit_node;
+ subtype(p):=native_word_node;
+
+ native_size(p):=native_node_size + 1;
+ native_glyph_count(p):=0;
+ native_glyph_info_ptr(p):=null_ptr;
+ native_font(p):=f;
+
+ if c > @"FFFF then begin
+ native_length(p):=2;
+ set_native_char(p, 0, (c - @"10000) div 1024 + @"D800);
+ set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00);
+ end
+ else begin
+ native_length(p):=1;
+ set_native_char(p, 0, c);
+ end;
+ end;
+
+ set_native_metrics(p, XeTeX_use_glyph_metrics);
+
+ new_native_character:=p;
+end;
+
+procedure font_feature_warning(featureNameP:void_pointer; featLen:integer;
+ settingNameP:void_pointer; setLen:integer);
+var
+ i: integer;
+begin
+ begin_diagnostic;
+ print_nl("Unknown ");
+ if setLen > 0 then begin
+ print("selector `");
+ print_utf8_str(settingNameP, setLen);
+ print("' for ");
+ end;
+ print("feature `");
+ print_utf8_str(featureNameP, featLen);
+ print("' in font `");
+ i:=1;
+ while ord(name_of_file[i]) <> 0 do begin
+ print_visible_char(name_of_file[i]); { this is already UTF-8 }
+ incr(i);
+ end;
+ print("'.");
+ end_diagnostic(false);
+end;
+
+procedure font_mapping_warning(mappingNameP:void_pointer;
+ mappingNameLen:integer;
+ warningType:integer); { 0: just logging; 1: file not found; 2: can't load }
+var
+ i: integer;
+begin
+ begin_diagnostic;
+ if warningType=0 then print_nl("Loaded mapping `")
+ else print_nl("Font mapping `");
+ print_utf8_str(mappingNameP, mappingNameLen);
+ print("' for font `");
+ i:=1;
+ while ord(name_of_file[i]) <> 0 do begin
+ print_visible_char(name_of_file[i]); { this is already UTF-8 }
+ incr(i);
+ end;
+ case warningType of
+ 1: print("' not found.");
+ 2: begin print("' not usable;");
+ print_nl("bad mapping file or incorrect mapping type.");
+ end;
+ othercases print("'.")
+ endcases;
+ end_diagnostic(false);
+end;
+
+procedure graphite_warning;
+var
+ i: integer;
+begin
+ begin_diagnostic;
+ print_nl("Font `");
+ i:=1;
+ while ord(name_of_file[i]) <> 0 do begin
+ print_visible_char(name_of_file[i]); { this is already UTF-8 }
+ incr(i);
+ end;
+ print("' does not support Graphite. Trying OpenType layout instead.");
+ end_diagnostic(false);
+end;
+
+function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number;
+label
+ done;
+const
+ first_math_fontdimen = 10;
+var
+ k, num_font_dimens: integer;
+ font_engine: void_pointer; {really an CFDictionaryRef or XeTeXLayoutEngine}
+ actual_size: scaled; {|s| converted to real size, if it was negative}
+ p: pointer; {for temporary |native_char| node we'll create}
+ ascent, descent, font_slant, x_ht, cap_ht: scaled;
+ f: internal_font_number;
+ full_name: str_number;
+begin
+ { on entry here, the full name is packed into |name_of_file| in UTF8 form }
+
+ load_native_font:=null_font;
+
+ font_engine:=find_native_font(name_of_file + 1, s);
+ if font_engine = 0 then goto done;
+
+ if s>=0 then
+ actual_size:=s
+ else begin
+ if (s <> -1000) then
+ actual_size:=xn_over_d(loaded_font_design_size,-s,1000)
+ else
+ actual_size:=loaded_font_design_size;
+ end;
+
+ { look again to see if the font is already loaded, now that we know its canonical name }
+ str_room(name_length);
+ for k:=1 to name_length do
+ append_char(name_of_file[k]);
+ full_name:=make_string; { not |slow_make_string| because we'll flush it if the font was already loaded }
+
+ for f:=font_base+1 to font_ptr do
+ if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin
+ release_font_engine(font_engine, native_font_type_flag);
+ flush_string;
+ load_native_font:=f;
+ goto done;
+ end;
+
+ if (native_font_type_flag = otgr_font_flag) and isOpenTypeMathFont(font_engine) then
+ num_font_dimens:=first_math_fontdimen + lastMathConstant
+ else
+ num_font_dimens:=8;
+
+ if (font_ptr = font_max) or (fmem_ptr + num_font_dimens > font_mem_size) then begin
+ @<Apologize for not loading the font, |goto done|@>;
+ end;
+
+ { we've found a valid installed font, and have room }
+ incr(font_ptr);
+ font_area[font_ptr]:=native_font_type_flag; { set by |find_native_font| to either |aat_font_flag| or |ot_font_flag| }
+
+ { store the canonical name }
+ font_name[font_ptr]:=full_name;
+
+ font_check[font_ptr].b0:=0;
+ font_check[font_ptr].b1:=0;
+ font_check[font_ptr].b2:=0;
+ font_check[font_ptr].b3:=0;
+ font_glue[font_ptr]:=null;
+ font_dsize[font_ptr]:=loaded_font_design_size;
+ font_size[font_ptr]:=actual_size;
+
+ if (native_font_type_flag = aat_font_flag) then begin
+ aat_get_font_metrics(font_engine, addressof(ascent), addressof(descent),
+ addressof(x_ht), addressof(cap_ht), addressof(font_slant))
+ end else begin
+ ot_get_font_metrics(font_engine, addressof(ascent), addressof(descent),
+ addressof(x_ht), addressof(cap_ht), addressof(font_slant));
+ end;
+
+ height_base[font_ptr]:=ascent;
+ depth_base[font_ptr]:=-descent;
+
+ font_params[font_ptr]:=num_font_dimens; {we add an extra \.{\\fontdimen8} |:= cap_height|; then OT math fonts have a bunch more}
+ font_bc[font_ptr]:=0;
+ font_ec[font_ptr]:=65535;
+ font_used[font_ptr]:=false;
+ hyphen_char[font_ptr]:=default_hyphen_char;
+ skew_char[font_ptr]:=default_skew_char;
+ param_base[font_ptr]:=fmem_ptr-1;
+
+ font_layout_engine[font_ptr]:=font_engine;
+ font_mapping[font_ptr]:=0; {don't use the mapping, if any, when measuring space here}
+ font_letter_space[font_ptr]:=loaded_font_letter_space;
+
+@# {measure the width of the space character and set up font parameters}
+ p:=new_native_character(font_ptr, " ");
+ s:=width(p) + loaded_font_letter_space;
+ free_node(p, native_size(p));
+
+ font_info[fmem_ptr].sc:=font_slant; {|slant|}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=s; {|space| = width of space character}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=s div 2; {|space_stretch| = 1/2 * space}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=s div 3; {|space_shrink| = 1/3 * space}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=x_ht; {|x_height|}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=font_size[font_ptr]; {|quad| = font size}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=s div 3; {|extra_space| = 1/3 * space}
+ incr(fmem_ptr);
+ font_info[fmem_ptr].sc:=cap_ht; {|cap_height|}
+ incr(fmem_ptr);
+
+ if num_font_dimens = first_math_fontdimen + lastMathConstant then begin
+ font_info[fmem_ptr].int:=num_font_dimens; { \.{\\fontdimen9} |:=| number of assigned fontdimens }
+ incr(fmem_ptr);
+ for k:=0 to lastMathConstant do begin
+ font_info[fmem_ptr].sc:=get_ot_math_constant(font_ptr, k);
+ incr(fmem_ptr);
+ end;
+ end;
+
+ font_mapping[font_ptr]:=loaded_font_mapping;
+ font_flags[font_ptr]:=loaded_font_flags;
+
+ load_native_font:=font_ptr;
+done:
+end;
+
+procedure do_locale_linebreaks(s: integer; len: integer);
+var
+ offs, prevOffs, i: integer;
+ use_penalty, use_skip: boolean;
+begin
+ if (XeTeX_linebreak_locale = 0) or (len = 1) then begin
+ link(tail):=new_native_word_node(main_f, len);
+ tail:=link(tail);
+ for i:=0 to len - 1 do
+ set_native_char(tail, i, native_text[s + i]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+ end else begin
+ use_skip:=XeTeX_linebreak_skip <> zero_glue;
+ use_penalty:=XeTeX_linebreak_penalty <> 0 or not use_skip;
+ linebreak_start(main_f, XeTeX_linebreak_locale, native_text + s, len);
+ offs:=0;
+ repeat
+ prevOffs:=offs;
+ offs:=linebreak_next;
+ if offs > 0 then begin
+ if prevOffs <> 0 then begin
+ if use_penalty then
+ tail_append(new_penalty(XeTeX_linebreak_penalty));
+ if use_skip then
+ tail_append(new_param_glue(XeTeX_linebreak_skip_code));
+ end;
+ link(tail):=new_native_word_node(main_f, offs - prevOffs);
+ tail:=link(tail);
+ for i:=prevOffs to offs - 1 do
+ set_native_char(tail, i - prevOffs, native_text[s + i]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+ end;
+ until offs < 0;
+ end
+end;
+
+procedure bad_utf8_warning;
+begin
+ begin_diagnostic;
+ print_nl("Invalid UTF-8 byte or sequence");
+ if terminal_input then print(" in terminal input")
+ else begin
+ print(" at line ");
+ print_int(line);
+ end;
+ print(" replaced by U+FFFD.");
+ end_diagnostic(false);
+end;
+
+function get_input_normalization_state: integer;
+begin
+ if eqtb=nil then get_input_normalization_state:=0 { may be called before eqtb is initialized }
+ else get_input_normalization_state:=XeTeX_input_normalization_state;
+end;
+
+function get_tracing_fonts_state: integer;
+begin
+ get_tracing_fonts_state:=XeTeX_tracing_fonts_state;
+end;
+
+@ 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; 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); link(p):=b; q:=fraction_rule(t); link(q):=p;
+p:=new_kern(t); link(p):=q; 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|@>
+procedure stack_glyph_into_box(@!b:pointer;@!f:internal_font_number;@!g:integer);
+var p,q:pointer;
+begin
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=f; native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ if type(b)=hlist_node then begin
+ q:=list_ptr(b);
+ if q=null then list_ptr(b):=p else begin
+ while link(q)<>null do q:=link(q);
+ link(q):=p;
+ if (height(b) < height(p)) then height(b):=height(p);
+ if (depth(b) < depth(p)) then depth(b):=depth(p);
+ end;
+ end else begin
+ link(p):=list_ptr(b); list_ptr(b):=p;
+ height(b):=height(p);
+ if (width(b) < width(p)) then width(b):=width(p);
+ end;
+end;
+
+procedure stack_glue_into_box(@!b:pointer;@!min,max:scaled);
+var p,q:pointer;
+begin
+ q:=new_spec(zero_glue);
+ width(q):=min;
+ stretch(q):=max-min;
+ p:=new_glue(q);
+ if type(b)=hlist_node then begin
+ q:=list_ptr(b);
+ if q=null then list_ptr(b):=p else begin
+ while link(q)<>null do q:=link(q);
+ link(q):=p;
+ end;
+ end else begin
+ link(p):=list_ptr(b); list_ptr(b):=p;
+ height(b):=height(p); width(b):=width(p);
+ end;
+end;
+
+function build_opentype_assembly(@!f:internal_font_number;@!a:void_pointer;@!s:scaled;@!horiz:boolean):pointer;
+ {return a box with height/width at least |s|, using font |f|, with glyph assembly info from |a|}
+var
+ b:pointer; {the box we're constructing}
+ n:integer; {the number of repetitions of each extender}
+ i,j:integer; {indexes}
+ g:integer; {glyph code}
+ p:pointer; {temp pointer}
+ s_max,o,oo,prev_o,min_o:scaled;
+ no_extenders: boolean;
+ nat,str:scaled; {natural size, stretch}
+begin
+ b:=new_null_box;
+ if horiz then
+ type(b):=hlist_node
+ else
+ type(b):=vlist_node;
+
+ {figure out how many repeats of each extender to use}
+ n:=-1;
+ no_extenders:=true;
+ min_o:=ot_min_connector_overlap(f);
+ repeat
+ n:=n+1;
+ {calc max possible size with this number of extenders}
+ s_max:=0;
+ prev_o:=0;
+ for i:=0 to ot_part_count(a)-1 do begin
+ if ot_part_is_extender(a, i) then begin
+ no_extenders:=false;
+ for j:=1 to n do begin
+ o:=ot_part_start_connector(f, a, i);
+ if min_o<o then o:=min_o;
+ if prev_o<o then o:=prev_o;
+ s_max:=s_max-o+ot_part_full_advance(f, a, i);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end
+ end else begin
+ o:=ot_part_start_connector(f, a, i);
+ if min_o<o then o:=min_o;
+ if prev_o<o then o:=prev_o;
+ s_max:=s_max-o+ot_part_full_advance(f, a, i);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end;
+ end;
+ until (s_max>=s) or no_extenders;
+
+ {assemble box using |n| copies of each extender,
+ with appropriate glue wherever an overlap occurs}
+ prev_o:=0;
+ for i:=0 to ot_part_count(a)-1 do begin
+ if ot_part_is_extender(a, i) then begin
+ for j:=1 to n do begin
+ o:=ot_part_start_connector(f, a, i);
+ if prev_o<o then o:=prev_o;
+ oo:=o; {max overlap}
+ if min_o<o then o:=min_o;
+ if oo>0 then stack_glue_into_box(b, -oo, -o);
+ g:=ot_part_glyph(a, i);
+ stack_glyph_into_box(b, f, g);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end
+ end else begin
+ o:=ot_part_start_connector(f, a, i);
+ if prev_o<o then o:=prev_o;
+ oo:=o; {max overlap}
+ if min_o<o then o:=min_o;
+ if oo>0 then stack_glue_into_box(b, -oo, -o);
+ g:=ot_part_glyph(a, i);
+ stack_glyph_into_box(b, f, g);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end;
+ end;
+
+ {find natural size and total stretch of the box}
+ p:=list_ptr(b); nat:=0; str:=0;
+ while p<>null do begin
+ if type(p)=whatsit_node then begin
+ if horiz then
+ nat:=nat+width(p)
+ else
+ nat:=nat+height(p)+depth(p);
+ end else if type(p)=glue_node then begin
+ nat:=nat+width(glue_ptr(p));
+ str:=str+stretch(glue_ptr(p));
+ end;
+ p:=link(p);
+ end;
+
+ {set glue so as to stretch the connections if needed}
+ o:=0;
+ if (s>nat) and (str>0) then begin
+ o:=(s-nat);
+ {don't stretch more than |str|}
+ if (o>str) then o:=str;
+ glue_order(b):=normal; glue_sign(b):=stretching;
+ glue_set(b):=unfloat(o/str);
+ if horiz then
+ width(b):= nat+round(str*float(glue_set(b)))
+ else
+ height(b):=nat+round(str*float(glue_set(b)));
+ end else
+ if horiz then
+ width(b):=nat
+ else
+ height(b):=nat;
+
+ build_opentype_assembly:=b;
+end;
+
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
+label found,continue;
+var b:pointer; {the box that will be constructed}
+ot_assembly_ptr:void_pointer;
+@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
+@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
+@!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}
+@!q: four_quarters; {character info}
+@!hd: eight_bits; {height-depth byte}
+@!r: four_quarters; {extensible pieces}
+@!z: integer; {runs through font family members}
+@!large_attempt: boolean; {are we trying the ``large'' variant?}
+begin f:=null_font; w:=0; large_attempt:=false;
+z:=small_fam(d); x:=small_char(d);
+ot_assembly_ptr:=nil;
+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 begin
+ if not is_ot_font(f) then
+ @<Make variable |b| point to a box for |(f,c)|@>
+ else begin
+ {for OT fonts, c is the glyph ID to use}
+ if ot_assembly_ptr<>nil then
+ b:=build_opentype_assembly(f, ot_assembly_ptr, v, 0)
+ else begin
+ b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size);
+ type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node;
+ native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c;
+ set_native_glyph_metrics(list_ptr(b), 1);
+ width(b):=width(list_ptr(b));
+ height(b):=height(list_ptr(b));
+ depth(b):=depth(list_ptr(b));
+ end
+ end
+end else begin b:=new_null_box;
+ width(b):=null_delimiter_space; {use this width if no delimiter was found}
+ end;
+shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
+free_ot_assembly(ot_assembly_ptr);
+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|...@>=
+if is_ot_font(g) then begin
+ x:=map_char_to_glyph(g, x);
+ f:=g; c:=x; w:=0; n:=0;
+ repeat
+ y:=get_ot_math_variant(g, x, n, addressof(u), 0);
+ if u>w then begin
+ c:=y; w:=u;
+ if u>=v then goto found;
+ end;
+ n:=n+1;
+ until u<0;
+ {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
+ ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0);
+ if ot_assembly_ptr<>nil then goto found;
+end else
+begin y:=x;
+if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
+ begin continue: q:=char_info(g)(y);
+ if char_exists(q) then
+ begin if char_tag(q)=ext_tag then
+ begin f:=g; c:=y; goto found;
+ end;
+ hd:=height_depth(q);
+ u:=char_height(g)(hd)+char_depth(g)(hd);
+ if u>w then
+ begin f:=g; c:=y; w:=u;
+ if u>=v then goto found;
+ end;
+ if char_tag(q)=list_tag then
+ begin y:=rem_byte(q); 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:integer):pointer;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+@!b,@!p:pointer; {the new box and its character node}
+begin
+if is_native_font(f) then begin
+ b:=new_null_box;
+ p:=new_native_character(f, c);
+ list_ptr(b):=p;
+ height(b):=height(p); width(b):=width(p);
+ if depth(p)<0 then depth(b):=0 else depth(b):=depth(p);
+ end
+else begin
+ q:=char_info(f)(c); hd:=height_depth(q);
+ b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
+ height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
+ p:=get_avail; character(p):=c; font(p):=f;
+ end;
+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(q)=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); link(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;
+var q:four_quarters;
+@!hd:eight_bits; {|height_depth| byte}
+begin q:=char_info(f)(c); hd:=height_depth(q);
+height_plus_depth:=char_height(f)(hd)+char_depth(f)(hd);
+end;
+
+@ @<Construct an extensible...@>=
+begin b:=new_null_box;
+type(b):=vlist_node;
+r:=font_info[exten_base[f]+rem_byte(q)].qqqq;@/
+@<Compute the minimum suitable height, |w|, and the corresponding
+ number of extension steps, |n|; also set |width(b)|@>;
+c:=ext_bot(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+c:=ext_rep(r);
+for m:=1 to n do stack_into_box(b,f,c);
+c:=ext_mid(r);
+if c<>min_quarterword then
+ begin stack_into_box(b,f,c); c:=ext_rep(r);
+ for m:=1 to n do stack_into_box(b,f,c);
+ end;
+c:=ext_top(r);
+if c<>min_quarterword then stack_into_box(b,f,c);
+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...@>=
+c:=ext_rep(r); u:=height_plus_depth(f,c);
+w:=0; q:=char_info(f)(c); width(b):=char_width(f)(q)+char_italic(f)(q);@/
+c:=ext_bot(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_mid(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+c:=ext_top(r);@+if c<>min_quarterword then w:=w+height_plus_depth(f,c);
+n:=0;
+if u>0 then while w<v do
+ begin w:=w+u; incr(n);
+ if ext_mid(r)<>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:pointer; {temporary register 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(link(p)=null) then
+ begin f:=font(p); v:=char_width(f)(char_info(f)(character(p)));
+ if v<>width(b) then link(p):=new_kern(width(b)-v);
+ end;
+ free_node(b,box_node_size);
+ b:=new_glue(ss_glue); link(b):=p;
+ while link(p)<>null do p:=link(p);
+ link(p):=new_glue(ss_glue);
+ 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:=get_node(glue_spec_size);
+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(link(head)); flush_node_list(incompleat_noad);
+link(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, |link(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:small_number; {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:small_number):pointer;
+label found;
+var q:pointer; {beginning of a list to be boxed}
+@!save_style:small_number; {|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; mem[nucleus(cur_mlist)]:=mem[p];
+ end;
+sub_box: begin q:=info(p); goto found;
+ end;
+sub_mlist: cur_mlist:=info(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:=link(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 (link(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:=link(q);
+ if r<>null then if link(r)=null then if not is_char_node(r) then
+ if type(r)=kern_node then {unneeded italic correction}
+ begin free_node(r,small_node_size); link(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|, |cur_c|,
+and |cur_i| to the font code, character code, and character information bytes of
+a given noad field. It also takes care of issuing error messages for
+nonexistent characters; in such cases, |char_exists(cur_i)| 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:=cast_to_ushort(character(a)); cur_f:=fam_fnt(fam(a)+cur_size);
+cur_c:=cur_c + (plane_and_fam_field(a) div @"100) * @"10000;
+if cur_f=null_font then
+ @<Complain about an undefined family and set |cur_i| null@>
+else if is_native_font(cur_f) then begin
+ cur_i:=null_character;
+end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
+ cur_i:=char_info(cur_f)(cur_c)
+ else cur_i:=null_character;
+ if not(char_exists(cur_i)) then
+ begin char_warning(cur_f,qo(cur_c));
+ math_type(a):=empty; cur_i:=null_character;
+ 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_ASCII(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; cur_i:=null_character; 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:integer; {the |character| field of a |math_char|}
+@!cur_i:four_quarters; {the |char_info| of a |math_char|,
+ or a lig/kern instruction}
+
+@ 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(#)==mem[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:small_number; {the given style}
+@!save_style:small_number; {holds |cur_style| during recursion}
+@!q:pointer; {runs through the mlist}
+@!r:pointer; {the most recent noad preceding |q|}
+@!r_type:small_number; {the |type| of noad |r|, or |op_noad| if |r=null|}
+@!t:small_number; {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:small_number; {the size of a noad to be deleted}
+@!max_h,@!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_h:=0; max_d:=0;
+@<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_h then max_h:=height(z);
+if depth(z)>max_d then max_d:=depth(z);
+free_node(z,box_node_size);
+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:=link(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_h then max_h:=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:=link(q); link(q):=p;
+ while link(p)<>null do p:=link(p);
+ link(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:=link(q);
+ if p<>null then if (type(p)=glue_node)or(type(p)=kern_node) then
+ begin link(q):=link(p); link(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);
+begin info(nucleus(q)):=@|
+ overbar(clean_box(nucleus(q),cramped_style(cur_style)),@|
+ 3*default_rule_thickness,default_rule_thickness);
+math_type(nucleus(q)):=sub_box;
+end;
+
+@ @<Declare math...@>=
+procedure make_under(@!q:pointer);
+var p,@!x,@!y: 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); link(x):=p;
+link(p):=fraction_rule(default_rule_thickness);
+y:=vpack(x,natural);
+delta:=height(y)+depth(y)+default_rule_thickness;
+height(y):=height(x); depth(y):=delta-height(y);
+info(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:=info(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:pointer; {temporary registers for box construction}
+f:internal_font_number;
+rule_thickness:scaled; {rule thickness}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin f:=fam_fnt(small_fam(left_delimiter(q)) + cur_size);
+if is_new_mathfont(f) then rule_thickness:=get_ot_math_constant(f,radicalRuleThickness)
+else rule_thickness:=default_rule_thickness;
+x:=clean_box(nucleus(q),cramped_style(cur_style));
+if is_new_mathfont(f) then begin
+ if cur_style<text_style then {display style}
+ clr:=get_ot_math_constant(f,radicalDisplayStyleVerticalGap)
+ else clr:=get_ot_math_constant(f,radicalVerticalGap);
+end else begin
+ if cur_style<text_style then {display style}
+ clr:=rule_thickness+(abs(math_x_height(cur_size)) div 4)
+ else begin clr:=rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+rule_thickness);
+if is_new_mathfont(f) then begin
+ depth(y):=height(y)+depth(y)-rule_thickness;
+ height(y):=rule_thickness;
+end;
+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);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural); 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...@>=
+function compute_ot_math_accent_pos(@!p:pointer):scaled;
+var
+ @!q,@!r:pointer;
+ @!s,@!g:scaled;
+begin
+ if (math_type(nucleus(p))=math_char) then begin
+ fetch(nucleus(p));
+ q:=new_native_character(cur_f, qo(cur_c));
+ g:=get_native_glyph(q, 0);
+ s:=get_ot_math_accent_pos(cur_f, g);
+ end else begin
+ if (math_type(nucleus(p))=sub_mlist) then begin
+ r:=info(nucleus(p));
+ if (r<>null) and (type(r)=accent_noad) then
+ s:=compute_ot_math_accent_pos(r)
+ else
+ s:=@"7FFFFFFF;
+ end else
+ s:=@"7FFFFFFF;
+ end;
+ compute_ot_math_accent_pos:=s;
+end;
+
+procedure make_math_accent(@!q:pointer);
+label done,done1;
+var p,@!x,@!y:pointer; {temporary registers for box construction}
+@!a:integer; {address of lig/kern instruction}
+@!c,@!g:integer; {accent character}
+@!f:internal_font_number; {its font}
+@!i:four_quarters; {its |char_info|}
+@!s,@!sa: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,@!w2:scaled; {width of the accentee, not including sub/superscripts}
+@!ot_assembly_ptr:void_pointer;
+begin fetch(accent_chr(q));
+x:=null;
+ot_assembly_ptr:=nil;
+if is_native_font(cur_f) then
+ begin c:=cur_c; f:=cur_f;
+ if not is_bottom_acc(q) then s:=compute_ot_math_accent_pos(q) else s:=0;
+ x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
+ end
+else if char_exists(cur_i) then
+ begin i:=cur_i; 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@>;
+ end;
+if x<>null then begin
+ if is_new_mathfont(f) then
+ if is_bottom_acc(q) then delta:=0
+ else if h<get_ot_math_constant(f, accentBaseHeight) then delta:=h@+else delta:=get_ot_math_constant(f, accentBaseHeight)
+ else
+ 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);
+ if is_native_font(f) then begin
+ {turn the |native_word| node into a |native_glyph| one}
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0);
+ set_native_glyph_metrics(p, 1);
+ free_node(list_ptr(y), native_size(list_ptr(y)));
+ list_ptr(y):=p;
+
+ @<Switch to a larger native-font accent if available and appropriate@>;
+
+ {determine horiz positioning}
+ if is_glyph_node(p) then
+ begin sa:=get_ot_math_accent_pos(f,native_glyph(p));
+ if sa=@"7FFFFFFF then sa:=half(width(y));
+ end
+ else sa:=half(width(y));
+ if is_bottom_acc(q) or (s=@"7FFFFFFF) then s:=half(w);
+ shift_amount(y):=s-sa;
+ end else
+ shift_amount(y):=s+half(w-width(y));
+ width(y):=0;
+ if is_bottom_acc(q) then begin
+ link(x):=y; y:=vpack(x,natural); shift_amount(y):=-(h - height(y));
+ end else begin
+ p:=new_kern(-delta); link(p):=x; link(y):=p; y:=vpack(y,natural);
+ if height(y)<h then @<Make the height of box |y| equal to |h|@>;
+ end;
+ width(y):=width(x);
+ info(nucleus(q)):=y;
+ math_type(nucleus(q)):=sub_box;
+ end;
+ free_ot_assembly(ot_assembly_ptr);
+end;
+
+@ @<Make the height of box |y|...@>=
+begin p:=new_kern(h-height(y)); link(p):=list_ptr(y); list_ptr(y):=p;
+height(y):=h;
+end
+
+@ @<Switch to a larger native-font accent if available and appropriate@>=
+ if odd(subtype(q)) then {non growing accent}
+ set_native_glyph_metrics(p, 1)
+ else begin
+ c:=native_glyph(p);
+ a:=0;
+ repeat
+ g:=get_ot_math_variant(f, c, a, addressof(w2), 1);
+ if (w2>0) and (w2<=w) then begin
+ native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ incr(a);
+ end;
+ until (w2<0) or (w2>=w);
+ if (w2<0) then begin
+ ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1);
+ if ot_assembly_ptr<>nil then begin
+ free_node(p,glyph_node_size);
+ p:=build_opentype_assembly(f, ot_assembly_ptr, w, 1);
+ list_ptr(y):=p;
+ goto found;
+ end;
+ end else
+ set_native_glyph_metrics(p, 1);
+ end;
+found:
+ width(y):=width(p); height(y):=height(p); depth(y):=depth(p);
+ if is_bottom_acc(q) then begin
+ if height(y)<0 then height(y):=0
+ end else if depth(y)<0 then depth(y):=0;
+
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>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));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(cur_i))=skew_char[cur_f] then
+ begin if op_byte(cur_i)>=kern_flag then
+ if skip_byte(cur_i)<=stop_flag then s:=char_kern(cur_f)(cur_i);
+ goto done1;
+ end;
+ if skip_byte(cur_i)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+
+@ @<Swap the subscript and superscript into box |x|@>=
+begin flush_node_list(x); x:=new_noad;
+mem[nucleus(x)]:=mem[nucleus(q)];
+mem[supscr(x)]:=mem[supscr(q)];
+mem[subscr(x)]:=mem[subscr(q)];@/
+mem[supscr(q)].hh:=empty_field;
+mem[subscr(q)].hh:=empty_field;@/
+math_type(nucleus(q)):=sub_mlist; info(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));
+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 twice |delta|.
+
+@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
+begin if is_new_mathfont(cur_f) then begin
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, stackDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, stackGapMin);
+end else begin
+ if cur_style<text_style then clr:=7*default_rule_thickness
+ else clr:=3*default_rule_thickness;
+end;
+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 is_new_mathfont(cur_f) then begin
+ delta:=half(thickness(q));
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionNumDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, fractionNumeratorGapMin);
+ delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionDenomDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, fractionDenominatorGapMin);
+ delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+end else 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));
+end;
+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));
+ link(p):=z;
+ end
+else begin y:=fraction_rule(thickness(q));@/
+ p:=new_kern((axis_height(cur_size)-delta)-@|(height(z)-shift_down));@/
+ link(y):=p; link(p):=z;@/
+ p:=new_kern((shift_up-depth(x))-(axis_height(cur_size)+delta));
+ link(p):=y;
+ end;
+link(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); link(x):=v;@/
+z:=var_delimiter(right_delimiter(q), cur_size, delta); link(v):=z;@/
+new_hlist(q):=hpack(x,natural)
+
+@ 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;
+label found;
+var delta:scaled; {offset between subscript and superscript}
+@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
+@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
+@!h1,@!h2:scaled; {height of original text-style symbol and possible replacement}
+@!n,@!g:integer; {potential variant index and glyph code}
+@!ot_assembly_ptr:void_pointer;
+@!save_f:internal_font_number;
+begin if (subtype(q)=normal)and(cur_style<text_style) then
+ subtype(q):=limits;
+delta:=0;
+ot_assembly_ptr:=nil;
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+ if not is_ot_font(cur_f) then begin
+ if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+ if char_exists(i) then
+ begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
+ end;
+ end;
+ delta:=char_italic(cur_f)(cur_i);
+ end;
+ x:=clean_box(nucleus(q),cur_style);
+ if is_new_mathfont(cur_f) then begin
+ p:=list_ptr(x);
+ if is_glyph_node(p) then begin
+ if cur_style<text_style then begin
+ {try to replace the operator glyph with a display-size variant,
+ ensuring it is larger than the text size}
+ h1:=get_ot_math_constant(cur_f,displayOperatorMinHeight);
+ if h1<(height(p)+depth(p))*5/4 then h1:=(height(p)+depth(p))*5/4;
+ c:=native_glyph(p);
+ n:=0;
+ repeat
+ g:=get_ot_math_variant(cur_f, c, n, addressof(h2), 0);
+ if h2>0 then begin
+ native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ end;
+ incr(n);
+ until (h2<0) or (h2>=h1);
+ if (h2<0) then begin
+ {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
+ ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0);
+ if ot_assembly_ptr<>nil then begin
+ free_node(p,glyph_node_size);
+ p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1, 0);
+ list_ptr(x):=p;
+ delta:=0;
+ goto found;
+ end;
+ end else
+ set_native_glyph_metrics(p, 1);
+ end;
+ delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
+found:
+ width(x):=width(p); height(x):=height(p); depth(x):=depth(p);
+ end
+ end;
+ 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; info(nucleus(q)):=x;
+ end;
+save_f:=cur_f;
+if subtype(q)=limits then
+ @<Construct a box with limits above and below it, skewed by |delta|@>;
+free_ot_assembly(ot_assembly_ptr);
+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)|...@>=
+cur_f:=save_f;
+if math_type(supscr(q))=empty then
+ begin free_node(x,box_node_size); 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); link(p):=y; link(x):=p;@/
+ p:=new_kern(big_op_spacing5); link(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 free_node(z,box_node_size)
+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); link(y):=p; link(p):=z;@/
+ p:=new_kern(big_op_spacing5); link(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_node|, because
+there is no question of hyphenation afterwards; the ligature will simply be
+stored in an ordinary |char_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; {address of lig/kern instruction}
+@!p,@!r:pointer; {temporary registers for list manipulation}
+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:=link(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));
+ if char_tag(cur_i)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(cur_i);
+ cur_c:=character(nucleus(p));
+ cur_i:=font_info[a].qqqq;
+ if skip_byte(cur_i)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(cur_i);
+ cur_i:=font_info[a].qqqq;
+ end;
+ loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach
+ the kern after~|q|; or if it is a ligature with |cur_c|, combine
+ noads |q| and~|p| appropriately; then |return| if the cursor has
+ moved past a noad, or |goto restart|@>;
+ if skip_byte(cur_i)>=stop_flag then return;
+ a:=a+qo(skip_byte(cur_i))+1;
+ cur_i:=font_info[a].qqqq;
+ end;
+ 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 instruction |cur_i| is a kern with |cur_c|, ...@>=
+if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
+ if op_byte(cur_i)>=kern_flag then
+ begin p:=new_kern(char_kern(cur_f)(cur_i));
+ link(p):=link(q); link(q):=p; return;
+ end
+ else begin check_interrupt; {allow a way out of infinite ligature loop}
+ case op_byte(cur_i) of
+ qi(1),qi(5): character(nucleus(q)):=rem_byte(cur_i); {\.{=:\?}, \.{=:\?>}}
+ qi(2),qi(6): character(nucleus(p)):=rem_byte(cur_i); {\.{\?=:}, \.{\?=:>}}
+ qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}}
+ character(nucleus(r)):=rem_byte(cur_i);
+ plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/
+ link(q):=r; link(r):=p;
+ if op_byte(cur_i)<qi(11) then math_type(nucleus(r)):=math_char
+ else math_type(nucleus(r)):=math_text_char; {prevent combination}
+ end;
+ othercases begin link(q):=link(p);
+ character(nucleus(q)):=rem_byte(cur_i); {\.{=:}}
+ mem[subscr(q)]:=mem[subscr(p)]; mem[supscr(q)]:=mem[supscr(p)];@/
+ free_node(p,noad_size);
+ end
+ endcases;
+ if op_byte(cur_i)>qi(3) then return;
+ math_type(nucleus(q)):=math_char; goto restart;
+ 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:=info(nucleus(q));
+sub_mlist: begin cur_mlist:=info(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(link(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 is_native_font(cur_f) then begin
+ z:=new_native_character(cur_f, qo(cur_c));
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0);
+ set_native_glyph_metrics(p, 1);
+ free_node(z, native_size(z));
+ delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
+ if (math_type(nucleus(q))=math_text_char)and(not is_new_mathfont(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 link(p):=new_kern(delta); delta:=0;
+ end;
+end else if char_exists(cur_i) then
+ begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(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 link(p):=new_kern(delta); 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 the 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...@>=
+function attach_hkern_to_new_hlist(@!q:pointer;@!delta:scaled):pointer;
+var y,@!z:pointer; {temporary registers for box construction}
+begin z:=new_kern(delta);
+if new_hlist(q)=null then new_hlist(q):=z
+else begin y:=new_hlist(q);
+ while link(y)<>null do y:=link(y);
+ link(y):=z;
+ end;
+attach_hkern_to_new_hlist:=new_hlist(q);
+end;
+
+procedure make_scripts(@!q:pointer;@!delta:scaled);
+var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
+@!shift_up,@!shift_down,@!clr,@!sub_kern,@!sup_kern:scaled; {dimensions in the calculation}
+@!script_c:pointer; {temprary native character for sub/superscript}
+@!script_g:quarterword; {temporary register for sub/superscript native glyph id}
+@!script_f:internal_font_number; {temporary register for sub/superscript font}
+@!sup_g:quarterword; {superscript native glyph id}
+@!sup_f:internal_font_number; {superscript font}
+@!sub_g:quarterword; {subscript native glyph id}
+@!sub_f:internal_font_number; {subscript font}
+@!t:integer; {subsidiary size code}
+@!save_f:internal_font_number;
+@!script_head:pointer; {scratch var for OpenType s*scripts}
+@!script_ptr:pointer; {scratch var for OpenType s*scripts}
+@!saved_math_style:small_number; {scratch var for OpenType s*scripts}
+@!this_math_style:small_number; {scratch var for OpenType s*scripts}
+begin p:=new_hlist(q);
+script_c:=null; script_g:=0; script_f:=0; sup_kern:=0; sub_kern:=0;
+if is_char_node(p) or is_glyph_node(p) then
+ begin shift_up:=0; shift_down:=0;
+ end
+else begin z:=hpack(p,natural);
+ if cur_style<script_style then t:=script_size@+else t:=script_script_size;
+ shift_up:=height(z)-sup_drop(t);
+ shift_down:=depth(z)+sub_drop(t);
+ free_node(z,box_node_size);
+ 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 link(p)<>null do p:=link(p);
+ link(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
+script_head:=subscr(q);
+@<Fetch first character of a sub/superscript@>;
+sub_g:=script_g;
+sub_f:=script_f;
+save_f:=cur_f;
+x:=clean_box(subscr(q),sub_style(cur_style));
+cur_f:=save_f;
+width(x):=width(x)+script_space;
+if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
+if is_new_mathfont(cur_f) then
+ clr:=height(x)-get_ot_math_constant(cur_f, subscriptTopMax)
+else
+ 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;
+if is_new_mathfont(cur_f) then @<Attach subscript OpenType math kerning@>
+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
+script_head:=supscr(q);
+@<Fetch first character of a sub/superscript@>;
+sup_g:=script_g;
+sup_f:=script_f;
+save_f:=cur_f;
+x:=clean_box(supscr(q),sup_style(cur_style));
+cur_f:=save_f;
+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;
+if is_new_mathfont(cur_f) then
+ clr:=depth(x)+get_ot_math_constant(cur_f, superscriptBottomMin)
+else
+ clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
+if shift_up<clr then shift_up:=clr;
+if is_new_mathfont(cur_f) then @<Attach superscript OpenType math kerning@>
+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
+save_f:=cur_f;
+script_head:=subscr(q);
+@<Fetch first character of a sub/superscript@>;
+sub_g:=script_g;
+sub_f:=script_f;
+y:=clean_box(subscr(q),sub_style(cur_style));
+cur_f:=save_f;
+width(y):=width(y)+script_space;
+if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
+if is_new_mathfont(cur_f) then
+ clr:=get_ot_math_constant(cur_f, subSuperscriptGapMin)-((shift_up-depth(x))-(height(y)-shift_down))
+else
+ clr:=4*default_rule_thickness-((shift_up-depth(x))-(height(y)-shift_down));
+if clr>0 then
+ begin shift_down:=shift_down+clr;
+ if is_new_mathfont(cur_f) then
+ clr:=get_ot_math_constant(cur_f, superscriptBottomMaxWithSubscript)-(shift_up-depth(x))
+ else
+ 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;
+if is_new_mathfont(cur_f) then begin
+ @<Attach subscript OpenType math kerning@>@/
+ @<Attach superscript OpenType math kerning@>
+ end
+else
+ begin sup_kern:=0; sub_kern:=0;
+ end;
+shift_amount(x):=sup_kern+delta-sub_kern; {superscript is |delta| to the right of the subscript}
+p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y;
+x:=vpack(x,natural); shift_amount(x):=shift_down;
+end
+
+@ OpenType math fonts provide an additional adjustment for the horizontal
+position of sub/superscripts called math kerning.
+
+The following definitions should be kept in sync with \.{XeTeXOTMath.cpp}.
+
+@d sup_cmd=0 {superscript kern type for |get_ot_math_kern|}
+@d sub_cmd=1 {subscript kern type for |get_ot_math_kern|}
+
+@d is_valid_pointer(#) == ((# >= mem_min) and (# <= mem_end))
+
+@ @<Fetch first character of a sub/superscript@> =
+script_c:=null;
+script_g:=qi(0);
+script_f:=null_font;
+this_math_style:=sub_style(cur_style);
+
+{ Loop through the |sub_mlist| looking for the first character-like
+ thing. Ignore kerns or glue so that, for example, changing
+ $P_j$ to $P_{\!j}$ will have a predictable effect. Intercept
+ |style_node|s and execute them. If we encounter a |choice_node|,
+ follow the appropriate branch. Anything else halts the search
+ and inhibits OpenType kerning. }
+
+{ Don't try to do anything clever if the nucleus of the
+ |script_head| is empty, e.g., $P_{^j}$ and the such. }
+
+if math_type(script_head)=sub_mlist then
+ begin
+ script_ptr:=info(script_head);
+ script_head:=null;
+
+ while is_valid_pointer(script_ptr) do
+ begin
+ case type(script_ptr) of
+ kern_node, glue_node: do_nothing;
+ style_node: begin this_math_style:=subtype(script_ptr);
+ end;
+ choice_node: do_nothing; {see below}
+ ord_noad, op_noad, bin_noad, rel_noad, open_noad,
+ close_noad, punct_noad: begin script_head:=nucleus(script_ptr);
+ script_ptr:=null;
+ end;
+ othercases script_ptr:=null {end the search}
+ endcases;
+
+ if is_valid_pointer(script_ptr) then
+ if type(script_ptr)=choice_node then
+ case this_math_style div 2 of
+ 0: script_ptr:=display_mlist(script_ptr);
+ 1: script_ptr:=text_mlist(script_ptr);
+ 2: script_ptr:=script_mlist(script_ptr);
+ 3: script_ptr:=script_script_mlist(script_ptr);
+ end
+ else
+ script_ptr:=link(script_ptr);
+ end;
+ end;
+
+if is_valid_pointer(script_head) and math_type(script_head)=math_char then
+ begin
+ save_f:=cur_f;
+ saved_math_style:=cur_style;
+ cur_style:=this_math_style;
+ @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+ fetch(script_head);
+
+ if is_new_mathfont(cur_f) then
+ begin
+ script_c:=new_native_character(cur_f,qo(cur_c));
+ script_g:=get_native_glyph(script_c,0);
+ script_f:=cur_f; {script font}
+ end;
+
+ cur_f:=save_f;
+ cur_style:=saved_math_style;
+ @<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>;
+ end;
+
+ { The remaining case is |math_type(script_head) = sub_box|.
+ Although it would be possible to deconstruct the box node to
+ find the first glyph, it will most likely be from a text font
+ without MATH kerning, so there's probably no point. }
+
+@ @<Attach subscript OpenType math kerning@> =
+begin
+if is_glyph_node(p) then
+ begin
+ sub_kern:=get_ot_math_kern(native_font(p),native_glyph(p),sub_f,sub_g,sub_cmd,shift_down);
+ if sub_kern<>0 then p:=attach_hkern_to_new_hlist(q,sub_kern);
+ end;
+end;
+
+@ @<Attach superscript OpenType math kerning@> =
+begin
+{ if there is a superscript the kern will be added to |shift_amount(x)| }
+
+if math_type(subscr(q))=empty then
+ if is_glyph_node(p) then
+ begin
+ sup_kern:=get_ot_math_kern(native_font(p),native_glyph(p),sup_f,sup_g,sup_cmd,shift_up);
+ if sup_kern<>0 then p:=attach_hkern_to_new_hlist(q,sup_kern);
+ end;
+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_h| 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; link(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:=link(q); free_node(r,s);
+ 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: s:=fraction_noad_size;
+left_noad,right_noad: t:=make_left_right(q,style,max_d,max_h);
+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 link(p):=q; p:=q; q:=link(q); link(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:small_number;
+ @!max_d,@!max_h:scaled):small_number;
+var delta,@!delta1,@!delta2:scaled; {dimensions used in the calculation}
+begin cur_style:=style; @<Set up the values...@>;
+delta2:=max_d+axis_height(cur_size);
+delta1:=max_h+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;
+new_hlist(q):=var_delimiter(delimiter(q),cur_size,delta);
+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 an $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; link(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 link(p):=new_hlist(q);
+ repeat p:=link(p);
+ until link(p)=null;
+ end;
+if penalties then if link(q)<>null then if pen<inf_penalty then
+ begin r_type:=type(link(q));
+ if r_type<>penalty_node then if r_type<>rel_noad then
+ begin z:=new_penalty(pen); link(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. However, at the
+moment they have no |type| or |subtype| fields; they have |info| fields
+instead, and these |info| fields are initially set to the value |end_span|,
+for reasons explained below. Furthermore, the alignrecord nodes have no
+|height| or |depth| fields; these are renamed |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.
+
+(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 |info| field of the
+alignrecord for column~1 now points to the new span node, and the |info|
+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 u_part(#)==mem[#+height_offset].int {pointer to \<u_j> token list}
+@d v_part(#)==mem[#+depth_offset].int {pointer to \<v_j> token list}
+@d extra_info(#)==info(#+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.
+
+The current values of these seven quantities appear in global variables;
+when they have to be pushed down, they are stored in 5-word nodes, and
+|align_ptr| points to the topmost such node.
+
+@d preamble==link(align_head) {the current preamble list}
+@d align_stack_node_size=6 {number of |mem| words to save alignment states}
+
+@<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:=get_node(align_stack_node_size);
+link(p):=align_ptr; info(p):=cur_align;
+llink(p):=preamble; rlink(p):=cur_span;
+mem[p+2].int:=cur_loop; mem[p+3].int:=align_state;
+info(p+4):=cur_head; link(p+4):=cur_tail;
+info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail;
+align_ptr:=p;
+cur_head:=get_avail;
+cur_pre_head:=get_avail;
+end;
+@#
+procedure pop_alignment;
+var p:pointer; {the top alignment stack node}
+begin free_avail(cur_head);
+free_avail(cur_pre_head);
+p:=align_ptr;
+cur_tail:=link(p+4); cur_head:=info(p+4);
+cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5);
+align_state:=mem[p+3].int; cur_loop:=mem[p+2].int;
+cur_span:=rlink(p); preamble:=llink(p);
+cur_align:=info(p); align_ptr:=link(p);
+free_node(p,align_stack_node_size);
+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: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@>=
+link(cur_align):=new_param_glue(tab_skip_code);
+cur_align:=link(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_head|@>;
+link(cur_align):=new_null_box; cur_align:=link(cur_align); {a new alignrecord}
+info(cur_align):=end_span; width(cur_align):=null_flag;
+u_part(cur_align):=link(hold_head);
+@<Scan the template \<v_j>, putting the resulting token list in |hold_head|@>;
+v_part(cur_align):=link(hold_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";
+@.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_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_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_head) then
+ begin link(p):=get_avail; p:=link(p); info(p):=cur_tok;
+ end;
+ end;
+done1:
+
+@ @<Scan the template \<v_j>...@>=
+p:=hold_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;
+ link(p):=get_avail; p:=link(p); info(p):=cur_tok;
+ end;
+done2: link(p):=get_avail; 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:=link(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.
+
+@<Insert the \(v)\<v_j>...@>=
+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; goto restart;
+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:=link(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:=link(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 link(q):=new_null_box; p:=link(q); {a new alignrecord}
+info(p):=end_span; width(p):=null_flag; cur_loop:=link(cur_loop);
+@<Copy the templates from node |cur_loop| into node |p|@>;
+cur_loop:=link(cur_loop);
+link(p):=new_glue(glue_ptr(cur_loop));
+subtype(link(p)):=tab_skip_code+1;
+end
+
+@ @<Copy the templates from node |cur_loop| into node |p|@>=
+q:=hold_head; r:=u_part(cur_loop);
+while r<>null do
+ begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
+ end;
+link(q):=null; u_part(p):=link(hold_head);
+q:=hold_head; r:=v_part(cur_loop);
+while r<>null do
+ begin link(q):=get_avail; q:=link(q); info(q):=info(r); r:=link(r);
+ end;
+link(q):=null; v_part(p):=link(hold_head)
+
+@ @<Copy the tabskip glue...@>=
+tail_append(new_glue(glue_ptr(link(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:=hpack(link(head),natural); w:=width(u);
+ cur_tail:=adjust_tail; adjust_tail:=null;
+ cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
+ end
+else begin u:=vpackage(link(head),natural,0); 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; link(tail):=u; tail:=u;
+end
+
+@ A span node is a 2-word record containing |width|, |info|, and |link|
+fields. The |link| field is not really a link, it indicates the number of
+spanned columns; the |info| 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 |link| 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 |info| field of the alignrecord for that
+column.
+
+@d span_node_size=2 {number of |mem| words for a span node}
+
+@<Initialize the special list heads...@>=
+link(end_span):=max_quarterword+1; info(end_span):=null;
+
+@ @<Update width entry for spanned columns@>=
+begin q:=cur_span;
+repeat incr(n); q:=link(link(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 link(info(q))<n do q:=info(q);
+if link(info(q))>n then
+ begin s:=get_node(span_node_size); info(s):=info(q); link(s):=n;
+ info(q):=s; width(s):=w;
+ end
+else if width(info(q))<w then width(info(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:=hpack(link(head),natural);
+ 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:=vpack(link(head),natural); pop_nest;
+ link(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: 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+|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:=link(preamble);
+repeat flush_list(u_part(q)); flush_list(v_part(q));
+p:=link(link(q));
+if width(q)=null_flag then
+ @<Nullify |width(q)| and the tabskip glue following this column@>;
+if info(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:=link(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(link(q)));
+r:=info(q); s:=end_span; info(s):=p; n:=min_quarterword+1;
+repeat width(r):=width(r)-t; u:=info(r);
+while link(r)>n do
+ begin s:=info(s); n:=link(info(s))+1;
+ end;
+if link(r)<n then
+ begin info(r):=info(s); info(s):=r; decr(link(r)); s:=r;
+ end
+else begin if width(r)>width(info(s)) then width(info(s)):=width(r);
+ free_node(r,span_node_size);
+ 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:=link(preamble);
+ repeat height(q):=width(q); width(q):=0; q:=link(link(q));
+ until q=null;
+ p:=vpack(preamble,saved(1),saved(0));
+ q:=link(preamble);
+ repeat width(q):=height(q); height(q):=0; q:=link(link(q));
+ until q=null;
+ end;
+pack_begin_line:=0
+
+@ @<Set the glue in all the unset...@>=
+q:=link(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:=link(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:=link(q); link(q):=null; q:=hpack(q,natural);
+ shift_amount(q):=o; link(q):=r; link(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);
+ if nest[nest_ptr-1].mode_field=mmode then set_box_lr(q)(dlist); {for |ship_out|}
+ 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:=link(list_ptr(q)); s:=link(list_ptr(p));
+repeat @<Set the glue in node |r| and change it from an unset node@>;
+r:=link(link(r)); s:=link(link(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;
+set_box_lr(r)(0); {for |ship_out|}
+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 link(u):=link(r); link(r):=link(hold_head); r:=u;
+ end
+
+@ @<Append tabskip glue and an empty box to list |u|...@>=
+s:=link(s); v:=glue_ptr(s); link(u):=new_glue(v); u:=link(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:=link(s); link(u):=new_null_box; u:=link(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.)
+
+In restricted horizontal mode, the |clang| part of |aux| is undefined;
+an over-cautious \PASCAL\ runtime system may complain about this.
+@^dirty \PASCAL@>
+
+@<Insert the \(c)current list into its environment@>=
+aux_save:=aux; p:=link(head); q:=tail; pop_nest;
+if mode=mmode then @<Finish an alignment in a display@>
+else begin aux:=aux_save; link(tail):=p;
+ if p<>null then tail:=q;
+ if mode=vmode then build_page;
+ 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
+and 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 |link(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}
+is 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}
+
+@ Since |line_break| is a rather lengthy procedure---sort of a small world unto
+itself---we must build it up little by little, somewhat more cautiously
+than we have done with the simpler procedures of \TeX. Here is the
+general outline.
+
+@p@t\4@>@<Declare subprocedures for |line_break|@>
+procedure line_break(@!d:boolean);
+label done,done1,done2,done3,done4,done5,done6,continue, restart;
+var @<Local variables for line breaking@>@;
+begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
+@<Get ready to start line breaking@>;
+@<Find optimal breakpoints@>;
+@<Break the paragraph at the chosen breakpoints, justify the resulting lines
+to the correct widths, and append them to the current vertical list@>;
+@<Clean up the memory by removing the break nodes@>;
+pack_begin_line:=0;
+end;
+@#
+@t\4@>@<Declare \eTeX\ procedures for use by |main_control|@>
+
+@ The first task 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.
+
+This code assumes that a |glue_node| and a |penalty_node| occupy the
+same number of |mem|~words.
+@^data structure assumptions@>
+
+@<Get ready to start...@>=
+link(temp_head):=link(head);
+if is_char_node(tail) then tail_append(new_penalty(inf_penalty))
+else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty))
+else begin type(tail):=penalty_node; delete_glue_ref(glue_ptr(tail));
+ flush_node_list(leader_ptr(tail)); penalty(tail):=inf_penalty;
+ end;
+link(tail):=new_param_glue(par_fill_skip_code);
+last_line_fill:=link(tail);
+init_cur_lang:=prev_graf mod @'200000;
+init_l_hyf:=prev_graf div @'20000000;
+init_r_hyf:=(prev_graf div @'200000) mod @'100;
+pop_nest;
+
+@ 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|.
+
+@d tight_fit=3 {fitness classification for lines shrinking 0.5 to 1.0 of their
+ shrinkability}
+@d loose_fit=1 {fitness classification for lines stretching 0.5 to 1.0 of their
+ stretchability}
+@d very_loose_fit=0 {fitness classification for lines stretching more than
+ their stretchability}
+@d decent_fit=2 {fitness classification for all other lines}
+
+@ 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:
+
+\yskip\hang|link| points to the next node in the list of active nodes; the
+last active node has |link=last_active|.
+
+\yskip\hang|break_node| points to the passive node associated with this
+breakpoint.
+
+\yskip\hang|line_number| is the number of the line that follows this
+breakpoint.
+
+\yskip\hang|fitness| is the fitness classification of the line ending at this
+breakpoint.
+
+\yskip\hang|type| is either |hyphenated| or |unhyphenated|, depending on
+whether this breakpoint is a |disc_node|.
+
+\yskip\hang|total_demerits| is the minimum possible sum of demerits over all
+lines leading from the beginning of the paragraph to this breakpoint.
+
+\yskip\noindent
+The value of |link(active)| points to the first active node on a linked 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.
+
+@d active_node_size_normal=3 {number of words in normal active nodes}
+@d fitness==subtype {|very_loose_fit..tight_fit| on final line for this break}
+@d break_node==rlink {pointer to the corresponding passive node}
+@d line_number==llink {line that begins at this breakpoint}
+@d total_demerits(#)==mem[#+2].int {the quantity that \TeX\ minimizes}
+@d unhyphenated=0 {the |type| of a normal active break node}
+@d hyphenated=1 {the |type| of an active node that breaks at a |disc_node|}
+@d last_active==active {the active list ends where it begins}
+
+@ @<Initialize the special list heads...@>=
+type(last_active):=hyphenated; line_number(last_active):=max_halfword;
+subtype(last_active):=0; {the |subtype| is never examined by the algorithm}
+
+@ The passive node for a given breakpoint contains only four fields:
+
+\yskip\hang|link| points to the passive node created just before this one,
+if any, otherwise it is |null|.
+
+\yskip\hang|cur_break| points to the position of this breakpoint in the
+horizontal list for the paragraph being broken.
+
+\yskip\hang|prev_break| points to the passive node that should precede this
+one in an optimal path to this breakpoint.
+
+\yskip\hang|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.)
+
+\yskip\noindent
+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.
+
+@d passive_node_size=2 {number of words in passive nodes}
+@d cur_break==rlink {in passive node, points to position of this breakpoint}
+@d prev_break==llink {points to passive node that should precede this one}
+@d serial==info {serial number for symbolic identification}
+
+@<Glob...@>=
+@!passive:pointer; {most recent node on passive list}
+@!printed_node:pointer; {most recent node that has been printed}
+@!pass_number:halfword; {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 |link(p)=q| and |link(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 six 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, fil, fill, and filll appear in |mem[q+2..q+5].sc|; and the shrink difference
+appears in |mem[q+6].sc|. The |subtype| field of a delta node is not used.
+
+@d delta_node_size=7 {number of words in a delta node}
+@d delta_node=2 {|type| field in a delta node}
+
+@ As the algorithm runs, it maintains a set of six 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 six 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 6 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.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glob...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to~|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+
+@ 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.
+
+@ 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.
+
+@d check_shrinkage(#)==if (shrink_order(#)<>normal)and(shrink(#)<>0) then
+ begin #:=finite_shrink(#);
+ end
+
+@<Glob...@>=
+@!no_shrink_error_yet:boolean; {have we complained about infinite shrinkage?}
+
+@ @<Declare subprocedures for |line_break|@>=
+function finite_shrink(@!p:pointer):pointer; {recovers from infinite shrinkage}
+var q:pointer; {new glue specification}
+begin if no_shrink_error_yet then
+ begin no_shrink_error_yet:=false;
+ @!stat if tracing_paragraphs>0 then end_diagnostic(true);@+tats@;
+ print_err("Infinite glue shrinkage found in a paragraph");
+@.Infinite glue shrinkage...@>
+ help5("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.");
+ error;
+ @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
+ end;
+q:=new_spec(p); shrink_order(q):=normal;
+delete_glue_ref(p); finite_shrink:=q;
+end;
+
+@ @<Get ready to start...@>=
+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[2+stretch_order(q)]:=stretch(q);@/
+background[2+stretch_order(r)]:=@|background[2+stretch_order(r)]+stretch(r);@/
+background[6]:=shrink(q)+shrink(r);
+@<Check for special treatment of last line of paragraph@>;
+
+@ 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|.
+
+@<Glob...@>=
+@!cur_p:pointer; {the current breakpoint under consideration}
+@!second_pass:boolean; {is this our second attempt to break this paragraph?}
+@!final_pass:boolean; {is this our final attempt to break this paragraph?}
+@!threshold:integer; {maximum badness on feasible lines}
+
+@ 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| or |unhyphenated|,
+depending on whether or not the current break is at a |disc_node|. The
+end of a paragraph is also regarded as `|hyphenated|'; this case is
+distinguishable by the condition |cur_p=null|.
+
+@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#]
+@d deactivate=60 {go here when node |r| should be deactivated}
+
+@d cp_skipable(#) == {skipable nodes at the margins during character protrusion}
+(
+ not is_char_node(#) and
+ (
+ (type(#) = ins_node)
+ or (type(#) = mark_node)
+ or (type(#) = adjust_node)
+ or (type(#) = penalty_node)
+ or ((type(#) = disc_node) and
+ (pre_break(#) = null) and
+ (post_break(#) = null) and
+ (replace_count(#) = 0)) {an empty |disc_node|}
+ or ((type(#) = math_node) and (width(#) = 0))
+ or ((type(#) = kern_node) and
+ ((width(#) = 0) or (subtype(#) = normal)))
+ or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue))
+ or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and
+ (depth(#) = 0) and (list_ptr(#) = null))
+ )
+)
+
+@<Declare subprocedures for |line_break|@>=
+procedure push_node(p: pointer);
+begin
+ if hlist_stack_level > max_hlist_stack then
+ pdf_error("push_node", "stack overflow");
+ hlist_stack[hlist_stack_level]:=p;
+ hlist_stack_level:=hlist_stack_level + 1;
+end;
+
+function pop_node: pointer;
+begin
+ hlist_stack_level:=hlist_stack_level - 1;
+ if hlist_stack_level < 0 then {would point to some bug}
+ pdf_error("pop_node", "stack underflow (internal error)");
+ pop_node:=hlist_stack[hlist_stack_level];
+end;
+
+function find_protchar_left(l: pointer; d: boolean): pointer;
+{searches left to right from list head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0)
+ and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then
+ l:=link(l) {for paragraph start with \.{\\parindent = 0pt}}
+ else if d then
+ while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do
+ l:=link(l); {std.\ discardables at line break, \TeX book, p 95}
+ hlist_stack_level:=0;
+ run:=true;
+ repeat
+ t:=l;
+ while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin
+ push_node(l);
+ l:=list_ptr(l);
+ end;
+ while run and cp_skipable(l) do begin
+ while (link(l) = null) and (hlist_stack_level > 0) do begin
+ l:=pop_node; {don't visit this node again}
+ end;
+ if link(l) <> null then
+ l:=link(l)
+ else if hlist_stack_level = 0 then run:=false
+ end;
+ until t = l;
+ find_protchar_left:=l;
+end;
+
+function find_protchar_right(l, r: pointer): pointer;
+{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ find_protchar_right:=null;
+ if r = null then return;
+ hlist_stack_level:=0;
+ run:=true;
+ repeat
+ t:=r;
+ while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin
+ push_node(l);
+ push_node(r);
+ l:=list_ptr(r);
+ r:=l;
+ while link(r) <> null do
+ r:=link(r);
+ end;
+ while run and cp_skipable(r) do begin
+ while (r = l) and (hlist_stack_level > 0) do begin
+ r:=pop_node; {don't visit this node again}
+ l:=pop_node;
+ end;
+ if (r <> l) and (r <> null) then
+ r:=prev_rightmost(l, r)
+ else if (r = l) and (hlist_stack_level = 0) then run:=false
+ end;
+ until t = r;
+ find_protchar_right:=r;
+end;
+
+function total_pw(q, p: pointer): scaled;
+{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}
+var l, r: pointer;
+ n: integer;
+begin
+ if break_node(q) = null then
+ l:=first_p
+ else
+ l:=cur_break(break_node(q));
+ r:=prev_rightmost(global_prev_p, p); {get |link(r)=p|}
+ {let's look at the right margin first}
+ if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then
+ {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|}
+ begin
+ r:=pre_break(p);
+ while link(r) <> null do
+ r:=link(r);
+ end else r:=find_protchar_right(l, r);
+ {now the left margin}
+ if (l <> null) and (type(l) = disc_node) then begin
+ if post_break(l) <> null then begin
+ l:=post_break(l); {protrude the first char}
+ goto done;
+ end else {discard |replace_count(l)| nodes}
+ begin
+ n:=replace_count(l);
+ l:=link(l);
+ while n > 0 do begin
+ if link(l) <> null then
+ l:=link(l);
+ decr(n);
+ end;
+ end;
+ end;
+ l:=find_protchar_left(l, true);
+done:
+ total_pw:=left_pw(l) + right_pw(r);
+end;
+procedure try_break(@!pi:integer;@!break_type:small_number);
+label exit,done,done1,continue,deactivate,found,not_found;
+var r:pointer; {runs through the active list}
+@!prev_r:pointer; {stays a step behind |r|}
+@!old_l:halfword; {maximum line number in current equivalence class of lines}
+@!no_break_yet:boolean; {have we found a feasible break at |cur_p|?}
+@<Other local variables for |try_break|@>@;
+begin @<Make sure that |pi| is in the proper range@>;
+no_break_yet:=true; prev_r:=active; old_l:=0;
+do_all_six(copy_to_cur_active);
+loop@+ begin continue: r:=link(prev_r);
+ @<If node |r| is of type |delta_node|, update |cur_active_width|,
+ set |prev_r| and |prev_prev_r|, then |goto continue|@>;
+ @<If a line number class has ended, create new active nodes for
+ the best feasible breaks in that class; then |return|
+ if |r=last_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@>;
+ end;
+exit: @!stat @<Update the value of |printed_node| for
+ symbolic displays@>@+tats@;
+end;
+
+@ @<Other local variables for |try_break|@>=
+@!prev_prev_r:pointer; {a step behind |prev_r|, if |type(prev_r)=delta_node|}
+@!s:pointer; {runs through nodes ahead of |cur_p|}
+@!q:pointer; {points to a new node being created}
+@!v:pointer; {points to a glue specification or a node ahead of |cur_p|}
+@!t:integer; {node count, if |cur_p| is a discretionary node}
+@!f:internal_font_number; {used in character width calculation}
+@!l:halfword; {line number of current active node}
+@!node_r_stays_active:boolean; {should node |r| remain in the active list?}
+@!line_width:scaled; {the current line will be justified to this width}
+@!fit_class:very_loose_fit..tight_fit; {possible fitness class of test line}
+@!b:halfword; {badness of test line}
+@!d:integer; {demerits of test line}
+@!artificial_demerits:boolean; {has |d| been forced to zero?}
+@!save_link:pointer; {temporarily holds value of |link(cur_p)|}
+@!shortfall:scaled; {used in badness calculations}
+
+@ @<Make sure that |pi| is in the proper range@>=
+if abs(pi)>=inf_penalty then
+ if pi>0 then return {this breakpoint is inhibited by infinite penalty}
+ else pi:=eject_penalty {this breakpoint will be forced}
+
+@ The following code uses the fact that |type(last_active)<>delta_node|.
+
+@d update_width(#)==@|
+ cur_active_width[#]:=cur_active_width[#]+mem[r+#].sc
+
+@<If node |r|...@>=
+@^inner loop@>
+if type(r)=delta_node then
+ begin do_all_six(update_width);
+ prev_prev_r:=prev_r; prev_r:=r; goto continue;
+ end
+
+@ 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.
+
+@d awful_bad==@'7777777777 {more than a billion demerits}
+
+@<Global...@>=
+@!minimal_demerits:array[very_loose_fit..tight_fit] of integer; {best total
+ demerits known for current line class and position, given the fitness}
+@!minimum_demerits:integer; {best total demerits known for current line class
+ and position}
+@!best_place:array[very_loose_fit..tight_fit] of pointer; {how to achieve
+ |minimal_demerits|}
+@!best_pl_line:array[very_loose_fit..tight_fit] of halfword; {corresponding
+ line number}
+
+@ @<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;
+
+@ 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=last_active| and
+|line_number(last_active)>old_l|.
+@^inner loop@>
+
+@<If a line number class...@>=
+begin l:=line_number(r);
+if l>old_l then
+ begin {now we are no longer in the inner loop}
+ if (minimum_demerits<awful_bad)and@|
+ ((old_l<>easy_line)or(r=last_active)) then
+ @<Create new active nodes for the best feasible breaks
+ just found@>;
+ if r=last_active then return;
+ @<Compute the new line width@>;
+ end;
+end
+
+@ 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.
+
+@<Create new active nodes...@>=
+begin if no_break_yet then @<Compute the values of |break_width|@>;
+@<Insert a delta node to prepare for breaks at |cur_p|@>;
+if abs(adj_demerits)>=awful_bad-minimum_demerits then
+ minimum_demerits:=awful_bad-1
+else minimum_demerits:=minimum_demerits+abs(adj_demerits);
+for fit_class:=very_loose_fit to tight_fit do
+ begin if minimal_demerits[fit_class]<=minimum_demerits then
+ @<Insert a new active node
+ from |best_place[fit_class]| to |cur_p|@>;
+ minimal_demerits[fit_class]:=awful_bad;
+ end;
+minimum_demerits:=awful_bad;
+@<Insert a delta node to prepare for the next active node@>;
+end
+
+@ 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|
+or |space_adjustment|.
+
+@d set_break_width_to_background(#)==break_width[#]:=background[#]
+
+@<Compute the values of |break...@>=
+begin no_break_yet:=false; do_all_six(set_break_width_to_background);
+s:=cur_p;
+if break_type>unhyphenated then if cur_p<>null then
+ @<Compute the discretionary |break_width| values@>;
+while s<>null do
+ begin if is_char_node(s) then goto done;
+ case type(s) of
+ glue_node:@<Subtract glue from |break_width|@>;
+ penalty_node: do_nothing;
+ math_node: break_width[1]:=break_width[1]-width(s);
+ kern_node: if subtype(s)<>explicit then goto done
+ else break_width[1]:=break_width[1]-width(s);
+ othercases goto done
+ endcases;@/
+ s:=link(s);
+ end;
+done: end
+
+@ @<Subtract glue from |break...@>=
+begin v:=glue_ptr(s); break_width[1]:=break_width[1]-width(v);
+break_width[2+stretch_order(v)]:=break_width[2+stretch_order(v)]-stretch(v);
+break_width[6]:=break_width[6]-shrink(v);
+end
+
+@ When |cur_p| is a discretionary break, the length of a line ``from |cur_p| to
+|cur_p|'' has to be defined properly so that the other calculations work out.
+Suppose that the pre-break text at |cur_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 |cur_p| to |q| will be computed as $\gamma+\beta(q)-\alpha(|cur_p|)$,
+where $\beta(q)=\beta(|cur_p|)-l_0+l$. The actual length will be the background
+plus $l_1$, so the length from |cur_p| to |cur_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.
+
+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|.
+
+@<Glob...@>=
+@!disc_width:scaled; {the length of discretionary material preceding a break}
+
+@ @<Compute the discretionary |break...@>=
+begin t:=replace_count(cur_p); v:=cur_p; s:=post_break(cur_p);
+while t>0 do
+ begin decr(t); v:=link(v);
+ @<Subtract the width of node |v| from |break_width|@>;
+ end;
+while s<>null do
+ begin @<Add the width of node |s| to |break_width|@>;
+ s:=link(s);
+ end;
+break_width[1]:=break_width[1]+disc_width;
+if post_break(cur_p)=null then s:=link(v);
+ {nodes may be discardable after the break}
+end
+
+@ Replacement texts and discretionary texts are supposed to contain
+only character nodes, kern nodes, ligature nodes, and box or rule nodes.
+
+@<Subtract the width of node |v|...@>=
+if is_char_node(v) then
+ begin f:=font(v);
+ break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v)));
+ end
+else case type(v) of
+ ligature_node: begin f:=font(lig_char(v));@/
+ xtx_ligature_present:=true;
+ break_width[1]:=@|break_width[1]-
+ char_width(f)(char_info(f)(character(lig_char(v))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]-width(v);
+ whatsit_node:
+ if (is_native_word_subtype(v))
+ or (subtype(v)=glyph_node)
+ or (subtype(v)=pic_node)
+ or (subtype(v)=pdf_node)
+ then break_width[1]:=break_width[1]-width(v)
+ else confusion("disc1a");
+ othercases confusion("disc1")
+@:this can't happen disc1}{\quad disc1@>
+ endcases
+
+@ @<Add the width of node |s| to |b...@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ break_width[1]:=@|break_width[1]+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
+ break_width[1]:=break_width[1]+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ break_width[1]:=break_width[1]+width(s);
+ whatsit_node:
+ if (is_native_word_subtype(s))
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then break_width[1]:=break_width[1]+width(s)
+ else confusion("disc2a");
+ othercases confusion("disc2")
+@:this can't happen disc2}{\quad disc2@>
+ endcases
+
+@ We use the fact that |type(active)<>delta_node|.
+
+@d convert_to_break_width(#)==@|
+ mem[prev_r+#].sc:=@|@t\hskip10pt@>mem[prev_r+#].sc
+ -cur_active_width[#]+break_width[#]
+@d store_break_width(#)==active_width[#]:=break_width[#]
+@d new_delta_to_break_width(#)==@|
+ mem[q+#].sc:=break_width[#]-cur_active_width[#]
+
+@<Insert a delta node to prepare for breaks at |cur_p|@>=
+if type(prev_r)=delta_node then {modify an existing delta node}
+ begin do_all_six(convert_to_break_width);
+ end
+else if prev_r=active then {no delta node needed at the beginning}
+ begin do_all_six(store_break_width);
+ end
+else begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
+ subtype(q):=0; {the |subtype| is not used}
+ do_all_six(new_delta_to_break_width);
+ link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
+ end
+
+@ When the following code is performed, we will have just inserted at
+least one active node before |r|, so |type(prev_r)<>delta_node|.
+
+@d new_delta_from_break_width(#)==@|mem[q+#].sc:=
+ cur_active_width[#]-break_width[#]
+
+@<Insert a delta node to prepare for the next active node@>=
+if r<>last_active then
+ begin q:=get_node(delta_node_size); link(q):=r; type(q):=delta_node;@/
+ subtype(q):=0; {the |subtype| is not used}
+ do_all_six(new_delta_from_break_width);
+ link(prev_r):=q; prev_prev_r:=prev_r; prev_r:=q;
+ end
+
+@ When we create an active node, we also create the corresponding
+passive node.
+
+@<Insert a new active node from |best_place[fit_class]| to |cur_p|@>=
+begin q:=get_node(passive_node_size);
+link(q):=passive; passive:=q; cur_break(q):=cur_p;
+@!stat incr(pass_number); serial(q):=pass_number;@+tats@;@/
+prev_break(q):=best_place[fit_class];@/
+q:=get_node(active_node_size); break_node(q):=passive;
+line_number(q):=best_pl_line[fit_class]+1;
+fitness(q):=fit_class; type(q):=break_type;
+total_demerits(q):=minimal_demerits[fit_class];
+if do_last_line_fit then
+ @<Store \(a)additional data in the new active node@>;
+link(q):=r; link(prev_r):=q; prev_r:=q;
+@!stat if tracing_paragraphs>0 then
+ @<Print a symbolic description of the new break node@>;
+tats@;@/
+end
+
+@ @<Print a symbolic description of the new break node@>=
+begin print_nl("@@@@"); print_int(serial(passive));
+@.\AT!\AT!@>
+print(": line "); print_int(line_number(q)-1);
+print_char("."); print_int(fit_class);
+if break_type=hyphenated then print_char("-");
+print(" t="); print_int(total_demerits(q));
+if do_last_line_fit then @<Print additional data in the new active node@>;
+print(" -> @@@@");
+if prev_break(passive)=null then print_char("0")
+else print_int(serial(prev_break(passive)));
+end
+
+@ 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 |info| 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@>
+
+@<Glob...@>=
+@!easy_line:halfword; {line numbers |>easy_line| are equivalent in break nodes}
+@!last_special_line:halfword; {line numbers |>last_special_line| all have
+ the same width}
+@!first_width:scaled; {the width of all lines |<=last_special_line|, if
+ no \.{\\parshape} has been specified}
+@!second_width:scaled; {the width of all lines |>last_special_line|}
+@!first_indent:scaled; {left margin to go with |first_width|}
+@!second_indent:scaled; {left margin to go with |second_width|}
+
+@ We compute the values of |easy_line| and the other local variables relating
+to line length when the |line_break| procedure is initializing itself.
+
+@<Get ready to start...@>=
+if par_shape_ptr=null then
+ if hang_indent=0 then
+ begin last_special_line:=0; second_width:=hsize;
+ second_indent:=0;
+ end
+ else @<Set line length parameters in preparation for hanging indentation@>
+else begin last_special_line:=info(par_shape_ptr)-1;
+ second_width:=mem[par_shape_ptr+2*(last_special_line+1)].sc;
+ second_indent:=mem[par_shape_ptr+2*last_special_line+1].sc;
+ end;
+if looseness=0 then easy_line:=last_special_line
+else easy_line:=max_halfword
+
+@ @<Set line length parameters in preparation for hanging indentation@>=
+begin last_special_line:=abs(hang_after);
+if hang_after<0 then
+ begin first_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then first_indent:=hang_indent
+ else first_indent:=0;
+ second_width:=hsize; second_indent:=0;
+ end
+else begin first_width:=hsize; first_indent:=0;
+ second_width:=hsize-abs(hang_indent);
+ if hang_indent>=0 then second_indent:=hang_indent
+ else second_indent:=0;
+ end;
+end
+
+@ 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|.
+
+@<Compute the new line width@>=
+if l>easy_line then
+ begin line_width:=second_width; old_l:=max_halfword-1;
+ end
+else begin old_l:=l;
+ if l>last_special_line then line_width:=second_width
+ else if par_shape_ptr=null then line_width:=first_width
+ else line_width:=mem[par_shape_ptr+2*l@,].sc;
+ end
+
+@ The remaining part of |try_break| deals with the calculation of
+demerits for a break from |r| to |cur_p|.
+
+The first thing to do is calculate the badness, |b|. This value will always
+be between zero and |inf_bad+1|; the latter value occurs only in the
+case of lines from |r| to |cur_p| that cannot shrink enough to fit the necessary
+width. In such cases, node |r| will be deactivated.
+We also deactivate node~|r| when a break at~|cur_p| is forced, since future
+breaks must go through a forced break.
+
+@<Consider the demerits for a line from |r| to |cur_p|...@>=
+begin artificial_demerits:=false;@/
+@^inner loop@>
+shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if XeTeX_protrude_chars > 1 then
+ shortfall:=shortfall + total_pw(r, cur_p);
+if shortfall>0 then
+ @<Set the value of |b| to the badness for stretching the line,
+ and compute the corresponding |fit_class|@>
+else @<Set the value of |b| to the badness for shrinking the line,
+ and compute the corresponding |fit_class|@>;
+if do_last_line_fit then @<Adjust \(t)the additional data for last line@>;
+found:
+if (b>inf_bad)or(pi=eject_penalty) then
+ @<Prepare to deactivate node~|r|, and |goto deactivate| unless
+ there is a reason to consider lines of text from |r| to |cur_p|@>
+else begin prev_r:=r;
+ if b>threshold then goto continue;
+ node_r_stays_active:=true;
+ end;
+@<Record a new feasible break@>;
+if node_r_stays_active then goto continue; {|prev_r| has been set to |r|}
+deactivate: @<Deactivate node |r|@>;
+end
+
+@ When a line must stretch, the available stretchability can be found in the
+subarray |cur_active_width[2..5]|, in units of points, 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@>
+
+@<Set the value of |b| to the badness for stretching...@>=
+if (cur_active_width[3]<>0)or(cur_active_width[4]<>0)or@|
+ (cur_active_width[5]<>0) then
+ begin if do_last_line_fit then
+ begin if cur_p=null then {the last line of a paragraph}
+ @<Perform computations for last line and |goto found|@>;
+ shortfall:=0;
+ end;
+ b:=0; fit_class:=decent_fit; {infinite stretch}
+ end
+else begin if shortfall>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto done1;
+ end;
+ b:=badness(shortfall,cur_active_width[2]);
+ if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+ else fit_class:=decent_fit;
+ done1:
+ end
+
+@ Shrinkability is never infinite in a paragraph;
+we can shrink the line from |r| to |cur_p| by at most |cur_active_width[6]|.
+
+@<Set the value of |b| to the badness for shrinking...@>=
+begin if -shortfall>cur_active_width[6] then b:=inf_bad+1
+else b:=badness(-shortfall,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+end
+
+@ 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@>
+
+@<Prepare to deactivate node~|r|, and |goto deactivate| unless...@>=
+begin if final_pass and (minimum_demerits=awful_bad) and@|
+ (link(r)=last_active) and
+ (prev_r=active) then
+ artificial_demerits:=true {set demerits zero, this break is forced}
+else if b>threshold then goto deactivate;
+node_r_stays_active:=false;
+end
+
+@ 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.
+
+@<Record a new feasible break@>=
+if artificial_demerits then d:=0
+else @<Compute the demerits, |d|, from |r| to |cur_p|@>;
+@!stat if tracing_paragraphs>0 then
+ @<Print a symbolic description of this feasible break@>;
+tats@;@/
+d:=d+total_demerits(r); {this is the minimum total demerits
+ from the beginning to |cur_p| via |r|}
+if d<=minimal_demerits[fit_class] then
+ begin minimal_demerits[fit_class]:=d;
+ best_place[fit_class]:=break_node(r); best_pl_line[fit_class]:=l;
+ if do_last_line_fit then
+ @<Store \(a)additional data for this feasible break@>;
+ if d<minimum_demerits then minimum_demerits:=d;
+ end
+
+@ @<Print a symbolic description of this feasible break@>=
+begin if printed_node<>cur_p then
+ @<Print the list between |printed_node| and |cur_p|,
+ then set |printed_node:=cur_p|@>;
+print_nl("@@");
+@.\AT!@>
+if cur_p=null then print_esc("par")
+else if type(cur_p)<>glue_node then
+ begin if type(cur_p)=penalty_node then print_esc("penalty")
+ else if type(cur_p)=disc_node then print_esc("discretionary")
+ else if type(cur_p)=kern_node then print_esc("kern")
+ else print_esc("math");
+ end;
+print(" via @@@@");
+if break_node(r)=null then print_char("0")
+else print_int(serial(break_node(r)));
+print(" b=");
+if b>inf_bad then print_char("*")@+else print_int(b);
+@.*\relax@>
+print(" p="); print_int(pi); print(" d=");
+if artificial_demerits then print_char("*")@+else print_int(d);
+end
+
+@ @<Print the list between |printed_node| and |cur_p|...@>=
+begin print_nl("");
+if cur_p=null then short_display(link(printed_node))
+else begin save_link:=link(cur_p);
+ link(cur_p):=null; print_nl(""); short_display(link(printed_node));
+ link(cur_p):=save_link;
+ end;
+printed_node:=cur_p;
+end
+
+@ When the data for a discretionary break is being displayed, we will have
+printed the |pre_break| and |post_break| lists; we want to skip over the
+third list, so that the discretionary data will not appear twice. The
+following code is performed at the very end of |try_break|.
+
+@<Update the value of |printed_node|...@>=
+if cur_p=printed_node then if cur_p<>null then if type(cur_p)=disc_node then
+ begin t:=replace_count(cur_p);
+ while t>0 do
+ begin decr(t); printed_node:=link(printed_node);
+ end;
+ end
+
+@ @<Compute the demerits, |d|, from |r| to |cur_p|@>=
+begin d:=line_penalty+b;
+if abs(d)>=10000 then d:=100000000@+else d:=d*d;
+if pi<>0 then
+ if pi>0 then d:=d+pi*pi
+ else if pi>eject_penalty then d:=d-pi*pi;
+if (break_type=hyphenated)and(type(r)=hyphenated) then
+ if cur_p<>null then d:=d+double_hyphen_demerits
+ else d:=d+final_hyphen_demerits;
+if abs(fit_class-fitness(r))>1 then d:=d+adj_demerits;
+end
+
+@ 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 |link(prev_r)|
+to~|cur_p|.
+
+@d combine_two_deltas(#)==@|mem[prev_r+#].sc:=mem[prev_r+#].sc+mem[r+#].sc
+@d downdate_width(#)==@|cur_active_width[#]:=cur_active_width[#]-
+ mem[prev_r+#].sc
+
+@<Deactivate node |r|@>=
+link(prev_r):=link(r); free_node(r,active_node_size);
+if prev_r=active then @<Update the active widths, since the first active
+ node has been deleted@>
+else if type(prev_r)=delta_node then
+ begin r:=link(prev_r);
+ if r=last_active then
+ begin do_all_six(downdate_width);
+ link(prev_prev_r):=last_active;
+ free_node(prev_r,delta_node_size); prev_r:=prev_prev_r;
+ end
+ else if type(r)=delta_node then
+ begin do_all_six(update_width);
+ do_all_six(combine_two_deltas);
+ link(prev_r):=link(r); free_node(r,delta_node_size);
+ end;
+ end
+
+@ The following code uses the fact that |type(last_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.
+
+@d update_active(#)==active_width[#]:=active_width[#]+mem[r+#].sc
+
+@<Update the active widths,...@>=
+begin r:=link(active);
+if type(r)=delta_node then
+ begin do_all_six(update_active);
+ do_all_six(copy_to_cur_active);
+ link(active):=link(r); free_node(r,delta_node_size);
+ end;
+end
+
+@* \[39] Breaking paragraphs into lines, continued.
+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 |link(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.
+
+The following declarations provide for a few other local variables that are
+used in special calculations.
+
+@<Local variables for line breaking@>=
+@!auto_breaking:boolean; {is node |cur_p| outside a formula?}
+@!prev_p:pointer; {helps to determine when glue nodes are breakpoints}
+@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest}
+@!f:internal_font_number; {used when calculating character widths}
+
+@ The `\ignorespaces|loop|\unskip' in the following code is performed at most
+thrice per call of |line_break|, since it is actually a pass over the
+entire paragraph.
+
+@d update_prev_p == begin
+ prev_p:=cur_p;
+ global_prev_p:=cur_p;
+end
+
+@<Find optimal breakpoints@>=
+threshold:=pretolerance;
+if threshold>=0 then
+ begin @!stat if tracing_paragraphs>0 then
+ begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/
+ second_pass:=false; final_pass:=false;
+ end
+else begin threshold:=tolerance; second_pass:=true;
+ final_pass:=(emergency_stretch<=0);
+ @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
+ end;
+loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
+ if second_pass then @<Initialize for hyphenating a paragraph@>;
+ @<Create an active breakpoint representing the beginning of the paragraph@>;
+ cur_p:=link(temp_head); auto_breaking:=true;@/
+ update_prev_p; {glue at beginning is not a legal breakpoint}
+ first_p:=cur_p; {to access the first node of paragraph as the first active
+ node has |break_node=null|}
+ while (cur_p<>null)and(link(active)<>last_active) do
+ @<Call |try_break| if |cur_p| is a legal breakpoint;
+ on the second pass, also try to hyphenate the next
+ word, if |cur_p| is a glue node;
+ then advance |cur_p| to the next node of the paragraph
+ that could possibly be a legal breakpoint@>;
+ if cur_p=null then
+ @<Try the final line break at the end of the paragraph,
+ and |goto done| if the desired breakpoints have been found@>;
+ @<Clean up the memory by removing the break nodes@>;
+ if not second_pass then
+ begin@!stat if tracing_paragraphs>0 then print_nl("@@secondpass");@;@+tats@/
+ threshold:=tolerance; second_pass:=true; final_pass:=(emergency_stretch<=0);
+ end {if at first you don't succeed, \dots}
+ else begin @!stat if tracing_paragraphs>0 then
+ print_nl("@@emergencypass");@;@+tats@/
+ background[2]:=background[2]+emergency_stretch; final_pass:=true;
+ end;
+ end;
+done: @!stat if tracing_paragraphs>0 then
+ begin end_diagnostic(true); normalize_selector;
+ end;@+tats@/
+if do_last_line_fit then @<Adjust \(t)the final line of the paragraph@>;
+
+@ The active node that represents the starting point does not need a
+corresponding passive node.
+
+@d store_background(#)==active_width[#]:=background[#]
+
+@<Create an active breakpoint representing the beginning of the paragraph@>=
+q:=get_node(active_node_size);
+type(q):=unhyphenated; fitness(q):=decent_fit;
+link(q):=last_active; break_node(q):=null;
+line_number(q):=prev_graf+1; total_demerits(q):=0; link(active):=q;
+if do_last_line_fit then
+ @<Initialize additional fields of the first active node@>;
+do_all_six(store_background);@/
+passive:=null; printed_node:=temp_head; pass_number:=0;
+font_in_short_display:=null_font
+
+@ @<Clean...@>=
+q:=link(active);
+while q<>last_active do
+ begin cur_p:=link(q);
+ if type(q)=delta_node then free_node(q,delta_node_size)
+ else free_node(q,active_node_size);
+ q:=cur_p;
+ end;
+q:=passive;
+while q<>null do
+ begin cur_p:=link(q);
+ free_node(q,passive_node_size);
+ q:=cur_p;
+ end
+
+@ Here is the main switch in the |line_break| routine, where legal breaks
+are determined. 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.
+
+@d act_width==active_width[1] {length from first active node to current node}
+@d kern_break==begin if not is_char_node(link(cur_p)) and auto_breaking then
+ if type(link(cur_p))=glue_node then try_break(0,unhyphenated);
+ act_width:=act_width+width(cur_p);
+ end
+
+@<Call |try_break| if |cur_p| is a legal breakpoint...@>=
+begin if is_char_node(cur_p) then
+ @<Advance \(c)|cur_p| to the node following the present
+ string of characters@>;
+case type(cur_p) of
+hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p);
+whatsit_node: @<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>;
+glue_node: begin @<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)|@>;
+ if second_pass and auto_breaking then
+ @<Try to hyphenate the following word@>;
+ end;
+kern_node: if subtype(cur_p)=explicit then kern_break
+ else act_width:=act_width+width(cur_p);
+ligature_node: begin f:=font(lig_char(cur_p));
+ xtx_ligature_present:=true;
+ act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
+ end;
+disc_node: @<Try to break after a discretionary fragment, then |goto done5|@>;
+math_node: begin if subtype(cur_p)<L_code then auto_breaking:=odd(subtype(cur_p));
+ kern_break;
+ end;
+penalty_node: try_break(penalty(cur_p),unhyphenated);
+mark_node,ins_node,adjust_node: do_nothing;
+othercases confusion("paragraph")
+@:this can't happen paragraph}{\quad paragraph@>
+endcases;@/
+update_prev_p; cur_p:=link(cur_p);
+done5:end
+
+@ 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 |link(cur_p)=null| when |cur_p| is a
+character node.
+@^inner loop@>
+
+@<Advance \(c)|cur_p| to the node following the present string...@>=
+begin update_prev_p;
+repeat f:=font(cur_p);
+act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
+cur_p:=link(cur_p);
+until not is_char_node(cur_p);
+end
+
+@ When node |cur_p| is a glue node, we look at |prev_p| to see whether or not
+a breakpoint is legal at |cur_p|, as explained above.
+
+@<If node |cur_p| is a legal breakpoint, call...@>=
+if auto_breaking then
+ begin if is_char_node(prev_p) then try_break(0,unhyphenated)
+ else if precedes_break(prev_p) then try_break(0,unhyphenated)
+ else if (type(prev_p)=kern_node)and(subtype(prev_p)<>explicit) then
+ try_break(0,unhyphenated);
+ end;
+check_shrinkage(glue_ptr(cur_p)); q:=glue_ptr(cur_p);
+act_width:=act_width+width(q);@|
+active_width[2+stretch_order(q)]:=@|
+ active_width[2+stretch_order(q)]+stretch(q);@/
+active_width[6]:=active_width[6]+shrink(q)
+
+@ The following code knows that discretionary texts contain
+only character nodes, kern nodes, box nodes, rule nodes, and ligature nodes.
+
+@<Try to break after a discretionary fragment...@>=
+begin s:=pre_break(cur_p); disc_width:=0;
+if s=null then try_break(ex_hyphen_penalty,hyphenated)
+else begin repeat @<Add the width of node |s| to |disc_width|@>;
+ s:=link(s);
+ until s=null;
+ act_width:=act_width+disc_width;
+ try_break(hyphen_penalty,hyphenated);
+ act_width:=act_width-disc_width;
+ end;
+r:=replace_count(cur_p); s:=link(cur_p);
+while r>0 do
+ begin @<Add the width of node |s| to |act_width|@>;
+ decr(r); s:=link(s);
+ end;
+update_prev_p; cur_p:=s; goto done5;
+end
+
+@ @<Add the width of node |s| to |disc_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ disc_width:=disc_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
+ disc_width:=disc_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ disc_width:=disc_width+width(s);
+ whatsit_node:
+ if (is_native_word_subtype(s))
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then disc_width:=disc_width+width(s)
+ else confusion("disc3a");
+ othercases confusion("disc3")
+@:this can't happen disc3}{\quad disc3@>
+ endcases
+
+@ @<Add the width of node |s| to |act_width|@>=
+if is_char_node(s) then
+ begin f:=font(s);
+ act_width:=act_width+char_width(f)(char_info(f)(character(s)));
+ end
+else case type(s) of
+ ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
+ act_width:=act_width+
+ char_width(f)(char_info(f)(character(lig_char(s))));
+ end;
+ hlist_node,vlist_node,rule_node,kern_node:
+ act_width:=act_width+width(s);
+ whatsit_node:
+ if (is_native_word_subtype(s))
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then act_width:=act_width+width(s)
+ else confusion("disc4a");
+ othercases confusion("disc4")
+@:this can't happen disc4}{\quad disc4@>
+ endcases
+
+@ 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.
+
+@<Glob...@>=
+@!best_bet:pointer; {use this passive node and its predecessors}
+@!fewest_demerits:integer; {the demerits associated with |best_bet|}
+@!best_line:halfword; {line number following the last line of the new paragraph}
+@!actual_looseness:integer; {the difference between |line_number(best_bet)|
+ and the optimum |best_line|}
+@!line_diff:integer; {the difference between the current line number and
+ the optimum |best_line|}
+
+@ @<Try the final line break at the end of the paragraph...@>=
+begin try_break(eject_penalty,hyphenated);
+if link(active)<>last_active then
+ begin @<Find an active node with fewest demerits@>;
+ if looseness=0 then goto done;
+ @<Find the best active node for the desired looseness@>;
+ if (actual_looseness=looseness)or final_pass then goto done;
+ end;
+end
+
+@ @<Find an active node...@>=
+r:=link(active); fewest_demerits:=awful_bad;
+repeat if type(r)<>delta_node then if total_demerits(r)<fewest_demerits then
+ begin fewest_demerits:=total_demerits(r); best_bet:=r;
+ end;
+r:=link(r);
+until r=last_active;
+best_line:=line_number(best_bet)
+
+@ 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.
+
+@<Find the best active node...@>=
+begin r:=link(active); actual_looseness:=0;
+repeat if type(r)<>delta_node then
+ begin line_diff:=line_number(r)-best_line;
+ if ((line_diff<actual_looseness)and(looseness<=line_diff))or@|
+ ((line_diff>actual_looseness)and(looseness>=line_diff)) then
+ begin best_bet:=r; actual_looseness:=line_diff;
+ fewest_demerits:=total_demerits(r);
+ end
+ else if (line_diff=actual_looseness)and@|
+ (total_demerits(r)<fewest_demerits) then
+ begin best_bet:=r; fewest_demerits:=total_demerits(r);
+ end;
+ end;
+r:=link(r);
+until r=last_active;
+best_line:=line_number(best_bet);
+end
+
+@ 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.)
+
+@<Break the paragraph at the chosen...@>=
+post_line_break(d)
+
+@ 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.
+
+@d next_break==prev_break {new name for |prev_break| after links are reversed}
+
+@<Declare subprocedures for |line_break|@>=
+procedure post_line_break(@!d:boolean);
+label done,done1;
+var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+ p, k: pointer;
+ w: scaled;
+ glue_break: boolean; {was a break at glue?}
+ ptmp: pointer;
+@!disc_break:boolean; {was the current break at a discretionary node?}
+@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
+@!cur_width:scaled; {width of line number |cur_line|}
+@!cur_indent:scaled; {left margin of line number |cur_line|}
+@!t:quarterword; {used for replacement counts in discretionary nodes}
+@!pen:integer; {use when calculating penalties between lines}
+@!cur_line: halfword; {the current line number being justified}
+@!LR_ptr:pointer; {stack of LR codes}
+begin LR_ptr:=LR_save;
+@<Reverse the links of the relevant passive nodes, setting |cur_p| to the
+ first breakpoint@>;
+cur_line:=prev_graf+1;
+repeat @<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 then if not post_disc_break then
+ @<Prune unwanted nodes at the beginning of the next line@>;
+until cur_p=null;
+if (cur_line<>best_line)or(link(temp_head)<>null) then
+ confusion("line breaking");
+@:this can't happen line breaking}{\quad line breaking@>
+prev_graf:=best_line-1;
+LR_save:=LR_ptr;
+end;
+
+@ 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.
+
+@<Reverse the links of the relevant passive nodes...@>=
+q:=break_node(best_bet); cur_p:=null;
+repeat r:=q; q:=prev_break(q); next_break(r):=cur_p; cur_p:=r;
+until q=null
+
+@ 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.
+
+@<Prune unwanted nodes at the beginning of the next line@>=
+begin r:=temp_head;
+loop@+ begin q:=link(r);
+ if q=cur_break(cur_p) then goto done1;
+ {|cur_break(cur_p)| is the next breakpoint}
+ {now |q| cannot be |null|}
+ if is_char_node(q) then goto done1;
+ if non_discardable(q) then goto done1;
+ if type(q)=kern_node then if (subtype(q)<>explicit) and (subtype(q)<>space_adjustment) then goto done1;
+ r:=q; {now |type(q)=glue_node|, |kern_node|, |math_node|, or |penalty_node|}
+ if type(q)=math_node then if TeXXeT_en then
+ @<Adjust \(t)the LR stack for the |post_line_break| routine@>;
+ end;
+done1: if r<>temp_head then
+ begin link(r):=null; flush_node_list(link(temp_head));
+ link(temp_head):=q;
+ end;
+end
+
+@ The current line to be justified appears in a horizontal list starting
+at |link(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.
+
+@<Justify the line ending at breakpoint |cur_p|, and append it...@>=
+if TeXXeT_en then
+ @<Insert LR nodes at the beginning of the current line and adjust
+ the LR stack based on LR nodes in this line@>;
+@<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|@>;
+if TeXXeT_en then @<Insert LR nodes at the end of the current line@>;
+@<Put the \(l)\.{\\leftskip} glue at the left and detach this line@>;
+@<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@>;
+@<Append a penalty node, if a nonzero penalty is appropriate@>
+
+@ At the end of the following code, |q| will point to the final node on the
+list about to be justified.
+
+@<Modify the end of the line...@>=
+q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+glue_break:=false;
+if q<>null then {|q| cannot be a |char_node|}
+ if type(q)=glue_node then
+ begin delete_glue_ref(glue_ptr(q));
+ glue_ptr(q):=right_skip;
+ subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ glue_break:=true;
+ goto done;
+ end
+ else begin if type(q)=disc_node then
+ @<Change discretionary to compulsory and set
+ |disc_break:=true|@>
+ else if type(q)=kern_node then width(q):=0
+ else if type(q)=math_node then
+ begin width(q):=0;
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
+ end;
+ end
+else begin q:=temp_head;
+ while link(q)<>null do q:=link(q);
+ end;
+done:
+{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 XeTeX_protrude_chars > 0 then begin
+ if disc_break and (is_char_node(q) or (type(q) <> disc_node))
+ {|q| has been reset to the last node of |pre_break|}
+ then begin
+ p:=q;
+ ptmp:=p;
+ end else begin
+ p:=prev_rightmost(link(temp_head), q); {get |link(p) = q|}
+ ptmp:=p;
+ p:=find_protchar_right(link(temp_head), p);
+ end;
+ w:=right_pw(p);
+ if w <> 0 then {we have found a marginal kern, append it after |ptmp|}
+ begin
+ k:=new_margin_kern(-w, last_rightmost_char, right_side);
+ link(k):=link(ptmp);
+ link(ptmp):=k;
+ if (ptmp = q) then
+ q:=link(q);
+ end;
+end;
+{if |q| was not a breakpoint at glue and has been reset to |rightskip| then
+ we append |rightskip| after |q| now}
+if not glue_break then begin
+ @<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+end;
+
+@ @<Change discretionary to compulsory...@>=
+begin t:=replace_count(q);
+@<Destroy the |t| nodes following |q|, and
+ make |r| point to the following node@>;
+if post_break(q)<>null then @<Transplant the post-break list@>;
+if pre_break(q)<>null then @<Transplant the pre-break list@>;
+link(q):=r; disc_break:=true;
+end
+
+@ @<Destroy the |t| nodes following |q|...@>=
+if t=0 then r:=link(q)
+else begin r:=q;
+ while t>1 do
+ begin r:=link(r); decr(t);
+ end;
+ s:=link(r);
+ r:=link(s); link(s):=null;
+ flush_node_list(link(q)); replace_count(q):=0;
+ end
+
+@ We move the post-break list from inside node |q| to the main list by
+re\-attaching it just before the present node |r|, then resetting |r|.
+
+@<Transplant the post-break list@>=
+begin s:=post_break(q);
+while link(s)<>null do s:=link(s);
+link(s):=r; r:=post_break(q); post_break(q):=null; post_disc_break:=true;
+end
+
+@ We move the pre-break list from inside node |q| to the main list by
+re\-attaching it just after the present node |q|, then resetting |q|.
+
+@<Transplant the pre-break list@>=
+begin s:=pre_break(q); link(q):=s;
+while link(s)<>null do s:=link(s);
+pre_break(q):=null; q:=s;
+end
+
+@ @<Put the \(r)\.{\\rightskip} glue after node |q|@>=
+r:=new_param_glue(right_skip_code); link(r):=link(q); link(q):=r; q:=r
+
+@ 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
+|link(temp_head)| pointing to the remainder of the paragraph, if any.
+
+@<Put the \(l)\.{\\leftskip} glue at the left...@>=
+r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+{at this point |q| is the leftmost node; all discardable nodes have been discarded}
+if XeTeX_protrude_chars > 0 then begin
+ p:=q;
+ p:=find_protchar_left(p, false); {no more discardables}
+ w:=left_pw(p);
+ if w <> 0 then begin
+ k:=new_margin_kern(-w, last_leftmost_char, left_side);
+ link(k):=q;
+ q:=k;
+ end;
+end;
+if left_skip<>zero_glue then
+ begin r:=new_param_glue(left_skip_code);
+ link(r):=q; q:=r;
+ end
+
+@ @<Append the new box to the current vertical list...@>=
+if pre_adjust_head <> pre_adjust_tail then
+ append_list(pre_adjust_head)(pre_adjust_tail);
+pre_adjust_tail:=null;
+append_to_vlist(just_box);
+if adjust_head <> adjust_tail then
+ append_list(adjust_head)(adjust_tail);
+adjust_tail:=null
+
+@ 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.
+
+@<Call the packaging subroutine...@>=
+if cur_line>last_special_line then
+ begin cur_width:=second_width; cur_indent:=second_indent;
+ end
+else if par_shape_ptr=null then
+ begin cur_width:=first_width; cur_indent:=first_indent;
+ end
+else begin cur_width:=mem[par_shape_ptr+2*cur_line].sc;
+ cur_indent:=mem[par_shape_ptr+2*cur_line-1].sc;
+ end;
+adjust_tail:=adjust_head;
+pre_adjust_tail:=pre_adjust_head;
+just_box:=hpack(q,cur_width,exactly);
+shift_amount(just_box):=cur_indent
+
+@ 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.
+
+@<Append a penalty node, if a nonzero penalty is appropriate@>=
+if cur_line+1<>best_line then
+ begin q:=inter_line_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=penalty(q+r);
+ end
+ else pen:=inter_line_penalty;
+ q:=club_penalties_ptr;
+ if q<>null then
+ begin r:=cur_line-prev_graf;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line=prev_graf+1 then pen:=pen+club_penalty;
+ if d then q:=display_widow_penalties_ptr
+ else q:=widow_penalties_ptr;
+ if q<>null then
+ begin r:=best_line-cur_line-1;
+ if r>penalty(q) then r:=penalty(q);
+ pen:=pen+penalty(q+r);
+ end
+ else if cur_line+2=best_line then
+ if d then pen:=pen+display_widow_penalty
+ else pen:=pen+widow_penalty;
+ if disc_break then pen:=pen+broken_penalty;
+ if pen<>0 then
+ begin r:=new_penalty(pen);
+ link(tail):=r; tail:=r;
+ end;
+ end
+
+@* \[40] Pre-hyphenation.
+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 or text direction 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 |max_hyphenatable_length+1|, so a character that would
+otherwise be $c_{|max_hyphenatable_length|+1}$ 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.
+
+@<Initialize for hyphenating...@>=
+begin @!init if trie_not_ready then init_trie;@+tini@;@/
+cur_lang:=init_cur_lang; l_hyf:=init_l_hyf; r_hyf:=init_r_hyf;
+set_hyph_index;
+end
+
+@ The letters $c_1\ldots c_n$ that are candidates for hyphenation are placed
+into an array called |hc|; the number |n| is placed into |hn|; pointers to
+nodes $p_{a-1}$ and~$p_b$ in the description above are placed into variables
+|ha| and |hb|; and the font number is placed into |hf|.
+
+@<Glob...@>=
+@!hc:array[0..hyphenatable_length_limit+3] of 0..number_usvs; {word to be hyphenated}
+{ note that element 0 needs to be a full UnicodeScalar, even though we
+ basically work in UTF16 }
+@!hn:small_number; {the number of positions occupied in |hc|, 0..64 in TeX}
+@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
+@!hf:internal_font_number; {font number of the letters in |hc|}
+@!hu:array[0..hyphenatable_length_limit+1] of 0..too_big_char;
+ {like |hc|, before conversion to lowercase}
+@!hyf_char:integer; {hyphen character of the relevant font}
+@!cur_lang,@!init_cur_lang:0..biggest_lang;
+ {current hyphenation table of interest}
+@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
+@!hyf_bchar:halfword; {boundary character after $c_n$}
+@!max_hyph_char:integer;
+
+@ @<Set initial values of key variables@>=
+max_hyph_char:=too_big_lang;
+
+@ Hyphenation routines need a few more local variables.
+
+@<Local variables for line...@>=
+@!j:small_number; {an index into |hc| or |hu|}
+@!c:UnicodeScalar; {character being considered for hyphenation}
+
+@ When the following code is activated, the |line_break| procedure is in its
+second pass, and |cur_p| points to a glue node.
+
+@<Try to hyphenate...@>=
+begin prev_s:=cur_p; s:=link(prev_s);
+if s<>null then
+ begin @<Skip to node |ha|, or |goto done1| if no hyphenation
+ should be attempted@>;
+ if l_hyf+r_hyf>max_hyphenatable_length then goto done1;
+if is_native_word_node(ha) then begin
+ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>;
+ @<Prepare a |native_word_node| for hyphenation@>;
+end else begin
+ @<Skip to node |hb|, putting letters into |hu| and |hc|@>;
+end;
+ @<Check that the nodes following |hb| permit hyphenation and that at least
+ |l_hyf+r_hyf| letters have been found, otherwise |goto done1|@>;
+ hyphenate;
+ end;
+done1: end
+
+@ @<Declare subprocedures for |line_break|@>=
+@t\4@>@<Declare the function called |reconstitute|@>
+procedure hyphenate;
+label common_ending,done,found,found1,found2,not_found,exit;
+var @<Local variables for hyphenation@>@;
+begin @<Find hyphen locations for the word in |hc|, or |return|@>;
+@<If no hyphens were found, |return|@>;
+@<Replace nodes |ha..hb| by a sequence of nodes that includes
+ the discretionary hyphens@>;
+exit:end;
+
+function max_hyphenatable_length: integer;
+begin
+ if XeTeX_hyphenatable_length>hyphenatable_length_limit then
+ max_hyphenatable_length:=hyphenatable_length_limit
+ else
+ max_hyphenatable_length:=XeTeX_hyphenatable_length;
+end;
+
+@ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>=
+s:=link(ha);
+loop@+ begin if not(is_char_node(s)) then
+ case type(s) of
+ ligature_node: do_nothing;
+ kern_node: if subtype(s)<>normal then goto done6;
+ whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
+ goto done6;
+ othercases goto done1
+ endcases;
+ s:=link(s);
+ end;
+done6:
+
+@ @<Prepare a |native_word_node| for hyphenation@>=
+{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes }
+hn:=0;
+restart:
+for l:=0 to native_length(ha)-1 do begin
+ c:=get_native_usv(ha, l);
+ set_lc_code(c);
+ if (hc[0] = 0) then begin
+ if (hn > 0) then begin
+ { we've got some letters, and now found a non-letter, so break off the tail of the |native_word|
+ and link it after this node, and goto done3 }
+ @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
+ goto done3;
+ end
+ end else if (hn = 0) and (l > 0) then begin
+ { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart }
+ @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
+ ha:=link(ha);
+ goto restart;
+ end else if (hn = max_hyphenatable_length) then
+ { reached max hyphenatable length }
+ goto done3
+ else begin
+ { found a letter that is part of a potentially hyphenatable sequence }
+ incr(hn);
+ if c<@"10000 then begin
+ hu[hn]:=c; hc[hn]:=hc[0];
+ end
+ else begin
+ hu[hn]:=(c - @"10000) div @"400 + @"D800;
+ hc[hn]:=(hc[0] - @"10000) div @"400 + @"D800;
+ incr(hn);
+ hu[hn]:=c mod @"400 + @"DC00;
+ hc[hn]:=hc[0] mod @"400 + @"DC00;
+ incr(l);
+ end;
+ hyf_bchar:=non_char;
+ end
+end;
+
+@ @<Split the |native_word_node| at |l| and link the second part after |ha|@>=
+ q:=new_native_word_node(hf, native_length(ha) - l);
+ subtype(q):=subtype(ha);
+ for i:=l to native_length(ha) - 1 do
+ set_native_char(q, i - l, get_native_char(ha, i));
+ set_native_metrics(q, XeTeX_use_glyph_metrics);
+ link(q):=link(ha);
+ link(ha):=q;
+ { truncate text in node |ha| }
+ native_length(ha):=l;
+ set_native_metrics(ha, XeTeX_use_glyph_metrics);
+
+@ @<Local variables for line breaking@>=
+l: integer;
+i: integer;
+
+@ The first thing we need to do is find the node |ha| just before the
+first letter.
+
+@<Skip to node |ha|, or |goto done1|...@>=
+loop@+ begin if is_char_node(s) then
+ begin c:=qo(character(s)); hf:=font(s);
+ end
+ else if type(s)=ligature_node then
+ if lig_ptr(s)=null then goto continue
+ else begin q:=lig_ptr(s); c:=qo(character(q)); hf:=font(q);
+ end
+ else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
+ else if (type(s)=math_node)and(subtype(s)>=L_code) then goto continue
+ else if type(s)=whatsit_node then
+ begin
+ if (is_native_word_subtype(s)) then begin
+ { we only consider the node if it contains at least one letter, otherwise we'll skip it }
+ for l:=0 to native_length(s) - 1 do begin
+ c:=get_native_usv(s, l);
+ if lc_code(c) <> 0 then begin
+ hf:=native_font(s);
+ prev_s:=s;
+ if (lc_code(c)=c)or(uc_hyph>0) then goto done2
+ else goto done1;
+ end;
+ if c>=@"10000 then incr(l);
+ end
+ end;
+ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
+ goto continue
+ end
+ else goto done1;
+ set_lc_code(c);
+ if hc[0]<>0 then
+ if (hc[0]=c)or(uc_hyph>0) then goto done2
+ else goto done1;
+continue: prev_s:=s; s:=link(prev_s);
+ end;
+done2: hyf_char:=hyphen_char[hf];
+if hyf_char<0 then goto done1;
+if hyf_char>biggest_char then goto done1;
+ha:=prev_s
+
+@ The word to be hyphenated is now moved to the |hu| and |hc| arrays.
+
+@<Skip to node |hb|, putting letters...@>=
+hn:=0;
+loop@+ begin if is_char_node(s) then
+ begin if font(s)<>hf then goto done3;
+ hyf_bchar:=character(s); c:=qo(hyf_bchar);
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if hc[0]>max_hyph_char then goto done3;
+ if hn=max_hyphenatable_length then goto done3;
+ hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
+ end
+ else if type(s)=ligature_node then
+ @<Move the characters of a ligature node to |hu| and |hc|;
+ but |goto done3| if they are not all letters@>
+ else if (type(s)=kern_node)and(subtype(s)=normal) then
+ begin hb:=s;
+ hyf_bchar:=font_bchar[hf];
+ end
+ else goto done3;
+ s:=link(s);
+ end;
+done3:
+
+@ We let |j| be the index of the character being stored when a ligature node
+is being expanded, since we do not want to advance |hn| until we are sure
+that the entire ligature consists of letters. Note that it is possible
+to get to |done3| with |hn=0| and |hb| not set to any value.
+
+@<Move the characters of a ligature node to |hu| and |hc|...@>=
+begin if font(lig_char(s))<>hf then goto done3;
+j:=hn; q:=lig_ptr(s);@+if q>null then hyf_bchar:=character(q);
+while q>null do
+ begin c:=qo(character(q));
+ set_lc_code(c);
+ if hc[0]=0 then goto done3;
+ if hc[0]>max_hyph_char then goto done3;
+ if j=max_hyphenatable_length then goto done3;
+ incr(j); hu[j]:=c; hc[j]:=hc[0];@/
+ q:=link(q);
+ end;
+hb:=s; hn:=j;
+if odd(subtype(s)) then hyf_bchar:=font_bchar[hf]@+else hyf_bchar:=non_char;
+end
+
+@ @<Check that the nodes following |hb| permit hyphenation...@>=
+if hn<l_hyf+r_hyf then goto done1; {|l_hyf| and |r_hyf| are |>=1|}
+loop@+ begin if not(is_char_node(s)) then
+ case type(s) of
+ ligature_node: do_nothing;
+ kern_node: if subtype(s)<>normal then goto done4;
+ whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
+ goto done4;
+ math_node: if subtype(s)>=L_code then goto done4@+else goto done1;
+ othercases goto done1
+ endcases;
+ s:=link(s);
+ end;
+done4:
+
+@* \[41] Post-hyphenation.
+If a hyphen may be inserted between |hc[j]| and |hc[j+1]|, the hyphenation
+procedure will set |hyf[j]| to some small odd number. But before we look
+at \TeX's hyphenation procedure, which is independent of the rest of the
+line-breaking algorithm, let us consider what we will do with the hyphens
+it finds, since it is better to work on this part of the program before
+forgetting what |ha| and |hb|, etc., are all about.
+
+@<Glob...@>=
+@!hyf:array [0..hyphenatable_length_limit+1] of 0..9; {odd values indicate discretionary hyphens}
+@!init_list:pointer; {list of punctuation characters preceding the word}
+@!init_lig:boolean; {does |init_list| represent a ligature?}
+@!init_lft:boolean; {if so, did the ligature involve a left boundary?}
+
+@ @<Local variables for hyphenation@>=
+@!i,@!j,@!l:0..hyphenatable_length_limit+2; {indices into |hc| or |hu|}
+@!q,@!r,@!s:pointer; {temporary registers for list manipulation}
+@!bchar:halfword; {boundary character of hyphenated word, or |non_char|}
+
+@ \TeX\ will never insert a hyphen that has fewer than
+\.{\\lefthyphenmin} letters before it or fewer than
+\.{\\righthyphenmin} after it; hence, a short word has
+comparatively little chance of being hyphenated. If no hyphens have
+been found, we can save time by not having to make any changes to the
+paragraph.
+
+@<If no hyphens were found, |return|@>=
+for j:=l_hyf to hn-r_hyf do if odd(hyf[j]) then goto found1;
+return;
+found1:
+
+@ If hyphens are in fact going to be inserted, \TeX\ first deletes the
+subsequence of nodes between |ha| and~|hb|. An attempt is made to
+preserve the effect that implicit boundary characters and punctuation marks
+had on ligatures inside the hyphenated word, by storing a left boundary or
+preceding character in |hu[0]| and by storing a possible right boundary
+in |bchar|. We set |j:=0| if |hu[0]| is to be part of the reconstruction;
+otherwise |j:=1|.
+The variable |s| will point to the tail of the current hlist, and
+|q| will point to the node following |hb|, so that
+things can be hooked up after we reconstitute the hyphenated word.
+
+@<Replace nodes |ha..hb| by a sequence of nodes...@>=
+if is_native_word_node(ha) then begin
+ @<Hyphenate the |native_word_node| at |ha|@>;
+end else begin
+q:=link(hb); link(hb):=null; r:=link(ha); link(ha):=null; bchar:=hyf_bchar;
+if is_char_node(ha) then
+ if font(ha)<>hf then goto found2
+ else begin init_list:=ha; init_lig:=false; hu[0]:=qo(character(ha));
+ end
+else if type(ha)=ligature_node then
+ if font(lig_char(ha))<>hf then goto found2
+ else begin init_list:=lig_ptr(ha); init_lig:=true; init_lft:=(subtype(ha)>1);
+ hu[0]:=qo(character(lig_char(ha)));
+ if init_list=null then if init_lft then
+ begin hu[0]:=max_hyph_char; init_lig:=false;
+ end; {in this case a ligature will be reconstructed from scratch}
+ free_node(ha,small_node_size);
+ end
+else begin {no punctuation found; look for left boundary}
+ if not is_char_node(r) then if type(r)=ligature_node then
+ if subtype(r)>1 then goto found2;
+ j:=1; s:=ha; init_list:=null; goto common_ending;
+ end;
+s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
+while link(s)<>ha do s:=link(s);
+j:=0; goto common_ending;
+found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
+common_ending: flush_node_list(r);
+@<Reconstitute nodes for the hyphenated word, inserting discretionary hyphens@>;
+flush_list(init_list);
+end
+
+@ @<Hyphenate the |native_word_node| at |ha|@>=
+{ find the node immediately before the word to be hyphenated }
+s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
+while link(s) <> ha do s:=link(s);
+
+{ for each hyphen position,
+ create a |native_word_node| fragment for the text before this point,
+ and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text
+}
+
+hyphen_passed:=0; { location of last hyphen we saw }
+
+for j:=l_hyf to hn - r_hyf do begin
+ { if this is a valid break.... }
+ if odd(hyf[j]) then begin
+
+ { make a |native_word_node| for the fragment before the hyphen }
+ q:=new_native_word_node(hf, j - hyphen_passed);
+ subtype(q):=subtype(ha);
+ for i:=0 to j - hyphen_passed - 1 do
+ set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
+ set_native_metrics(q, XeTeX_use_glyph_metrics);
+ link(s):=q; { append the new node }
+ s:=q;
+
+ { make the |disc_node| for the hyphenation point }
+ q:=new_disc;
+ pre_break(q):=new_native_character(hf, hyf_char);
+ link(s):=q;
+ s:=q;
+
+ hyphen_passed:=j;
+ end
+end;
+
+{ make a |native_word_node| for the last fragment of the word }
+hn:=native_length(ha); { ensure trailing punctuation is not lost! }
+q:=new_native_word_node(hf, hn - hyphen_passed);
+subtype(q):=subtype(ha);
+for i:=0 to hn - hyphen_passed - 1 do
+ set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
+set_native_metrics(q, XeTeX_use_glyph_metrics);
+link(s):=q; { append the new node }
+s:=q;
+
+q:=link(ha);
+link(s):=q;
+link(ha):=null;
+flush_node_list(ha);
+
+@ We must now face the fact that the battle is not over, even though the
+{\def\!{\kern-1pt}%
+hyphens have been found: The process of reconstituting a word can be nontrivial
+because ligatures might change when a hyphen is present. {\sl The \TeX book\/}
+discusses the difficulties of the word ``difficult'', and
+the discretionary material surrounding a
+hyphen can be considerably more complex than that. Suppose
+\.{abcdef} is a word in a font for which the only ligatures are \.{b\!c},
+\.{c\!d}, \.{d\!e}, and \.{e\!f}. If this word permits hyphenation
+between \.b and \.c, the two patterns with and without hyphenation are
+$\.a\,\.b\,\.-\,\.{c\!d}\,\.{e\!f}$ and $\.a\,\.{b\!c}\,\.{d\!e}\,\.f$.
+Thus the insertion of a hyphen might cause effects to ripple arbitrarily
+far into the rest of the word. A further complication arises if additional
+hyphens appear together with such rippling, e.g., if the word in the
+example just given could also be hyphenated between \.c and \.d; \TeX\
+avoids this by simply ignoring the additional hyphens in such weird cases.}
+
+Still further complications arise in the presence of ligatures that do not
+delete the original characters. When punctuation precedes the word being
+hyphenated, \TeX's method is not perfect under all possible scenarios,
+because punctuation marks and letters can propagate information back and forth.
+For example, suppose the original pre-hyphenation pair
+\.{*a} changes to \.{*y} via a \.{\?=:} ligature, which changes to \.{xy}
+via a \.{=:\?} ligature; if $p_{a-1}=\.x$ and $p_a=\.y$, the reconstitution
+procedure isn't smart enough to obtain \.{xy} again. In such cases the
+font designer should include a ligature that goes from \.{xa} to \.{xy}.
+
+@ The processing is facilitated by a subroutine called |reconstitute|. Given
+a string of characters $x_j\ldots x_n$, there is a smallest index $m\ge j$
+such that the ``translation'' of $x_j\ldots x_n$ by ligatures and kerning
+has the form $y_1\ldots y_t$ followed by the translation of $x_{m+1}\ldots x_n$,
+where $y_1\ldots y_t$ is some nonempty sequence of character, ligature, and
+kern nodes. We call $x_j\ldots x_m$ a ``cut prefix'' of $x_j\ldots x_n$.
+For example, if $x_1x_2x_3=\.{fly}$, and if the font contains `fl' as a
+ligature and a kern between `fl' and `y', then $m=2$, $t=2$, and $y_1$ will
+be a ligature node for `fl' followed by an appropriate kern node~$y_2$.
+In the most common case, $x_j$~forms no ligature with $x_{j+1}$ and we
+simply have $m=j$, $y_1=x_j$. If $m<n$ we can repeat the procedure on
+$x_{m+1}\ldots x_n$ until the entire translation has been found.
+
+The |reconstitute| function returns the integer $m$ and puts the nodes
+$y_1\ldots y_t$ into a linked list starting at |link(hold_head)|,
+getting the input $x_j\ldots x_n$ from the |hu| array. If $x_j=256$,
+we consider $x_j$ to be an implicit left boundary character; in this
+case |j| must be strictly less than~|n|. There is a
+parameter |bchar|, which is either 256 or an implicit right boundary character
+assumed to be present just following~$x_n$. (The value |hu[n+1]| is never
+explicitly examined, but the algorithm imagines that |bchar| is there.)
+
+If there exists an index |k| in the range $j\le k\le m$ such that |hyf[k]|
+is odd and such that the result of |reconstitute| would have been different
+if $x_{k+1}$ had been |hchar|, then |reconstitute| sets |hyphen_passed|
+to the smallest such~|k|. Otherwise it sets |hyphen_passed| to zero.
+
+A special convention is used in the case |j=0|: Then we assume that the
+translation of |hu[0]| appears in a special list of charnodes starting at
+|init_list|; moreover, if |init_lig| is |true|, then |hu[0]| will be
+a ligature character, involving a left boundary if |init_lft| is |true|.
+This facility is provided for cases when a hyphenated
+word is preceded by punctuation (like single or double quotes) that might
+affect the translation of the beginning of the word.
+
+@<Glob...@>=
+@!hyphen_passed:small_number; {first hyphen in a ligature, if any}
+
+@ @<Declare the function called |reconstitute|@>=
+function reconstitute(@!j,@!n:small_number;@!bchar,@!hchar:halfword):
+ small_number;
+label continue,done;
+var @!p:pointer; {temporary register for list manipulation}
+@!t:pointer; {a node being appended to}
+@!q:four_quarters; {character information or a lig/kern instruction}
+@!cur_rh:halfword; {hyphen character for ligature testing}
+@!test_char:halfword; {hyphen or other character for ligature testing}
+@!w:scaled; {amount of kerning}
+@!k:font_index; {position of current lig/kern instruction}
+begin hyphen_passed:=0; t:=hold_head; w:=0; link(hold_head):=null;
+ {at this point |ligature_present=lft_hit=rt_hit=false|}
+@<Set up data structures with the cursor following position |j|@>;
+continue:@<If there's a ligature or kern at the cursor position, update the data
+ structures, possibly advancing~|j|; continue until the cursor moves@>;
+@<Append a ligature and/or kern to the translation;
+ |goto continue| if the stack of inserted ligatures is nonempty@>;
+reconstitute:=j;
+end;
+
+@ The reconstitution procedure shares many of the global data structures
+by which \TeX\ has processed the words before they were hyphenated.
+There is an implied ``cursor'' between characters |cur_l| and |cur_r|;
+these characters will be tested for possible ligature activity. If
+|ligature_present| then |cur_l| is a ligature character formed from the
+original characters following |cur_q| in the current translation list.
+There is a ``ligature stack'' between the cursor and character |j+1|,
+consisting of pseudo-ligature nodes linked together by their |link| fields.
+This stack is normally empty unless a ligature command has created a new
+character that will need to be processed later. A pseudo-ligature is
+a special node having a |character| field that represents a potential
+ligature and a |lig_ptr| field that points to a |char_node| or is |null|.
+We have
+$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
+ |qi(hu[j+1])|,&if |lig_stack=null| and |j<n|;\cr
+ bchar,&if |lig_stack=null| and |j=n|.\cr}$$
+
+@<Glob...@>=
+@!cur_l,@!cur_r:halfword; {characters before and after the cursor}
+@!cur_q:pointer; {where a ligature should be detached}
+@!lig_stack:pointer; {unfinished business to the right of the cursor}
+@!ligature_present:boolean; {should a ligature node be made for |cur_l|?}
+@!lft_hit,@!rt_hit:boolean; {did we hit a ligature with a boundary character?}
+
+@ @d append_charnode_to_t(#)== begin link(t):=get_avail; t:=link(t);
+ font(t):=hf; character(t):=#;
+ end
+@d set_cur_r==begin if j<n then cur_r:=qi(hu[j+1])@+else cur_r:=bchar;
+ if odd(hyf[j]) then cur_rh:=hchar@+else cur_rh:=non_char;
+ end
+
+@<Set up data structures with the cursor following position |j|@>=
+cur_l:=qi(hu[j]); cur_q:=t;
+if j=0 then
+ begin ligature_present:=init_lig; p:=init_list;
+ if ligature_present then lft_hit:=init_lft;
+ while p>null do
+ begin append_charnode_to_t(character(p)); p:=link(p);
+ end;
+ end
+else if cur_l<non_char then append_charnode_to_t(cur_l);
+lig_stack:=null; set_cur_r
+
+@ We may want to look at the lig/kern program twice, once for a hyphen
+and once for a normal letter. (The hyphen might appear after the letter
+in the program, so we'd better not try to look for both at once.)
+
+@<If there's a ligature or kern at the cursor position, update...@>=
+if cur_l=non_char then
+ begin k:=bchar_label[hf];
+ if k=non_address then goto done@+else q:=font_info[k].qqqq;
+ end
+else begin q:=char_info(hf)(cur_l);
+ if char_tag(q)<>lig_tag then goto done;
+ k:=lig_kern_start(hf)(q); q:=font_info[k].qqqq;
+ if skip_byte(q)>stop_flag then
+ begin k:=lig_kern_restart(hf)(q); q:=font_info[k].qqqq;
+ end;
+ end; {now |k| is the starting address of the lig/kern program}
+if cur_rh<non_char then test_char:=cur_rh@+else test_char:=cur_r;
+loop@+begin if next_char(q)=test_char then if skip_byte(q)<=stop_flag then
+ if cur_rh<non_char then
+ begin hyphen_passed:=j; hchar:=non_char; cur_rh:=non_char;
+ goto continue;
+ end
+ else begin if hchar<non_char then if odd(hyf[j]) then
+ begin hyphen_passed:=j; hchar:=non_char;
+ end;
+ if op_byte(q)<kern_flag then
+ @<Carry out a ligature replacement, updating the cursor structure
+ and possibly advancing~|j|; |goto continue| if the cursor doesn't
+ advance, otherwise |goto done|@>;
+ w:=char_kern(hf)(q); goto done; {this kern will be inserted below}
+ end;
+ if skip_byte(q)>=stop_flag then
+ if cur_rh=non_char then goto done
+ else begin cur_rh:=non_char; goto continue;
+ end;
+ k:=k+qo(skip_byte(q))+1; q:=font_info[k].qqqq;
+ end;
+done:
+
+@ @d wrap_lig(#)==if ligature_present then
+ begin p:=new_ligature(hf,cur_l,link(cur_q));
+ if lft_hit then
+ begin subtype(p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(p)); rt_hit:=false;
+ end;
+ link(cur_q):=p; t:=p; ligature_present:=false;
+ end
+@d pop_lig_stack==begin if lig_ptr(lig_stack)>null then
+ begin link(t):=lig_ptr(lig_stack); {this is a charnode for |hu[j+1]|}
+ t:=link(t); incr(j);
+ end;
+ p:=lig_stack; lig_stack:=link(p); free_node(p,small_node_size);
+ if lig_stack=null then set_cur_r@+else cur_r:=character(lig_stack);
+ end {if |lig_stack| isn't |null| we have |cur_rh=non_char|}
+
+@<Append a ligature and/or kern to the translation...@>=
+wrap_lig(rt_hit);
+if w<>0 then
+ begin link(t):=new_kern(w); t:=link(t); w:=0;
+ end;
+if lig_stack>null then
+ begin cur_q:=t; cur_l:=character(lig_stack); ligature_present:=true;
+ pop_lig_stack; goto continue;
+ end
+
+@ @<Carry out a ligature replacement, updating the cursor structure...@>=
+begin if cur_l=non_char then lft_hit:=true;
+if j=n then if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(q) of
+qi(1),qi(5):begin cur_l:=rem_byte(q); {\.{=:\?}, \.{=:\?>}}
+ ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(q); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack>null then character(lig_stack):=cur_r
+ else begin lig_stack:=new_lig_item(cur_r);
+ if j=n then bchar:=non_char
+ else begin p:=get_avail; lig_ptr(lig_stack):=p;
+ character(p):=qi(hu[j+1]); font(p):=hf;
+ end;
+ end;
+ end;
+qi(3):begin cur_r:=rem_byte(q); {\.{\?=:\?}}
+ p:=lig_stack; lig_stack:=new_lig_item(cur_r); link(lig_stack):=p;
+ end;
+qi(7),qi(11):begin wrap_lig(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=t; cur_l:=rem_byte(q); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(q); ligature_present:=true; {\.{=:}}
+ if lig_stack>null then pop_lig_stack
+ else if j=n then goto done
+ else begin append_charnode_to_t(cur_r); incr(j); set_cur_r;
+ end;
+ end
+endcases;
+if op_byte(q)>qi(4) then if op_byte(q)<>qi(7) then goto done;
+goto continue;
+end
+
+@ Okay, we're ready to insert the potential hyphenations that were found.
+When the following program is executed, we want to append the word
+|hu[1..hn]| after node |ha|, and node |q| should be appended to the result.
+During this process, the variable |i| will be a temporary
+index into |hu|; the variable |j| will be an index to our current position
+in |hu|; the variable |l| will be the counterpart of |j|, in a discretionary
+branch; the variable |r| will point to new nodes being created; and
+we need a few new local variables:
+
+@<Local variables for hyph...@>=
+@!major_tail,@!minor_tail:pointer; {the end of lists in the main and
+ discretionary branches being reconstructed}
+@!c:UnicodeScalar; {character temporarily replaced by a hyphen}
+@!c_loc:0..hyphenatable_length_limit; {where that character came from}
+@!r_count:integer; {replacement count for discretionary}
+@!hyf_node:pointer; {the hyphen, if it exists}
+
+@ When the following code is performed, |hyf[0]| and |hyf[hn]| will be zero.
+
+@<Reconstitute nodes for the hyphenated word...@>=
+repeat l:=j; j:=reconstitute(j,hn,bchar,qi(hyf_char))+1;
+if hyphen_passed=0 then
+ begin link(s):=link(hold_head);
+ while link(s)>null do s:=link(s);
+ if odd(hyf[j-1]) then
+ begin l:=j; hyphen_passed:=j-1; link(hold_head):=null;
+ end;
+ end;
+if hyphen_passed>0 then
+ @<Create and append a discretionary node as an alternative to the
+ unhyphenated word, and continue to develop both branches until they
+ become equivalent@>;
+until j>hn;
+link(s):=q
+
+@ In this repeat loop we will insert another discretionary if |hyf[j-1]| is
+odd, when both branches of the previous discretionary end at position |j-1|.
+Strictly speaking, we aren't justified in doing this, because we don't know
+that a hyphen after |j-1| is truly independent of those branches. But in almost
+all applications we would rather not lose a potentially valuable hyphenation
+point. (Consider the word `difficult', where the letter `c' is in position |j|.)
+
+@d advance_major_tail==begin major_tail:=link(major_tail); incr(r_count);
+ end
+
+@<Create and append a discretionary node as an alternative...@>=
+repeat r:=get_node(small_node_size);
+link(r):=link(hold_head); type(r):=disc_node;
+major_tail:=r; r_count:=0;
+while link(major_tail)>null do advance_major_tail;
+i:=hyphen_passed; hyf[i]:=0;
+@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>;
+@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|, appending to this
+ list and to |major_tail| until synchronization has been achieved@>;
+@<Move pointer |s| to the end of the current list, and set |replace_count(r)|
+ appropriately@>;
+hyphen_passed:=j-1; link(hold_head):=null;
+until not odd(hyf[j-1])
+
+@ The new hyphen might combine with the previous character via ligature
+or kern. At this point we have |l-1<=i<j| and |i<hn|.
+
+@<Put the \(c)characters |hu[l..i]| and a hyphen into |pre_break(r)|@>=
+minor_tail:=null; pre_break(r):=null; hyf_node:=new_character(hf,hyf_char);
+if hyf_node<>null then
+ begin incr(i); c:=hu[i]; hu[i]:=hyf_char; free_avail(hyf_node);
+ end;
+while l<=i do
+ begin l:=reconstitute(l,i,font_bchar[hf],non_char)+1;
+ if link(hold_head)>null then
+ begin if minor_tail=null then pre_break(r):=link(hold_head)
+ else link(minor_tail):=link(hold_head);
+ minor_tail:=link(hold_head);
+ while link(minor_tail)>null do minor_tail:=link(minor_tail);
+ end;
+ end;
+if hyf_node<>null then
+ begin hu[i]:=c; {restore the character in the hyphen position}
+ l:=i; decr(i);
+ end
+
+@ The synchronization algorithm begins with |l=i+1<=j|.
+
+@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|...@>=
+minor_tail:=null; post_break(r):=null; c_loc:=0;
+if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
+ end;
+while l<j do
+ begin repeat l:=reconstitute(l,hn,bchar,non_char)+1;
+ if c_loc>0 then
+ begin hu[c_loc]:=c; c_loc:=0;
+ end;
+ if link(hold_head)>null then
+ begin if minor_tail=null then post_break(r):=link(hold_head)
+ else link(minor_tail):=link(hold_head);
+ minor_tail:=link(hold_head);
+ while link(minor_tail)>null do minor_tail:=link(minor_tail);
+ end;
+ until l>=j;
+ while l>j do
+ @<Append characters of |hu[j..@,]| to |major_tail|, advancing~|j|@>;
+ end
+
+@ @<Append characters of |hu[j..@,]|...@>=
+begin j:=reconstitute(j,hn,bchar,non_char)+1;
+link(major_tail):=link(hold_head);
+while link(major_tail)>null do advance_major_tail;
+end
+
+@ Ligature insertion can cause a word to grow exponentially in size. Therefore
+we must test the size of |r_count| here, even though the hyphenated text
+was at most |max_hyphenatable_length| characters long.
+
+@<Move pointer |s| to the end of the current list...@>=
+if r_count>127 then {we have to forget the discretionary hyphen}
+ begin link(s):=link(r); link(r):=null; flush_node_list(r);
+ end
+else begin link(s):=r; replace_count(r):=r_count;
+ end;
+s:=major_tail
+
+@* \[42] Hyphenation.
+When a word |hc[1..hn]| has 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@>
+
+Let's consider Liang's method first, since it is much more interesting than the
+exception-lookup routine. The algorithm begins by setting |hyf[j]| to zero
+for all |j|, and invalid characters are inserted into |hc[0]|
+and |hc[hn+1]| to serve as delimiters. Then a reasonably fast method is
+used to see which of a given set of patterns occurs in the word
+|hc[0..(hn+1)]|. Each pattern $p_1\ldots p_k$ of length |k| has an associated
+sequence of |k+1| numbers $n_0\ldots n_k$; and if the pattern occurs in
+|hc[(j+1)..(j+k)]|, \TeX\ will set |hyf[j+i]:=@tmax@>(hyf[j+i],@t$n_i$@>)| for
+|0<=i<=k|. After this has been done for each pattern that occurs, a
+discretionary hyphen will be inserted between |hc[j]| and |hc[j+1]| when
+|hyf[j]| is odd, as we have already seen.
+
+The set of patterns $p_1\ldots p_k$ and associated numbers $n_0\ldots n_k$
+depends, of course, on the language whose words are being hyphenated, and
+on the degree of hyphenation that is desired. A method for finding
+appropriate |p|'s and |n|'s, from a given dictionary of words and acceptable
+hyphenations, is discussed in Liang's Ph.D. thesis (Stanford University,
+1983); \TeX\ simply starts with the patterns and works from there.
+
+@ The patterns are stored in a compact table that is also efficient for
+retrieval, using a variant of ``trie memory'' [cf.\ {\sl The Art of
+Computer Programming \bf3} (1973), 481--505]. We can find each pattern
+$p_1\ldots p_k$ by letting $z_0$ be one greater than the relevant language
+index and then, for |1<=i<=k|,
+setting |@t$z_i$@>:=trie_link@t$(z_{i-1})+p_i$@>|; the pattern will be
+identified by the number $z_k$. Since all the pattern information is
+packed together into a single |trie_link| array, it is necessary to
+prevent confusion between the data from inequivalent patterns, so another
+table is provided such that |trie_char@t$(z_i)=p_i$@>| for all |i|. There
+is also a table |trie_op|$(z_k)$ to identify the numbers $n_0\ldots n_k$
+associated with $p_1\ldots p_k$.
+
+Comparatively few different number sequences $n_0\ldots n_k$ actually occur,
+since most of the |n|'s are generally zero. Therefore the number sequences
+are encoded in such a way that |trie_op|$(z_k)$ is only one byte long.
+If |trie_op(@t$z_k$@>)<>min_quarterword|, when $p_1\ldots p_k$ has matched
+the letters in |hc[(l-k+1)..l@,]| of language |t|,
+we perform all of the required operations
+for this pattern by carrying out the following little program: Set
+|v:=trie_op(@t$z_k$@>)|. Then set |v:=v+op_start[t]|,
+|hyf[l-hyf_distance[v]]:=@tmax@>(hyf[l-hyf_distance[v]], hyf_num[v])|,
+and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|.
+
+@<Types...@>=
+@!trie_pointer=0..trie_size; {an index into |trie|}
+
+@ @d trie_link(#)==trie[#].rh {``downward'' link in a trie}
+@d trie_char(#)==trie[#].b1 {character matched at this trie location}
+@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
+
+@<Glob...@>=
+@!trie:array[trie_pointer] of two_halves; {|trie_link|, |trie_char|, |trie_op|}
+@!hyf_distance:array[1..trie_op_size] of small_number; {position |k-j| of $n_j$}
+@!hyf_num:array[1..trie_op_size] of small_number; {value of $n_j$}
+@!hyf_next:array[1..trie_op_size] of quarterword; {continuation code}
+@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language}
+
+@ @<Local variables for hyph...@>=
+@!z:trie_pointer; {an index into |trie|}
+@!v:integer; {an index into |hyf_distance|, etc.}
+
+@ Assuming that these auxiliary tables have been set up properly, the
+hyphenation algorithm is quite short. In the following code we set |hc[hn+2]|
+to the impossible value 256, in order to guarantee that |hc[hn+3]| will
+never be fetched.
+
+@<Find hyphen locations for the word in |hc|...@>=
+for j:=0 to hn do hyf[j]:=0;
+@<Look for the word |hc[1..hn]| in the exception table, and |goto found| (with
+ |hyf| containing the hyphens) if an entry is found@>;
+if trie_char(cur_lang+1)<>qi(cur_lang) then return; {no patterns for |cur_lang|}
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
+for j:=0 to hn-r_hyf+1 do
+ begin z:=trie_link(cur_lang+1)+hc[j]; l:=j;
+ while hc[l]=qo(trie_char(z)) do
+ begin if trie_op(z)<>min_quarterword then
+ @<Store \(m)maximum values in the |hyf| table@>;
+ incr(l); z:=trie_link(z)+hc[l];
+ end;
+ end;
+found: for j:=0 to l_hyf-1 do hyf[j]:=0;
+for j:=0 to r_hyf-1 do hyf[hn-j]:=0
+
+@ @<Store \(m)maximum values in the |hyf| table@>=
+begin v:=trie_op(z);
+repeat v:=v+op_start[cur_lang]; i:=l-hyf_distance[v];
+if hyf_num[v]>hyf[i] then hyf[i]:=hyf_num[v];
+v:=hyf_next[v];
+until v=min_quarterword;
+end
+
+@ The exception table that is built by \TeX's \.{\\hyphenation} primitive is
+organized as an ordered hash table [cf.\ Amble and Knuth, {\sl The Computer
+@^Amble, Ole@> @^Knuth, Donald Ervin@>
+Journal\/ \bf17} (1974), 135--142] using linear probing. If $\alpha$ and
+$\beta$ are words, we will say that $\alpha<\beta$ if $\vert\alpha\vert<
+\vert\beta\vert$ or if $\vert\alpha\vert=\vert\beta\vert$ and
+$\alpha$ is lexicographically smaller than $\beta$. (The notation $\vert
+\alpha\vert$ stands for the length of $\alpha$.) The idea of ordered hashing
+is to arrange the table so that a given word $\alpha$ can be sought by computing
+a hash address $h=h(\alpha)$ and then looking in table positions |h|, |h-1|,
+\dots, until encountering the first word $\L\alpha$. If this word is
+different from $\alpha$, we can conclude that $\alpha$ is not in the table.
+
+The words in the table point to lists in |mem| that specify hyphen positions
+in their |info| fields. The list for $c_1\ldots c_n$ contains the number |k| if
+the word $c_1\ldots c_n$ has a discretionary hyphen between $c_k$ and
+$c_{k+1}$.
+
+@<Types...@>=
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+
+@ @<Glob...@>=
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {lists of hyphen positions}
+@!hyph_count:hyph_pointer; {the number of words in the exception dictionary}
+
+@ @<Local variables for init...@>=
+@!z:hyph_pointer; {runs through the exception dictionary}
+
+@ @<Set init...@>=
+for z:=0 to hyph_size do
+ begin hyph_word[z]:=0; hyph_list[z]:=null;
+ end;
+hyph_count:=0;
+
+@ The algorithm for exception lookup is quite simple, as soon as we have
+a few more local variables to work with.
+
+@<Local variables for hyph...@>=
+@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
+@!k:str_number; {an index into |str_start|}
+@!u:pool_pointer; {an index into |str_pool|}
+
+@ First we compute the hash code |h|, then we search until we either
+find the word or we don't. Words from different languages are kept
+separate by appending the language code to the string.
+
+@<Look for the word |hc[1...@>=
+h:=hc[1]; incr(hn); hc[hn]:=cur_lang;
+for j:=2 to hn do h:=(h+h+hc[j]) mod hyph_size;
+loop@+ begin @<If the string |hyph_word[h]| is less than \(hc)|hc[1..hn]|,
+ |goto not_found|; but if the two strings are equal,
+ set |hyf| to the hyphen positions and |goto found|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+not_found: decr(hn)
+
+@ @<If the string |hyph_word[h]| is less than \(hc)...@>=
+k:=hyph_word[h]; if k=0 then goto not_found;
+if length(k)<hn then goto not_found;
+if length(k)=hn then
+ begin j:=1; u:=str_start_macro(k);
+ repeat if so(str_pool[u])<hc[j] then goto not_found;
+ if so(str_pool[u])>hc[j] then goto done;
+ incr(j); incr(u);
+ until j>hn;
+ @<Insert hyphens as specified in |hyph_list[h]|@>;
+ decr(hn); goto found;
+ end;
+done:
+
+@ @<Insert hyphens as specified...@>=
+s:=hyph_list[h];
+while s<>null do
+ begin hyf[info(s)]:=1; s:=link(s);
+ end
+
+@ @<Search |hyph_list| for pointers to |p|@>=
+for q:=0 to hyph_size do
+ begin if hyph_list[q]=p then
+ begin print_nl("HYPH("); print_int(q); print_char(")");
+ end;
+ end
+
+@ We have now completed the hyphenation routine, so the |line_break| procedure
+is finished at last. Since the hyphenation exception table is fresh in our
+minds, it's a good time to deal with the routine that adds new entries to it.
+
+When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
+|new_hyph_exceptions| to do the right thing.
+
+@d set_cur_lang==if language<=0 then cur_lang:=0
+ else if language>biggest_lang then cur_lang:=0
+ else cur_lang:=language
+
+@p procedure new_hyph_exceptions; {enters new exceptions}
+label reswitch, exit, found, not_found, not_found1;
+var n:0..hyphenatable_length_limit+1; {length of current word; not always a |small_number|}
+@!j:0..hyphenatable_length_limit+1; {an index into |hc|}
+@!h:hyph_pointer; {an index into |hyph_word| and |hyph_list|}
+@!k:str_number; {an index into |str_start|}
+@!p:pointer; {head of a list of hyphen positions}
+@!q:pointer; {used when creating a new node for list |p|}
+@!s,@!t:str_number; {strings being compared or stored}
+@!u,@!v:pool_pointer; {indices into |str_pool|}
+begin scan_left_brace; {a left brace must follow \.{\\hyphenation}}
+set_cur_lang;
+@!init if trie_not_ready then
+ begin hyph_index:=0; goto not_found1;
+ end;
+tini@/
+set_hyph_index;
+not_found1:
+@<Enter as many hyphenation exceptions as are listed,
+until coming to a right brace; then |return|@>;
+exit:end;
+
+@ @<Enter as many...@>=
+n:=0; p:=null;
+loop@+ begin get_x_token;
+ reswitch: case cur_cmd of
+ letter,other_char,char_given:@<Append a new letter or hyphen@>;
+ char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+ spacer,right_brace: begin if n>1 then @<Enter a hyphenation exception@>;
+ if cur_cmd=right_brace then return;
+ n:=0; p:=null;
+ end;
+ othercases @<Give improper \.{\\hyphenation} error@>
+ endcases;
+ end
+
+@ @<Give improper \.{\\hyph...@>=
+begin print_err("Improper "); print_esc("hyphenation");
+@.Improper \\hyphenation...@>
+ print(" will be flushed");
+help2("Hyphenation exceptions must contain only letters")@/
+ ("and hyphens. But continue; I'll forgive and forget.");
+error;
+end
+
+@ @<Append a new letter or hyphen@>=
+if cur_chr="-" then @<Append the value |n| to list |p|@>
+else begin set_lc_code(cur_chr);
+ if hc[0]=0 then
+ begin print_err("Not a letter");
+@.Not a letter@>
+ help2("Letters in \hyphenation words must have \lccode>0.")@/
+ ("Proceed; I'll ignore the character I just read.");
+ error;
+ end
+ else if n<max_hyphenatable_length then
+ begin incr(n);
+ if hc[0]<@"10000 then hc[n]:=hc[0]
+ else begin
+ hc[n]:=(hc[0] - @"10000) div @"400 + @"D800;
+ incr(n);
+ hc[n]:=hc[0] mod @"400 + @"DC00;
+ end;
+ end;
+ end
+
+@ @<Append the value |n| to list |p|@>=
+begin if n<max_hyphenatable_length then
+ begin q:=get_avail; link(q):=p; info(q):=n; p:=q;
+ end;
+end
+
+@ @<Enter a hyphenation exception@>=
+begin incr(n); hc[n]:=cur_lang; str_room(n); h:=0;
+for j:=1 to n do
+ begin h:=(h+h+hc[j]) mod hyph_size;
+ append_char(hc[j]);
+ end;
+s:=make_string;
+@<Insert the \(p)pair |(s,p)| into the exception table@>;
+end
+
+@ @<Insert the \(p)pair |(s,p)|...@>=
+if hyph_count=hyph_size then overflow("exception dictionary",hyph_size);
+@:TeX capacity exceeded exception dictionary}{\quad exception dictionary@>
+incr(hyph_count);
+while hyph_word[h]<>0 do
+ begin @<If the string |hyph_word[h]| is less than \(or)or equal to
+ |s|, interchange |(hyph_word[h],hyph_list[h])| with |(s,p)|@>;
+ if h>0 then decr(h)@+else h:=hyph_size;
+ end;
+hyph_word[h]:=s; hyph_list[h]:=p
+
+@ @<If the string |hyph_word[h]| is less than \(or)...@>=
+k:=hyph_word[h];
+if length(k)<length(s) then goto found;
+if length(k)>length(s) then goto not_found;
+u:=str_start_macro(k); v:=str_start_macro(s);
+repeat if str_pool[u]<str_pool[v] then goto found;
+if str_pool[u]>str_pool[v] then goto not_found;
+incr(u); incr(v);
+until u=str_start_macro(k+1);
+found:q:=hyph_list[h]; hyph_list[h]:=p; p:=q;@/
+t:=hyph_word[h]; hyph_word[h]:=s; s:=t;
+not_found:
+
+@* \[43] Initializing the hyphenation tables.
+The trie for \TeX's hyphenation algorithm is built from a sequence of
+patterns following a \.{\\patterns} specification. Such a specification
+is allowed only in \.{INITEX}, since the extra memory for auxiliary tables
+and for the initialization program itself would only clutter up the
+production version of \TeX\ with a lot of deadwood.
+
+The first step is to build a trie that is linked, instead of packed
+into sequential storage, so that insertions are readily made.
+After all patterns have been processed, \.{INITEX}
+compresses the linked trie by identifying common subtries. Finally the
+trie is packed into the efficient sequential form that the hyphenation
+algorithm actually uses.
+
+@<Declare subprocedures for |line_break|@>=
+@!init @<Declare procedures for preprocessing hyphenation patterns@>@;
+tini
+
+@ Before we discuss trie building in detail, let's consider the simpler
+problem of creating the |hyf_distance|, |hyf_num|, and |hyf_next| arrays.
+
+Suppose, for example, that \TeX\ reads the pattern `\.{ab2cde1}'. This is
+a pattern of length 5, with $n_0\ldots n_5=0\,0\,2\,0\,0\,1$ in the
+notation above. We want the corresponding |trie_op| code |v| to have
+|hyf_distance[v]=3|, |hyf_num[v]=2|, and |hyf_next[v]=@t$v^\prime$@>|,
+where the auxiliary |trie_op| code $v^\prime$ has
+|hyf_distance[@t$v^\prime$@>]=0|, |hyf_num[@t$v^\prime$@>]=1|, and
+|hyf_next[@t$v^\prime$@>]=min_quarterword|.
+
+\TeX\ computes an appropriate value |v| with the |new_trie_op| subroutine
+below, by setting
+$$\hbox{|@t$v^\prime$@>:=new_trie_op(0,1,min_quarterword)|,\qquad
+|v:=new_trie_op(3,2,@t$v^\prime$@>)|.}$$
+This subroutine looks up its three
+parameters in a special hash table, assigning a new value only if these
+three have not appeared before for the current language.
+
+The hash table is called |trie_op_hash|, and the number of entries it contains
+is |trie_op_ptr|.
+
+@<Glob...@>=
+@!init @!trie_op_hash:array[-trie_op_size..trie_op_size] of 0..trie_op_size;
+ {trie op codes for quadruples}
+@!trie_used:array[ASCII_code] of quarterword;
+ {largest opcode used so far for this language}
+@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
+ {language part of a hashed quadruple}
+@!trie_op_val:array[1..trie_op_size] of quarterword;
+ {opcode corresponding to a hashed quadruple}
+@!trie_op_ptr:0..trie_op_size; {number of stored ops so far}
+tini
+
+@ It's tempting to remove the |overflow| stops in the following procedure;
+|new_trie_op| could return |min_quarterword| (thereby simply ignoring
+part of a hyphenation pattern) instead of aborting the job. However, that would
+lead to different hyphenation results on different installations of \TeX\
+using the same patterns. The |overflow| stops are necessary for portability
+of patterns.
+
+@<Declare procedures for preprocessing hyph...@>=
+function new_trie_op(@!d,@!n:small_number;@!v:quarterword):quarterword;
+label exit;
+var h:-trie_op_size..trie_op_size; {trial hash location}
+@!u:quarterword; {trial op code}
+@!l:0..trie_op_size; {pointer to stored data}
+begin h:=abs(n+313*d+361*v+1009*cur_lang) mod (trie_op_size+trie_op_size)
+ - trie_op_size;
+loop@+ begin l:=trie_op_hash[h];
+ if l=0 then {empty position found for a new op}
+ begin if trie_op_ptr=trie_op_size then
+ overflow("pattern memory ops",trie_op_size);
+ u:=trie_used[cur_lang];
+ if u=max_quarterword then
+ overflow("pattern memory ops per language",
+ max_quarterword-min_quarterword);
+ incr(trie_op_ptr); incr(u); trie_used[cur_lang]:=u;
+ hyf_distance[trie_op_ptr]:=d;
+ hyf_num[trie_op_ptr]:=n; hyf_next[trie_op_ptr]:=v;
+ trie_op_lang[trie_op_ptr]:=cur_lang; trie_op_hash[h]:=trie_op_ptr;
+ trie_op_val[trie_op_ptr]:=u; new_trie_op:=u; return;
+ end;
+ if (hyf_distance[l]=d)and(hyf_num[l]=n)and(hyf_next[l]=v)
+ and(trie_op_lang[l]=cur_lang) then
+ begin new_trie_op:=trie_op_val[l]; return;
+ end;
+ if h>-trie_op_size then decr(h)@+else h:=trie_op_size;
+ end;
+exit:end;
+
+@ After |new_trie_op| has compressed the necessary opcode information,
+plenty of information is available to unscramble the data into the
+final form needed by our hyphenation algorithm.
+
+@<Sort \(t)the hyphenation op tables into proper order@>=
+op_start[0]:=-min_quarterword;
+for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+for j:=1 to trie_op_ptr do
+ trie_op_hash[j]:=op_start[trie_op_lang[j]]+trie_op_val[j]; {destination}
+for j:=1 to trie_op_ptr do while trie_op_hash[j]>j do
+ begin k:=trie_op_hash[j];@/
+ t:=hyf_distance[k]; hyf_distance[k]:=hyf_distance[j]; hyf_distance[j]:=t;@/
+ t:=hyf_num[k]; hyf_num[k]:=hyf_num[j]; hyf_num[j]:=t;@/
+ t:=hyf_next[k]; hyf_next[k]:=hyf_next[j]; hyf_next[j]:=t;@/
+ trie_op_hash[j]:=trie_op_hash[k]; trie_op_hash[k]:=k;
+ end
+
+@ Before we forget how to initialize the data structures that have been
+mentioned so far, let's write down the code that gets them started.
+
+@<Initialize table entries...@>=
+for k:=-trie_op_size to trie_op_size do trie_op_hash[k]:=0;
+for k:=0 to 255 do trie_used[k]:=min_quarterword;
+trie_op_ptr:=0;
+
+@ The linked trie that is used to preprocess hyphenation patterns appears
+in several global arrays. Each node represents an instruction of the form
+``if you see character |c|, then perform operation |o|, move to the
+next character, and go to node |l|; otherwise go to node |r|.''
+The four quantities |c|, |o|, |l|, and |r| are stored in four arrays
+|trie_c|, |trie_o|, |trie_l|, and |trie_r|. The root of the trie
+is |trie_l[0]|, and the number of nodes is |trie_ptr|. Null trie
+pointers are represented by zero. To initialize the trie, we simply
+set |trie_l[0]| and |trie_ptr| to zero. We also set |trie_c[0]| to some
+arbitrary value, since the algorithm may access it.
+
+The algorithms maintain the condition
+$$\hbox{|trie_c[trie_r[z]]>trie_c[z]|\qquad
+whenever |z<>0| and |trie_r[z]<>0|};$$ in other words, sibling nodes are
+ordered by their |c| fields.
+
+@d trie_root==trie_l[0] {root of the linked trie}
+
+@<Glob...@>=
+@!init @!trie_c:packed array[trie_pointer] of packed_ASCII_code;
+ {characters to match}
+@t\hskip10pt@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip10pt@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip10pt@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip10pt@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@t\hskip10pt@>@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {used to identify equivalent subtries}
+tini
+
+@ Let us suppose that a linked trie has already been constructed.
+Experience shows that we can often reduce its size by recognizing common
+subtries; therefore another hash table is introduced for this purpose,
+somewhat similar to |trie_op_hash|. The new hash table will be
+initialized to zero.
+
+The function |trie_node(p)| returns |p| if |p| is distinct from other nodes
+that it has seen, otherwise it returns the number of the first equivalent
+node that it has seen.
+
+Notice that we might make subtries equivalent even if they correspond to
+patterns for different languages, in which the trie ops might mean quite
+different things. That's perfectly all right.
+
+@<Declare procedures for preprocessing hyph...@>=
+function trie_node(@!p:trie_pointer):trie_pointer; {converts
+ to a canonical form}
+label exit;
+var h:trie_pointer; {trial hash location}
+@!q:trie_pointer; {trial trie node}
+begin h:=abs(trie_c[p]+1009*trie_o[p]+@|
+ 2718*trie_l[p]+3142*trie_r[p]) mod trie_size;
+loop@+ begin q:=trie_hash[h];
+ if q=0 then
+ begin trie_hash[h]:=p; trie_node:=p; return;
+ end;
+ if (trie_c[q]=trie_c[p])and(trie_o[q]=trie_o[p])and@|
+ (trie_l[q]=trie_l[p])and(trie_r[q]=trie_r[p]) then
+ begin trie_node:=q; return;
+ end;
+ if h>0 then decr(h)@+else h:=trie_size;
+ end;
+exit:end;
+
+@ A neat recursive procedure is now able to compress a trie by
+traversing it and applying |trie_node| to its nodes in ``bottom up''
+fashion. We will compress the entire trie by clearing |trie_hash| to
+zero and then saying `|trie_root:=compress_trie(trie_root)|'.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+function compress_trie(@!p:trie_pointer):trie_pointer;
+begin if p=0 then compress_trie:=0
+else begin trie_l[p]:=compress_trie(trie_l[p]);
+ trie_r[p]:=compress_trie(trie_r[p]);
+ compress_trie:=trie_node(p);
+ end;
+end;
+
+@ The compressed trie will be packed into the |trie| array using a
+``top-down first-fit'' procedure. This is a little tricky, so the reader
+should pay close attention: The |trie_hash| array is cleared to zero
+again and renamed |trie_ref| for this phase of the operation; later on,
+|trie_ref[p]| will be nonzero only if the linked trie node |p| is the
+smallest character
+in a family and if the characters |c| of that family have been allocated to
+locations |trie_ref[p]+c| in the |trie| array. Locations of |trie| that
+are in use will have |trie_link=0|, while the unused holes in |trie|
+will be doubly linked with |trie_link| pointing to the next larger vacant
+location and |trie_back| pointing to the next smaller one. This double
+linking will have been carried out only as far as |trie_max|, where
+|trie_max| is the largest index of |trie| that will be needed.
+To save time at the low end of the trie, we maintain array entries
+|trie_min[c]| pointing to the smallest hole that is greater than~|c|.
+Another array |trie_taken| tells whether or not a given location is
+equal to |trie_ref[p]| for some |p|; this array is used to ensure that
+distinct nodes in the compressed trie will have distinct |trie_ref|
+entries.
+
+@d trie_ref==trie_hash {where linked trie families go into |trie|}
+@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
+
+@<Glob...@>=
+@!init @!trie_taken:packed array[1..trie_size] of boolean;
+ {does a family start here?}
+@t\hskip10pt@>@!trie_min:array[ASCII_code] of trie_pointer;
+ {the first possible slot for each character}
+@t\hskip10pt@>@!trie_max:trie_pointer; {largest location used in |trie|}
+@t\hskip10pt@>@!trie_not_ready:boolean; {is the trie still in linked form?}
+tini
+
+@ Each time \.{\\patterns} appears, it contributes further patterns to
+the future trie, which will be built only when hyphenation is attempted or
+when a format file is dumped. The boolean variable |trie_not_ready|
+will change to |false| when the trie is compressed; this will disable
+further patterns.
+
+@<Initialize table entries...@>=
+trie_not_ready:=true; trie_root:=0; trie_c[0]:=si(0); trie_ptr:=0;
+
+@ Here is how the trie-compression data structures are initialized.
+If storage is tight, it would be possible to overlap |trie_op_hash|,
+|trie_op_lang|, and |trie_op_val| with |trie|, |trie_hash|, and |trie_taken|,
+because we finish with the former just before we need the latter.
+
+@<Get ready to compress the trie@>=
+@<Sort \(t)the hyphenation...@>;
+for p:=0 to trie_size do trie_hash[p]:=0;
+hyph_root:=compress_trie(hyph_root);
+trie_root:=compress_trie(trie_root); {identify equivalent subtries}
+for p:=0 to trie_ptr do trie_ref[p]:=0;
+for p:=0 to biggest_char do trie_min[p]:=p+1;
+trie_link(0):=1; trie_max:=0
+
+@ The |first_fit| procedure finds the smallest hole |z| in |trie| such that
+a trie family starting at a given node |p| will fit into vacant positions
+starting at |z|. If |c=trie_c[p]|, this means that location |z-c| must
+not already be taken by some other family, and that |z-c+@t$c^\prime$@>|
+must be vacant for all characters $c^\prime$ in the family. The procedure
+sets |trie_ref[p]| to |z-c| when the first fit has been found.
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure first_fit(@!p:trie_pointer); {packs a family into |trie|}
+label not_found,found;
+var h:trie_pointer; {candidate for |trie_ref[p]|}
+@!z:trie_pointer; {runs through holes}
+@!q:trie_pointer; {runs through the family starting at |p|}
+@!c:ASCII_code; {smallest character in the family}
+@!l,@!r:trie_pointer; {left and right neighbors}
+@!ll:1..too_big_char; {upper limit of |trie_min| updating}
+begin c:=so(trie_c[p]);
+z:=trie_min[c]; {get the first conceivably good hole}
+loop@+ begin h:=z-c;@/
+ @<Ensure that |trie_max>=h+max_hyph_char|@>;
+ if trie_taken[h] then goto not_found;
+ @<If all characters of the family fit relative to |h|, then
+ |goto found|,\30\ otherwise |goto not_found|@>;
+ not_found: z:=trie_link(z); {move to the next hole}
+ end;
+found: @<Pack the family into |trie| relative to |h|@>;
+end;
+
+@ By making sure that |trie_max| is at least |h+max_hyph_char|,
+we can be sure that
+|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
+never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
+
+@<Ensure that |trie_max>=h+max_hyph_char|@>=
+if trie_max<h+max_hyph_char then
+ begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
+@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
+ repeat incr(trie_max); trie_taken[trie_max]:=false;
+ trie_link(trie_max):=trie_max+1; trie_back(trie_max):=trie_max-1;
+ until trie_max=h+max_hyph_char;
+ end
+
+@ @<If all characters of the family fit relative to |h|...@>=
+q:=trie_r[p];
+while q>0 do
+ begin if trie_link(h+so(trie_c[q]))=0 then goto not_found;
+ q:=trie_r[q];
+ end;
+goto found
+
+@ @<Pack the family into |trie| relative to |h|@>=
+trie_taken[h]:=true; trie_ref[p]:=h; q:=p;
+repeat z:=h+so(trie_c[q]); l:=trie_back(z); r:=trie_link(z);
+trie_back(r):=l; trie_link(l):=r; trie_link(z):=0;
+if l<max_hyph_char then
+ begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
+ repeat trie_min[l]:=r; incr(l);
+ until l=ll;
+ end;
+q:=trie_r[q];
+until q=0
+
+@ To pack the entire linked trie, we use the following recursive procedure.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure trie_pack(@!p:trie_pointer); {pack subtries of a family}
+var q:trie_pointer; {a local variable that need not be saved on recursive calls}
+begin repeat q:=trie_l[p];
+if (q>0)and(trie_ref[q]=0) then
+ begin first_fit(q); trie_pack(q);
+ end;
+p:=trie_r[p];
+until p=0;
+end;
+
+@ When the whole trie has been allocated into the sequential table, we
+must go through it once again so that |trie| contains the correct
+information. Null pointers in the linked trie will be represented by the
+value~0, which properly implements an ``empty'' family.
+
+@<Move the data into |trie|@>=
+h.rh:=0; h.b0:=min_quarterword; h.b1:=min_quarterword; {|trie_link:=0|,
+ |trie_op:=min_quarterword|, |trie_char:=qi(0)|}
+if trie_max=0 then {no patterns were given}
+ begin for r:=0 to 256 do trie[r]:=h;
+ trie_max:=256;
+ end
+else begin if hyph_root>0 then trie_fix(hyph_root);
+ if trie_root>0 then trie_fix(trie_root); {this fixes the non-holes in |trie|}
+ r:=0; {now we will zero out all the holes}
+ repeat s:=trie_link(r); trie[r]:=h; r:=s;
+ until r>trie_max;
+ end;
+trie_char(0):=qi("?"); {make |trie_char(c)<>c| for all |c|}
+
+@ The fixing-up procedure is, of course, recursive. Since the linked trie
+usually has overlapping subtries, the same data may be moved several
+times; but that causes no harm, and at most as much work is done as it
+took to build the uncompressed trie.
+@^recursion@>
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure trie_fix(@!p:trie_pointer); {moves |p| and its siblings into |trie|}
+var q:trie_pointer; {a local variable that need not be saved on recursive calls}
+@!c:ASCII_code; {another one that need not be saved}
+@!z:trie_pointer; {|trie| reference; this local variable must be saved}
+begin z:=trie_ref[p];
+repeat q:=trie_l[p]; c:=so(trie_c[p]);
+trie_link(z+c):=trie_ref[q]; trie_char(z+c):=qi(c); trie_op(z+c):=trie_o[p];
+if q>0 then trie_fix(q);
+p:=trie_r[p];
+until p=0;
+end;
+
+@ Now let's go back to the easier problem, of building the linked
+trie. When \.{INITEX} has scanned the `\.{\\patterns}' control
+sequence, it calls on |new_patterns| to do the right thing.
+
+@<Declare procedures for preprocessing hyph...@>=
+procedure new_patterns; {initializes the hyphenation pattern data}
+label done, done1;
+var k,@!l:0..hyphenatable_length_limit+1; {indices into |hc| and |hyf|;
+ not always in |small_number| range}
+@!digit_sensed:boolean; {should the next digit be treated as a letter?}
+@!v:quarterword; {trie op code}
+@!p,@!q:trie_pointer; {nodes of trie traversed during insertion}
+@!first_child:boolean; {is |p=trie_l[q]|?}
+@!c:ASCII_code; {character being inserted}
+begin if trie_not_ready then
+ begin set_cur_lang; scan_left_brace; {a left brace must follow \.{\\patterns}}
+ @<Enter all of the patterns into a linked trie, until coming to a right
+ brace@>;
+ if saving_hyph_codes>0 then
+ @<Store hyphenation codes for current language@>;
+ end
+else begin print_err("Too late for "); print_esc("patterns");
+ help1("All patterns must be given before typesetting begins.");
+ error; link(garbage):=scan_toks(false,false); flush_list(def_ref);
+ end;
+end;
+
+@ Novices are not supposed to be using \.{\\patterns}, so the error
+messages are terse. (Note that all error messages appear in \TeX's string
+pool, even if they are used only by \.{INITEX}.)
+
+@<Enter all of the patterns into a linked trie...@>=
+k:=0; hyf[0]:=0; digit_sensed:=false;
+loop@+ begin get_x_token;
+ case cur_cmd of
+ letter,other_char:@<Append a new letter or a hyphen level@>;
+ spacer,right_brace: begin if k>0 then
+ @<Insert a new pattern into the linked trie@>;
+ if cur_cmd=right_brace then goto done;
+ k:=0; hyf[0]:=0; digit_sensed:=false;
+ end;
+ othercases begin print_err("Bad "); print_esc("patterns");
+@.Bad \\patterns@>
+ help1("(See Appendix H.)"); error;
+ end
+ endcases;
+ end;
+done:
+
+@ @<Append a new letter or a hyphen level@>=
+if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
+ begin if cur_chr="." then cur_chr:=0 {edge-of-word delimiter}
+ else begin cur_chr:=lc_code(cur_chr);
+ if cur_chr=0 then
+ begin print_err("Nonletter");
+@.Nonletter@>
+ help1("(See Appendix H.)"); error;
+ end;
+ end;
+ if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
+ if k<max_hyphenatable_length then
+ begin incr(k); hc[k]:=cur_chr; hyf[k]:=0; digit_sensed:=false;
+ end;
+ end
+else if k<max_hyphenatable_length then
+ begin hyf[k]:=cur_chr-"0"; digit_sensed:=true;
+ end
+
+@ When the following code comes into play, the pattern $p_1\ldots p_k$
+appears in |hc[1..k]|, and the corresponding sequence of numbers $n_0\ldots
+n_k$ appears in |hyf[0..k]|.
+
+@<Insert a new pattern into the linked trie@>=
+begin @<Compute the trie op code, |v|, and set |l:=0|@>;
+q:=0; hc[0]:=cur_lang;
+while l<=k do
+ begin c:=hc[l]; incr(l); p:=trie_l[q]; first_child:=true;
+ while (p>0)and(c>so(trie_c[p])) do
+ begin q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+ if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+ q:=p; {now node |q| represents $p_1\ldots p_{l-1}$}
+ end;
+if trie_o[q]<>min_quarterword then
+ begin print_err("Duplicate pattern");
+@.Duplicate pattern@>
+ help1("(See Appendix H.)"); error;
+ end;
+trie_o[q]:=v;
+end
+
+@ @<Insert a new trie node between |q| and |p|...@>=
+begin if trie_ptr=trie_size then overflow("pattern memory",trie_size);
+@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
+incr(trie_ptr); trie_r[trie_ptr]:=p; p:=trie_ptr; trie_l[p]:=0;
+if first_child then trie_l[q]:=p@+else trie_r[q]:=p;
+trie_c[p]:=si(c); trie_o[p]:=min_quarterword;
+end
+
+@ @<Compute the trie op code, |v|...@>=
+if hc[1]=0 then hyf[0]:=0;
+if hc[k]=0 then hyf[k]:=0;
+l:=k; v:=min_quarterword;
+loop@+ begin if hyf[l]<>0 then v:=new_trie_op(k-l,hyf[l],v);
+ if l>0 then decr(l)@+else goto done1;
+ end;
+done1:
+
+@ Finally we put everything together: Here is how the trie gets to its
+final, efficient form.
+The following packing routine is rigged so that the root of the linked
+tree gets mapped into location 1 of |trie|, as required by the hyphenation
+algorithm. This happens because the first call of |first_fit| will
+``take'' location~1.
+
+@<Declare procedures for preprocessing hyphenation patterns@>=
+procedure init_trie;
+var @!p:trie_pointer; {pointer for initialization}
+@!j,@!k,@!t:integer; {all-purpose registers for initialization}
+@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
+@!h:two_halves; {template used to zero out |trie|'s holes}
+begin
+incr(max_hyph_char);
+@<Get ready to compress the trie@>;
+if trie_root<>0 then
+ begin first_fit(trie_root); trie_pack(trie_root);
+ end;
+if hyph_root<>0 then @<Pack all stored |hyph_codes|@>;
+@<Move the data into |trie|@>;
+trie_not_ready:=false;
+end;
+
+@* \[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|.
+
+In this routine and those that follow, we make use of the fact that a
+vertical list contains no character nodes, hence the |type| field exists
+for each node in the list.
+@^data structure assumptions@>
+
+@p function prune_page_top(@!p:pointer;@!s:boolean):pointer;
+ {adjust top after page break}
+var prev_p:pointer; {lags one step behind |p|}
+@!q,@!r:pointer; {temporary variables for list manipulation}
+begin prev_p:=temp_head; link(temp_head):=p;
+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:=link(prev_p);
+ end;
+ glue_node,kern_node,penalty_node: begin q:=p; p:=link(q); link(q):=null;
+ link(prev_p):=p;
+ if s then
+ begin if split_disc=null then split_disc:=q@+else link(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:=link(temp_head);
+end;
+
+@ @<Insert glue for |split_top_skip|...@>=
+begin q:=new_skip_param(split_top_skip_code); link(prev_p):=q; link(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.
+
+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 active_height==active_width {new name for the six distance variables}
+@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}
+
+@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;
+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:=link(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 link(p)=null then t:=penalty_node
+ else t:=type(link(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) then b:=0
+ else b:=badness(h-cur_height,active_height[2])
+else if cur_height-h>active_height[6] then b:=awful_bad
+else b:=badness(cur_height-h,active_height[6])
+
+@ 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[6]:=active_height[6]+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=null| if and only if |split_bot_mark=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 @t\4@>@<Declare the function called |do_marks|@>@;
+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}
+p:pointer; {runs through the vlist}
+q:pointer; {points to where the break occurs}
+begin cur_val:=n; fetch_box(v);
+flush_node_list(split_disc); split_disc:=null;
+if sa_mark<>null then
+ if do_marks(vsplit_init,0,sa_mark) then sa_mark:=null;
+if split_first_mark<>null then
+ begin delete_token_ref(split_first_mark); split_first_mark:=null;
+ delete_token_ref(split_bot_mark); split_bot_mark:=null;
+ 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); free_node(v,box_node_size);
+if q<>null then q:=vpack(q,natural);
+change_box(q); {the |eq_level| of the box stays the same}
+vsplit:=vpackage(p,h,exactly,split_max_depth);
+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 mark_class(p)<>0 then @<Update the current marks for |vsplit|@>
+ else if split_first_mark=null then
+ begin split_first_mark:=mark_ptr(p);
+ split_bot_mark:=split_first_mark;
+ token_ref_count(split_first_mark):=@|
+ token_ref_count(split_first_mark)+2;
+ end
+ else begin delete_token_ref(split_bot_mark);
+ split_bot_mark:=mark_ptr(p);
+ add_token_ref(split_bot_mark);
+ end;
+ if link(p)=q then
+ begin link(p):=null; goto done;
+ end;
+ p:=link(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 |link(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$@>=link(page_ins_head)|;
+node $r_j$ is followed by |r@t$_{j+1}$@>=link(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|, 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|, 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 page_ins_node_size=4 {number of words for a page insertion node}
+@d inserting=0 {an insertion class that has not yet overflowed}
+@d split_up=1 {an overflowed insertion class}
+@d broken_ptr(#)==link(#+1)
+ {an insertion for this class will break here if anywhere}
+@d broken_ins(#)==info(#+1) {this insertion might break at |broken_ptr|}
+@d last_ins_ptr(#)==link(#+2) {the most recent insertion for this |subtype|}
+@d best_ins_ptr(#)==info(#+2) {the optimum most recent insertion}
+
+@<Initialize the special list heads...@>=
+subtype(page_ins_head):=qi(255);
+type(page_ins_head):=split_up; link(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 insertions
+ that were held over}
+
+@ @<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(link(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:=link(page_ins_head);
+ while r<>page_ins_head do
+ begin print_ln; print_esc("insert"); t:=qo(subtype(r));
+ print_int(t); print(" adds ");
+ if count(t)=1000 then t:=height(r)
+ else t:=x_over_n(height(r),1000)*count(t);
+ print_scaled(t);
+ if type(r)=split_up then
+ begin q:=page_head; t:=0;
+ repeat q:=link(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:=link(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 |link(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; link(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..biggest_reg; {insertion box number}
+@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
+begin if (link(contrib_head)=null)or output_active then return;
+repeat continue: p:=link(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 link(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|@>=
+link(page_tail):=p; page_tail:=p;
+link(contrib_head):=link(p); link(p):=null; goto done
+
+@ @<Recycle node |p|@>=
+link(contrib_head):=link(p); link(p):=null;
+if saving_vdiscards>0 then
+ begin if page_disc=null then page_disc:=p@+else link(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 link(p)=null then return
+ else if type(link(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 width(temp_ptr)>height(p) then width(temp_ptr):=width(temp_ptr)-height(p)
+else width(temp_ptr):=0;
+link(q):=p; link(contrib_head):=q; goto continue;
+end
+
+@ @<Prepare to move a box or rule node to the current page...@>=
+begin page_total:=page_total+page_depth+height(p);
+page_depth:=depth(p);
+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);
+ 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:=link(page_ins_head);
+ while r<>page_ins_head do
+ begin best_ins_ptr(r):=last_ins_ptr(r);
+ r:=link(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(link(r)) do r:=link(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 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|@>;
+ 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:=get_node(page_ins_node_size); link(q):=link(r); link(r):=q; r:=q;
+subtype(r):=qi(n); type(r):=inserting; 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);@/
+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; 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<>null| implies |first_mark<>null|;
+it also knows that |bot_mark=null| implies |top_mark=first_mark=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..biggest_reg; {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|}
+begin @<Set the value of |output_penalty|@>;
+if sa_mark<>null then
+ if do_marks(fire_up_init,0,sa_mark) then sa_mark:=null;
+if bot_mark<>null then
+ begin if top_mark<>null then delete_token_ref(top_mark);
+ top_mark:=bot_mark; add_token_ref(top_mark);
+ delete_token_ref(first_mark); first_mark:=null;
+ 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@>;
+if sa_mark<>null then
+ if do_marks(fire_up_done,0,sa_mark) then sa_mark:=null;
+if (top_mark<>null)and(first_mark=null) then
+ begin first_mark:=top_mark; add_token_ref(top_mark);
+ 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; link(q):=null; prev_p:=page_head; p:=link(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
+ if mark_class(p)<>0 then @<Update the current marks for |fire_up|@>
+ else @<Update the values of
+ |first_mark| and |bot_mark|@>;
+ prev_p:=p; p:=link(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=null then
+ begin first_mark:=mark_ptr(p);
+ add_token_ref(first_mark);
+ end;
+if bot_mark<>null then delete_token_ref(bot_mark);
+bot_mark:=mark_ptr(p); add_token_ref(bot_mark);
+end
+
+@ When the following code is executed, the current page runs from node
+|link(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 |link(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 link(contrib_head)=null then
+ if nest_ptr=0 then tail:=page_tail
+ else contrib_tail:=page_tail;
+ link(page_tail):=link(contrib_head);
+ link(contrib_head):=p;
+ link(prev_p):=null;
+ end;
+save_vbadness:=vbadness; vbadness:=inf_bad;
+save_vfuzz:=vfuzz; vfuzz:=max_dimen; {inhibit error messages}
+box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth);
+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 link(page_head):=link(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:=link(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 link(p)<>null do p:=link(p);
+ last_ins_ptr(r):=p;
+ end;
+ r:=link(r);
+ end;
+end
+
+@ @<Delete \(t)the page-insertion nodes@>=
+r:=link(page_ins_head);
+while r<>page_ins_head do
+ begin q:=link(r); free_node(r,page_ins_node_size); r:=q;
+ end;
+link(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|', 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:=link(page_ins_head);
+while subtype(r)<>subtype(p) do r:=link(r);
+if best_ins_ptr(r)=null then wait:=true
+else begin wait:=false; s:=last_ins_ptr(r); link(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 link(s)<>null do s:=link(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 then
+ if (broken_ins(r)=p)and(broken_ptr(r)<>null) then
+ begin while link(s)<>broken_ptr(r) do s:=link(s);
+ link(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);
+ free_node(temp_ptr,box_node_size); wait:=true;
+ end;
+ end;
+best_ins_ptr(r):=null;
+n:=qo(subtype(r));
+temp_ptr:=list_ptr(box(n));
+free_node(box(n),box_node_size);
+box(n):=vpack(temp_ptr,natural);
+end
+
+@ @<Either append the insertion node |p|...@>=
+link(prev_p):=link(p); link(p):=null;
+if wait then
+ begin link(q):=p; q:=p; incr(insert_penalties);
+ end
+else begin delete_glue_ref(split_top_ptr(p));
+ free_node(p,ins_node_size);
+ end;
+p:=prev_p
+
+@ The list of heldover insertions, running from |link(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 link(page_head)<>null then
+ begin if link(contrib_head)=null then
+ if nest_ptr=0 then tail:=page_tail@+else contrib_tail:=page_tail
+ else link(page_tail):=link(contrib_head);
+ link(contrib_head):=link(page_head);
+ link(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 link(page_tail):=link(head);
+ page_tail:=tail;
+ end;
+if link(page_head)<>null then {and both go before heldover contributions}
+ begin if link(contrib_head)=null then contrib_tail:=page_tail;
+ link(page_tail):=link(contrib_head);
+ link(contrib_head):=link(page_head);
+ link(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}
+@d main_loop=70 {go here to typeset a string of consecutive characters}
+@d collect_native=71 {go here to collect characters in a "native" font string}
+@d collected=72
+@d main_loop_wrapup=80 {go here to finish a character or ligature}
+@d main_loop_move=90 {go here to advance the ligature cursor}
+@d main_loop_move_lig=95 {same, when advancing past a generated ligature}
+@d main_loop_lookahead=100 {go here to bring in another character, if any}
+@d main_lig_loop=110 {go here to check for ligatures or kerning}
+@d append_normal_space=120 {go here to append a normal space between words}
+@#
+@d pdfbox_crop=1 {|pdf_box_type| passed to |find_pic_file|}
+@d pdfbox_media=2
+@d pdfbox_bleed=3
+@d pdfbox_trim=4
+@d pdfbox_art=5
+@d pdfbox_none=6
+
+@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,main_loop,main_loop_wrapup,
+ main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig,
+ main_loop_lookahead,main_loop_lookahead+1,
+ main_lig_loop,main_lig_loop+1,main_lig_loop+2,
+ collect_native,collected,
+ append_normal_space,exit;
+var@!t:integer; {general-purpose temporary variable}
+begin 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: goto main_loop;
+hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end;
+hmode+no_boundary: begin get_x_token;
+ if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
+ (cur_cmd=char_num) then cancel_boundary:=true;
+ goto reswitch;
+ end;
+othercases begin
+ if abs(mode)=hmode then check_for_post_char_toks(big_switch);
+ case abs(mode)+cur_cmd of
+ hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+ hmode+ex_space,mmode+ex_space: goto append_normal_space;
+ @t\4@>@<Cases of |main_control| that are not part of the inner loop@>
+ end
+ end
+endcases; {of the big |case| statement}
+goto big_switch;
+main_loop:@<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@>;
+append_normal_space:check_for_post_char_toks(big_switch);
+@<Append a normal inter-word space to the current list,
+ then |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;
+@!debug if panicking then check_mem(false);@+@;@+gubed
+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.
+
+The original unoptimized form of this algorithm resembles the
+|reconstitute| procedure, which was described earlier in connection with
+hyphenation. Again we have an implied ``cursor'' between characters
+|cur_l| and |cur_r|. The main difference is that the |lig_stack| can now
+contain a charnode as well as pseudo-ligatures; that stack is now
+usually nonempty, because the next character of input (if any) has been
+appended to it. In |main_control| we have
+$$|cur_r|=\cases{|character(lig_stack)|,&if |lig_stack>null|;\cr
+ |font_bchar[cur_font]|,&otherwise;\cr}$$
+except when |character(lig_stack)=font_false_bchar[cur_font]|.
+Several additional global variables are needed.
+
+@<Glob...@>=
+@!main_f:internal_font_number; {the current font}
+@!main_i:four_quarters; {character information bytes for |cur_l|}
+@!main_j:four_quarters; {ligature/kern command}
+@!main_k:font_index; {index into |font_info|}
+@!main_p:pointer; {temporary register for list manipulation}
+@!main_pp,@!main_ppp:pointer; {more temporary registers for list manipulation}
+@!main_h:pointer; {temp for hyphen offset in native-font text}
+@!is_hyph:boolean; {whether the last char seen is the font's hyphenchar}
+@!space_class:integer;
+@!prev_class:integer;
+@!main_s:integer; {space factor value}
+@!bchar:halfword; {boundary character of current font, or |non_char|}
+@!false_bchar:halfword; {nonexistent character matching |bchar|, or |non_char|}
+@!cancel_boundary:boolean; {should the left boundary be ignored?}
+@!ins_disc:boolean; {should we insert a discretionary node?}
+
+@ The boolean variables of the main loop are normally false, and always reset
+to false before the loop is left. That saves us the extra work of initializing
+each time.
+
+@<Set init...@>=
+ligature_present:=false; cancel_boundary:=false; lft_hit:=false; rt_hit:=false;
+ins_disc:=false;
+
+@ 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.
+
+The overall structure of the main loop is presented here. Some program labels
+are inside the individual sections.
+@^inner loop@>
+
+@d adjust_space_factor==@t@>@;@/
+ main_s:=sf_code(cur_chr) mod @"10000;
+ 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
+
+@d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found,
+ or |big_switch| in case of the initial letter of a run}
+ cur_ptr:=null;
+ space_class:=sf_code(cur_chr) div @"10000;
+
+ if XeTeX_inter_char_tokens_en and space_class <> char_class_ignored then begin {class 4096 = ignored (for combining marks etc)}
+ if prev_class = char_class_boundary then begin {boundary}
+ if (state<>token_list) or (token_type<>backed_up_char) then begin
+ find_sa_element(inter_char_val, char_class_boundary*char_class_limit + space_class, false);
+ if (cur_ptr<>null) and (sa_ptr(cur_ptr)<>null) then begin
+ if cur_cmd<>letter then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ back_input; token_type:=backed_up_char;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ goto big_switch;
+ end
+ end
+ end else begin
+ find_sa_element(inter_char_val, prev_class*char_class_limit + space_class, false);
+ if (cur_ptr<>null) and (sa_ptr(cur_ptr)<>null) then begin
+ if cur_cmd<>letter then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ back_input; token_type:=backed_up_char;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ prev_class:=char_class_boundary;
+ goto #;
+ end;
+ end;
+ prev_class:=space_class;
+ end
+
+@d check_for_post_char_toks(#)==
+ if XeTeX_inter_char_tokens_en and (space_class<>char_class_ignored) and (prev_class<>char_class_boundary) then begin
+ prev_class:=char_class_boundary;
+ find_sa_element(inter_char_val, space_class*char_class_limit + char_class_boundary, false); {boundary}
+ if (cur_ptr<>null) and (sa_ptr(cur_ptr)<>null) then begin
+ if cur_cs=0 then begin
+ if cur_cmd=char_num then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ end else cur_tok:=cs_token_flag+cur_cs;
+ back_input;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ goto #;
+ end;
+ end
+
+@<Append character |cur_chr|...@>=
+
+prev_class:=char_class_boundary; {boundary}
+
+{ added code for native font support }
+if is_native_font(cur_font) then begin
+ if mode>0 then if language<>clang then fix_language;
+
+ main_h:=0;
+ main_f:=cur_font;
+ native_len:=0;
+
+collect_native:
+ adjust_space_factor;
+
+ check_for_inter_char_toks(collected);
+
+ if (cur_chr > @"FFFF) then begin
+ native_room(2);
+ append_native((cur_chr - @"10000) div 1024 + @"D800);
+ append_native((cur_chr - @"10000) mod 1024 + @"DC00);
+ end else begin
+ native_room(1);
+ append_native(cur_chr);
+ end;
+ is_hyph:=(cur_chr = hyphen_char[main_f])
+ or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013)));
+ if (main_h = 0) and is_hyph then main_h:=native_len;
+
+ {try to collect as many chars as possible in the same font}
+ get_next;
+ if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
+ x_token;
+ if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
+ if cur_cmd=char_num then begin
+ scan_usv_num;
+ cur_chr:=cur_val;
+ goto collect_native;
+ end;
+
+ check_for_post_char_toks(collected);
+
+collected:
+ if (font_mapping[main_f] <> 0) then begin
+ main_k:=apply_mapping(font_mapping[main_f], native_text, native_len);
+ native_len:=0;
+ native_room(main_k);
+ main_h:=0;
+ for main_p:=0 to main_k - 1 do begin
+ append_native(mapped_text[main_p]);
+ if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f])
+ or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) )
+ then main_h:=native_len;
+ end
+ end;
+
+ if tracing_lost_chars > 0 then begin
+ temp_ptr:=0;
+ while (temp_ptr < native_len) do begin
+ main_k:=native_text[temp_ptr];
+ incr(temp_ptr);
+ if (main_k >= @"D800) and (main_k < @"DC00) then begin
+ main_k:=@"10000 + (main_k - @"D800) * 1024;
+ main_k:=main_k + native_text[temp_ptr] - @"DC00;
+ incr(temp_ptr);
+ end;
+ if map_char_to_glyph(main_f, main_k) = 0 then
+ char_warning(main_f, main_k);
+ end
+ end;
+
+ main_k:=native_len;
+ main_pp:=tail;
+
+ if mode=hmode then begin
+ main_ppp:=head;
+
+ { find node preceding tail, skipping discretionaries }
+ while (main_ppp<>main_pp) and (link(main_ppp)<>main_pp) do begin
+ if (not is_char_node(main_ppp)) and (type(main_ppp)=disc_node) then begin
+ temp_ptr:=main_ppp;
+ for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
+ end;
+ if main_ppp<>main_pp then main_ppp:=link(main_ppp);
+ end;
+
+ temp_ptr:=0;
+ repeat
+ if main_h = 0 then main_h:=main_k;
+
+ if is_native_word_node(main_pp)
+ and (native_font(main_pp)=main_f)
+ and (main_ppp<>main_pp)
+ and (not is_char_node(main_ppp))
+ and (type(main_ppp)<>disc_node)
+ then begin
+ { make a new temp string that contains the concatenated text of |tail| + the current word/fragment }
+ main_k:=main_h + native_length(main_pp);
+ native_room(main_k);
+
+ save_native_len:=native_len;
+ for main_p:=0 to native_length(main_pp) - 1 do
+ append_native(get_native_char(main_pp, main_p));
+ for main_p:=0 to main_h - 1 do
+ append_native(native_text[temp_ptr + main_p]);
+
+ do_locale_linebreaks(save_native_len, main_k);
+
+ native_len:=save_native_len; { discard the temp string }
+ main_k:=native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word }
+ temp_ptr:=main_h; { pointer to remaining fragment }
+
+ main_h:=0;
+ while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
+ and ( (not XeTeX_dash_break_en)
+ or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
+ do incr(main_h); { look for next hyphen or end of text }
+ if (main_h < main_k) then incr(main_h);
+
+ { remove the preceding node from the list }
+ link(main_ppp):=link(main_pp);
+ link(main_pp):=null;
+ flush_node_list(main_pp);
+ main_pp:=tail;
+ while (link(main_ppp)<>main_pp) do
+ main_ppp:=link(main_ppp);
+ end else begin
+ do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word }
+
+ temp_ptr:=temp_ptr + main_h; { advance ptr to remaining fragment }
+ main_k:=main_k - main_h; { decrement remaining length }
+
+ main_h:=0;
+ while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
+ and ( (not XeTeX_dash_break_en)
+ or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
+ do incr(main_h); { look for next hyphen or end of text }
+ if (main_h < main_k) then incr(main_h);
+ end;
+
+ if (main_k > 0) or is_hyph then begin
+ tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen),
+ or if last char in original text was a hyphen }
+ main_pp:=tail;
+ end;
+ until main_k = 0;
+ end else begin
+ { must be restricted hmode, so no need for line-breaking or discretionaries }
+ { but there might already be explicit |disc_node|s in the list }
+ main_ppp:=head;
+
+ { find node preceding tail, skipping discretionaries }
+ while (main_ppp<>main_pp) and (link(main_ppp)<>main_pp) do begin
+ if (not is_char_node(main_ppp)) and (type(main_ppp)=disc_node) then begin
+ temp_ptr:=main_ppp;
+ for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
+ end;
+ if main_ppp<>main_pp then main_ppp:=link(main_ppp);
+ end;
+
+ if is_native_word_node(main_pp)
+ and (native_font(main_pp)=main_f)
+ and (main_ppp<>main_pp)
+ and (not is_char_node(main_ppp))
+ and (type(main_ppp)<>disc_node)
+ then begin
+ { total string length for the new merged whatsit }
+ link(main_pp):=new_native_word_node(main_f, main_k + native_length(main_pp));
+ tail:=link(main_pp);
+
+ { copy text from the old one into the new }
+ for main_p:=0 to native_length(main_pp) - 1 do
+ set_native_char(tail, main_p, get_native_char(main_pp, main_p));
+ { append the new text }
+ for main_p:=0 to main_k - 1 do
+ set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+
+ { remove the preceding node from the list }
+ main_p:=head;
+ if main_p<>main_pp then
+ while link(main_p)<>main_pp do
+ main_p:=link(main_p);
+ link(main_p):=link(main_pp);
+ link(main_pp):=null;
+ flush_node_list(main_pp);
+ end else begin
+ { package the current string into a |native_word| whatsit }
+ link(main_pp):=new_native_word_node(main_f, main_k);
+ tail:=link(main_pp);
+ for main_p:=0 to main_k - 1 do
+ set_native_char(tail, main_p, native_text[main_p]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+ end
+ end;
+
+ if XeTeX_interword_space_shaping_state > 0 then begin
+ { |tail| is a word we have just appended. If it is preceded by another word
+ with a normal inter-word space between (all in the same font), then we will
+ measure that space in context and replace it with an adjusted glue value
+ if it differs from the font's normal space. }
+
+ { First we look for the most recent |native_word| in the list and set |main_pp| to it.
+ This is potentially expensive, in the case of very long paragraphs,
+ but in practice it's negligible compared to the cost of shaping and measurement. }
+ main_p := head;
+ main_pp := null;
+ while main_p <> tail do begin
+ if is_native_word_node(main_p) then main_pp := main_p;
+ main_p := link(main_p);
+ end;
+
+ if (main_pp <> null) then begin
+ { check if the font matches; if so, check the intervening nodes }
+ if (native_font(main_pp) = main_f) then begin
+ main_p := link(main_pp);
+
+ { Skip nodes that should be invisible to inter-word spacing, so that
+ e.g., `\.{\\nobreak\\ }' doesn't prevent contextual measurement.
+ This loop is guaranteed to end safely because it'll eventually hit
+ |tail|, which is a |native_word| node, if nothing else intervenes. }
+ while node_is_invisible_to_interword_space(main_p) do
+ main_p := link(main_p);
+
+ if not is_char_node(main_p) and (type(main_p) = glue_node) then begin
+ { We found a glue node: we might have an inter-word space to deal with.
+ Again, skip nodes that should be invisible to inter-word spacing.
+ We leave |main_p| pointing to the glue node; |main_pp| is the preceding word. }
+ main_ppp := link(main_p);
+ while node_is_invisible_to_interword_space(main_ppp) do
+ main_ppp := link(main_ppp);
+
+ if main_ppp = tail then begin
+ { We found a candidate inter-word space! Collect the characters of both words,
+ separated by a single space, into a |native_word| node and measure its overall width. }
+ temp_ptr := new_native_word_node(main_f, native_length(main_pp) + 1 + native_length(tail));
+ main_k := 0;
+ for t := 0 to native_length(main_pp)-1 do begin
+ set_native_char(temp_ptr, main_k, get_native_char(main_pp, t));
+ incr(main_k);
+ end;
+ set_native_char(temp_ptr, main_k, " ");
+ incr(main_k);
+ for t := 0 to native_length(tail)-1 do begin
+ set_native_char(temp_ptr, main_k, get_native_char(tail, t));
+ incr(main_k);
+ end;
+ set_native_metrics(temp_ptr, XeTeX_use_glyph_metrics);
+
+ { The contextual space width is the difference between this width and
+ the sum of the two words measured separately. }
+ t := width(temp_ptr) - width(main_pp) - width(tail);
+ free_node(temp_ptr, native_size(temp_ptr));
+
+ { If the desired width differs from the font's default word space,
+ we will insert a suitable kern after the existing glue.
+ Because kerns are discardable, this will behave OK during line breaking,
+ and it's easier than actually modifying/replacing the glue node. }
+ if t <> width(font_glue[main_f]) then begin
+ temp_ptr := new_kern(t - width(font_glue[main_f]));
+ subtype(temp_ptr) := space_adjustment;
+ link(temp_ptr) := link(main_p);
+ link(main_p) := temp_ptr;
+ end
+ end
+ end
+ end
+ end
+ end;
+
+ if cur_ptr<>null then goto big_switch
+ else goto reswitch;
+end;
+{ End of added code for native fonts }
+
+adjust_space_factor;@/
+check_for_inter_char_toks(big_switch);
+main_f:=cur_font;
+bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
+if mode>0 then if language<>clang then fix_language;
+fast_get_avail(lig_stack); font(lig_stack):=main_f; cur_l:=qi(cur_chr);
+character(lig_stack):=cur_l;@/
+cur_q:=tail;
+if cancel_boundary then
+ begin cancel_boundary:=false; main_k:=non_address;
+ end
+else main_k:=bchar_label[main_f];
+if main_k=non_address then goto main_loop_move+2; {no left boundary processing}
+cur_r:=cur_l; cur_l:=non_char;
+goto main_lig_loop+1; {begin with cursor after left boundary}
+@#
+main_loop_wrapup:@<Make a ligature node, if |ligature_present|;
+ insert a null discretionary, if appropriate@>;
+main_loop_move:@<If the cursor is immediately followed by the right boundary,
+ |goto reswitch|; if it's followed by an invalid character, |goto big_switch|;
+ otherwise move the cursor one step to the right and |goto main_lig_loop|@>;
+main_loop_lookahead:@<Look ahead for another character, or leave |lig_stack|
+ empty if there's none there@>;
+main_lig_loop:@<If there's a ligature/kern command relevant to |cur_l| and
+ |cur_r|, adjust the text appropriately; exit to |main_loop_wrapup|@>;
+main_loop_move_lig:@<Move the cursor past a pseudo-ligature, then
+ |goto main_loop_lookahead| or |main_lig_loop|@>
+
+@ If |link(cur_q)| is nonnull when |wrapup| is invoked, |cur_q| points to
+the list of characters that were consumed while building the ligature
+character~|cur_l|.
+
+A discretionary break is not inserted for an explicit hyphen when we are in
+restricted horizontal mode. In particular, this avoids putting discretionary
+nodes inside of other discretionaries.
+@^inner loop@>
+
+@d pack_lig(#)== {the parameter is either |rt_hit| or |false|}
+ begin main_p:=new_ligature(main_f,cur_l,link(cur_q));
+ if lft_hit then
+ begin subtype(main_p):=2; lft_hit:=false;
+ end;
+ if # then if lig_stack=null then
+ begin incr(subtype(main_p)); rt_hit:=false;
+ end;
+ link(cur_q):=main_p; tail:=main_p; ligature_present:=false;
+ end
+
+@d wrapup(#)==if cur_l<non_char then
+ begin if link(cur_q)>null then
+ if character(tail)=qi(hyphen_char[main_f]) then ins_disc:=true;
+ if ligature_present then pack_lig(#);
+ if ins_disc then
+ begin ins_disc:=false;
+ if mode>0 then tail_append(new_disc);
+ end;
+ end
+
+@<Make a ligature node, if |ligature_present|;...@>=
+wrapup(rt_hit)
+
+@ @<If the cursor is immediately followed by the right boundary...@>=
+@^inner loop@>
+if lig_stack=null then goto reswitch;
+cur_q:=tail; cur_l:=character(lig_stack);
+main_loop_move+1:if not is_char_node(lig_stack) then goto main_loop_move_lig;
+main_loop_move+2:if(cur_chr<font_bc[main_f])or(cur_chr>font_ec[main_f]) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+main_i:=char_info(main_f)(cur_l);
+if not char_exists(main_i) then
+ begin char_warning(main_f,cur_chr); free_avail(lig_stack); goto big_switch;
+ end;
+link(tail):=lig_stack; tail:=lig_stack {|main_loop_lookahead| is next}
+
+@ Here we are at |main_loop_move_lig|.
+When we begin this code we have |cur_q=tail| and |cur_l=character(lig_stack)|.
+
+@<Move the cursor past a pseudo-ligature...@>=
+main_p:=lig_ptr(lig_stack);
+if main_p>null then tail_append(main_p); {append a single character}
+temp_ptr:=lig_stack; lig_stack:=link(temp_ptr);
+free_node(temp_ptr,small_node_size);
+main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+if lig_stack=null then
+ if main_p>null then goto main_loop_lookahead
+ else cur_r:=bchar
+else cur_r:=character(lig_stack);
+goto main_lig_loop
+
+@ The result of \.{\\char} can participate in a ligature or kern, so we must
+look ahead for it.
+
+@<Look ahead for another character...@>=
+get_next; {set only |cur_cmd| and |cur_chr|, for speed}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|}
+if cur_cmd=letter then goto main_loop_lookahead+1;
+if cur_cmd=other_char then goto main_loop_lookahead+1;
+if cur_cmd=char_given then goto main_loop_lookahead+1;
+if cur_cmd=char_num then
+ begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1;
+ end;
+if cur_cmd=no_boundary then bchar:=non_char;
+cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
+main_loop_lookahead+1: adjust_space_factor;
+check_for_inter_char_toks(big_switch);
+fast_get_avail(lig_stack); font(lig_stack):=main_f;
+cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
+if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
+
+@ Even though comparatively few characters have a lig/kern program, several
+of the instructions here count as part of \TeX's inner loop, since a
+@^inner loop@>
+potentially long sequential search must be performed. For example, tests with
+Computer Modern Roman showed that about 40 per cent of all characters
+actually encountered in practice had a lig/kern program, and that about four
+lig/kern commands were investigated for every such character.
+
+At the beginning of this code we have |main_i=char_info(main_f)(cur_l)|.
+
+@<If there's a ligature/kern command...@>=
+if char_tag(main_i)<>lig_tag then goto main_loop_wrapup;
+if cur_r=non_char then goto main_loop_wrapup;
+main_k:=lig_kern_start(main_f)(main_i); main_j:=font_info[main_k].qqqq;
+if skip_byte(main_j)<=stop_flag then goto main_lig_loop+2;
+main_k:=lig_kern_restart(main_f)(main_j);
+main_lig_loop+1:main_j:=font_info[main_k].qqqq;
+main_lig_loop+2:if next_char(main_j)=cur_r then
+ if skip_byte(main_j)<=stop_flag then
+ @<Do ligature or kern command, returning to |main_lig_loop|
+ or |main_loop_wrapup| or |main_loop_move|@>;
+if skip_byte(main_j)=qi(0) then incr(main_k)
+else begin if skip_byte(main_j)>=stop_flag then goto main_loop_wrapup;
+ main_k:=main_k+qo(skip_byte(main_j))+1;
+ end;
+goto main_lig_loop+1
+
+@ When a ligature or kern instruction matches a character, we know from
+|read_font_info| that the character exists in the font, even though we
+haven't verified its existence in the normal way.
+
+This section could be made into a subroutine, if the code inside
+|main_control| needs to be shortened.
+
+\chardef\?='174 % vertical line to indicate character retention
+
+@<Do ligature or kern command...@>=
+begin if op_byte(main_j)>=kern_flag then
+ begin wrapup(rt_hit);
+ tail_append(new_kern(char_kern(main_f)(main_j))); goto main_loop_move;
+ end;
+if cur_l=non_char then lft_hit:=true
+else if lig_stack=null then rt_hit:=true;
+check_interrupt; {allow a way out in case there's an infinite ligature loop}
+case op_byte(main_j) of
+qi(1),qi(5):begin cur_l:=rem_byte(main_j); {\.{=:\?}, \.{=:\?>}}
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+qi(2),qi(6):begin cur_r:=rem_byte(main_j); {\.{\?=:}, \.{\?=:>}}
+ if lig_stack=null then {right boundary character is being consumed}
+ begin lig_stack:=new_lig_item(cur_r); bchar:=non_char;
+ end
+ else if is_char_node(lig_stack) then {|link(lig_stack)=null|}
+ begin main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ lig_ptr(lig_stack):=main_p;
+ end
+ else character(lig_stack):=cur_r;
+ end;
+qi(3):begin cur_r:=rem_byte(main_j); {\.{\?=:\?}}
+ main_p:=lig_stack; lig_stack:=new_lig_item(cur_r);
+ link(lig_stack):=main_p;
+ end;
+qi(7),qi(11):begin wrapup(false); {\.{\?=:\?>}, \.{\?=:\?>>}}
+ cur_q:=tail; cur_l:=rem_byte(main_j);
+ main_i:=char_info(main_f)(cur_l); ligature_present:=true;
+ end;
+othercases begin cur_l:=rem_byte(main_j); ligature_present:=true; {\.{=:}}
+ if lig_stack=null then goto main_loop_wrapup
+ else goto main_loop_move+1;
+ end
+endcases;
+if op_byte(main_j)>qi(4) then
+ if op_byte(main_j)<>qi(7) then goto main_loop_wrapup;
+if cur_l<non_char then goto main_lig_loop;
+main_k:=bchar_label[main_f]; goto main_lig_loop+1;
+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);
+link(tail):=temp_ptr; tail:=temp_ptr;
+goto big_switch
+
+@ Having |font_glue| allocated for each text font saves both time and memory.
+If any of the three spacing parameters are subsequently changed by the
+use of \.{\\fontdimen}, the |find_font_dimen| procedure deallocates the
+|font_glue| specification allocated here.
+
+@<Find the glue specification...@>=
+begin main_p:=font_glue[cur_font];
+if main_p=null then
+ begin main_p:=new_spec(zero_glue); main_k:=param_base[cur_font]+space_code;
+ width(main_p):=font_info[main_k].sc; {that's |space(cur_font)|}
+ stretch(main_p):=font_info[main_k+1].sc; {and |space_stretch(cur_font)|}
+ shrink(main_p):=font_info[main_k+2].sc; {and |space_shrink(cur_font)|}
+ font_glue[cur_font]:=main_p;
+ end;
+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:=space_skip
+ else @<Find the glue specification...@>;
+ main_p:=new_spec(main_p);
+ @<Modify the glue specification in |main_p| according to the space factor@>;
+ q:=new_glue(main_p); glue_ref_count(main_p):=null;
+ end;
+link(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_next;
+ scanner_status:=t;
+ if cur_cs < hash_base then
+ cur_cs:=prim_lookup(cur_cs-single_base)
+ else
+ cur_cs :=prim_lookup(text(cur_cs));
+ if cur_cs<>undefined_primitive then begin
+ cur_cmd:=prim_eq_type(cur_cs);
+ cur_chr:=prim_equiv(cur_cs);
+ cur_tok := cs_token_flag+prim_eqtb_base+cur_cs;
+ 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(XeTeX_math_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{\rm 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): new_save_level(simple_group);
+any_mode(begin_group): new_save_level(semi_simple_group);
+any_mode(end_group): if cur_group=semi_simple_group then unsave
+ 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: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_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_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_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; link(p):=get_avail;
+ 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: unsave;
+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
+|global_box_flag-1| represent `\.{\\setbox0}' through `\.{\\setbox32767}';
+codes |global_box_flag| through |ship_out_flag-1| represent
+`\.{\\global\\setbox0}' through `\.{\\global\\setbox32767}';
+code |ship_out_flag| represents `\.{\\shipout}'; and codes |leader_flag|
+through |leader_flag+2| 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 to denote \.{\\vbox} and \.{\\hbox}, respectively.
+
+@d box_flag==@'10000000000 {context code for `\.{\\setbox0}'}
+@d global_box_flag==@'10000100000 {context code for `\.{\\global\\setbox0}'}
+@d ship_out_flag==@'10000200000 {context code for `\.{\\shipout}'}
+@d leader_flag==@'10000200001 {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@>
+
+@ @<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);
+
+@ 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}
+@!a:small_number; {global prefix}
+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 build_page;
+ end
+ else begin if abs(mode)=hmode then space_factor:=1000
+ else begin p:=new_noad;
+ math_type(nucleus(p)):=sub_box;
+ info(nucleus(p)):=cur_box; cur_box:=p;
+ end;
+ link(tail):=cur_box; tail:=cur_box;
+ end;
+ end;
+end
+
+@ @<Store \(c)|cur_box| in a box register@>=
+begin if box_context<global_box_flag then
+ begin cur_val:=box_context-box_flag; a:=0;
+ end
+else begin cur_val:=box_context-global_box_flag; a:=4;
+ end;
+if cur_val<256 then define(box_base+cur_val,box_ref,cur_box)
+else sa_def_box;
+end
+
+@ @<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)) 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}
+@!r:pointer; {running behind |p|}
+@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?}
+@!tx:pointer; {effective tail node}
+@!m:quarterword; {the length of a replacement list}
+@!k:halfword; {0 or |vmode| or |hmode|}
+@!n:halfword; {a box number}
+begin case cur_chr of
+box_code: begin scan_register_num; fetch_box(cur_box);
+ change_box(null); {the box becomes void, at the same level}
+ end;
+copy_code: begin scan_register_num; fetch_box(q); cur_box:=copy_node_list(q);
+ 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.
+
+@d fetch_effective_tail_eTeX(#)== {extract |tx|,
+ drop \.{\\beginM} \.{\\endM} pair}
+q:=head; p:=null;
+repeat r:=p; p:=q; fm:=false;
+if not is_char_node(q) then
+ if type(q)=disc_node then
+ begin for m:=1 to replace_count(q) do p:=link(p);
+ if p=tx then #;
+ end
+ else if (type(q)=math_node)and(subtype(q)=begin_M_code) then fm:=true;
+q:=link(p);
+until q=tx; {found |r|$\to$|p|$\to$|q=tx|}
+q:=link(tx); link(p):=q; link(tx):=null;
+if q=null then if fm then confusion("tail1")
+@:this can't happen tail1}{\quad tail1@>
+ else tail:=p
+else if fm then {|r|$\to$|p=begin_M|$\to$|q=end_M|}
+ begin tail:=r; link(r):=null; flush_node_list(p);@+end
+@#
+@d check_effective_tail(#)==find_effective_tail_eTeX
+@d fetch_effective_tail==fetch_effective_tail_eTeX
+
+@<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 check_effective_tail(goto done);
+ if not is_char_node(tx) then
+ if (type(tx)=hlist_node)or(type(tx)=vlist_node) then
+ @<Remove the last box, unless it's part of a discretionary@>;
+ done:end;
+end
+
+@ @<Remove the last box...@>=
+begin fetch_effective_tail(goto done);
+cur_box:=tx; shift_amount(cur_box):=0;
+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;
+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 end_graf; package(0);
+ end;
+vtop_group: begin 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}
+@!u,v:integer; {saved values for upwards mode flag}
+begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3;
+v:=XeTeX_upwards_state; XeTeX_upwards_state:=u;
+if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
+else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
+ if c=vtop_code then @<Readjust the height and depth of |cur_box|,
+ for \.{\\vtop}@>;
+ end;
+XeTeX_upwards_state:=v;
+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
+
+@ A paragraph begins when horizontal-mode material occurs in vertical mode,
+or when the paragraph is explicitly started by `\.{\\indent}' or
+`\.{\\noindent}'.
+
+@<Put each...@>=
+primitive("indent",start_par,1);
+@!@:indent_}{\.{\\indent} primitive@>
+primitive("noindent",start_par,0);
+@!@:no_indent_}{\.{\\noindent} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+start_par: if chr_code=0 then print_esc("noindent")@+ else print_esc("indent");
+
+@ @<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+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...@>=
+function norm_min(@!h:integer):small_number;
+begin if h<=0 then norm_min:=1@+else if h>=63 then norm_min:=63@+
+else norm_min:=h;
+end;
+@#
+procedure new_graf(@!indented:boolean);
+begin prev_graf:=0;
+if (mode=vmode)or(head<>tail) then
+ tail_append(new_param_glue(par_skip_code));
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+if indented then
+ begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
+ end;
+if every_par<>null then begin_token_list(every_par,every_par_text);
+if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
+end;
+
+@ @<Cases of |main_control| that build...@>=
+hmode+start_par,mmode+start_par: 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;
+ info(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 build_page;
+ end;
+hmode+par_end: begin if align_state<0 then off_save; {this tries to
+ recover from an alignment that didn't end properly}
+ end_graf; {this takes us to the enclosing mode, if |mode>0|}
+ if mode=vmode then build_page;
+ 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;
+
+@ @<Declare act...@>=
+procedure end_graf;
+begin if mode=hmode then
+ begin if head=tail then pop_nest {null paragraphs are ignored}
+ else line_break(false);
+ if LR_save<>null then
+ begin flush_list(LR_save); LR_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): make_mark;
+
+@ @<Forbidden...@>=
+vmode+vadjust,
+
+@ @<Declare act...@>=
+procedure begin_insert_or_adjust;
+begin if cur_cmd=vadjust then cur_val:=255
+else begin scan_eight_bit_int;
+ 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 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(link(head),natural); pop_nest;
+ if saved(0)<255 then
+ begin tail_append(get_node(ins_node_size));
+ type(tail):=ins_node; subtype(tail):=qi(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(get_node(small_node_size));
+ type(tail):=adjust_node;@/
+ adjust_pre(tail):=saved(1); {the |subtype| is used for |adjust_pre|}
+ adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
+ end;
+ free_node(p,box_node_size);
+ if nest_ptr=0 then build_page;
+ end;
+output_group: @<Resume the page builder...@>;
+
+@ @<Declare act...@>=
+procedure make_mark;
+var p:pointer; {new node}
+@!c:halfword; {the mark class}
+begin if cur_chr=0 then c:=0
+else begin scan_register_num; c:=cur_val;
+ end;
+p:=scan_toks(false,true); p:=get_node(small_node_size);
+mark_class(p):=c;
+type(p):=mark_node; subtype(p):=0; {the |subtype| is not used}
+mark_ptr(p):=def_ref; link(tail):=p; tail:=p;
+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 build_page;
+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}
+@!r:pointer; {running behind |p|}
+@!fm:boolean; {a final \.{\\beginM} \.{\\endM} node pair?}
+@!tx:pointer; {effective tail node}
+@!m:quarterword; {the length of a replacement list}
+begin if (mode=vmode)and(tail=head) then
+ @<Apologize for inability to do the operation now,
+ unless \.{\\unskip} follows non-glue@>
+else begin check_effective_tail(return);
+ if not is_char_node(tx) then if type(tx)=cur_chr then
+ begin fetch_effective_tail(return);
+ flush_node_list(tx);
+ 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 256 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?}
+begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
+c:=cur_chr; scan_register_num; fetch_box(p);
+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 link(tail):=copy_node_list(list_ptr(p))
+else begin link(tail):=list_ptr(p); change_box(null);
+ free_node(p,box_node_size);
+ end;
+done:
+while link(tail) <> null do begin
+ r:=link(tail);
+ if not is_char_node(r) and (type(r) = margin_kern_node) then begin
+ link(tail):=link(r);
+ free_node(r, margin_kern_node_size);
+ end;
+ tail:=link(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 if type(tail)=ligature_node then p:=lig_char(tail)
+ else if (type(tail)=whatsit_node) then begin
+ if is_native_word_subtype(tail) then begin
+ tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit;
+ end
+ else if (subtype(tail)=glyph_node) then begin
+ tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit;
+ end;
+ return;
+ end
+ else return;
+ f:=font(p);
+ tail_append(new_kern(char_italic(f)(char_info(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.
+
+@<Put each...@>=
+primitive("-",discretionary,1);
+@!@:Single-character primitives -}{\quad\.{\\-}@>
+primitive("discretionary",discretionary,0);
+@!@:discretionary_}{\.{\\discretionary} primitive@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+discretionary: if chr_code=1 then
+ print_esc("-")@+else print_esc("discretionary");
+
+@ @<Cases of |main_control| that build...@>=
+hmode+discretionary,mmode+discretionary: append_discretionary;
+
+@ 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_discretionary;
+var c:integer; {hyphen character}
+begin tail_append(new_disc);
+if cur_chr=1 then
+ begin c:=hyphen_char[cur_font];
+ if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c);
+ 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;
+
+@ @<Declare act...@>=
+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|, |rule_node|,
+ and |ligature_node| items; set |n| to the length of the list,
+ and set |q| to the list's tail@>;
+p:=link(head); pop_nest;
+case saved(-1) of
+0:pre_break(tail):=p;
+1:post_break(tail):=p;
+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); n:=0; error;
+ end
+else link(tail):=p;
+if n<=max_quarterword then replace_count(tail):=n
+else begin print_err("Discretionary list is too long");
+@.Discretionary list is too long@>
+ help2("Wow---I never thought anybody would tweak me here.")@/
+ ("You can't seriously need such a huge discretionary list?");
+ error;
+ end;
+if n>0 then tail:=q;
+decr(save_ptr); return;
+end
+
+@ During this loop, |p=link(q)| and there are |n| items preceding |p|.
+
+@<Prune the current list, if necessary...@>=
+q:=head; p:=link(q); n:=0;
+while p<>null do
+ begin if not is_char_node(p) then if type(p)>rule_node then
+ if type(p)<>kern_node then if type(p)<>ligature_node then
+ if (type(p)<>whatsit_node)
+ or (not is_native_word_subtype(p) and (subtype(p)<>glyph_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); link(q):=null; goto done;
+ end;
+ q:=p; p:=link(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,@!lsb,@!rsb:scaled; {heights and widths, as explained above}
+@!i:four_quarters; {character information}
+begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
+if p<>null then
+ begin x:=x_height(f); s:=slant(f)/float_constant(65536);
+@^real division@>
+ if is_native_font(f) then
+ begin a:=width(p);
+ if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb))
+ end
+ else a:=char_width(f)(char_info(f)(character(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|@>;
+ link(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
+ begin q:=new_character(f,cur_chr); cur_val:=cur_chr
+ end
+else if cur_cmd=char_num then
+ begin scan_char_num; q:=new_character(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@>
+if is_native_font(f) then begin
+ w:=width(q);
+ get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta))
+ {using delta as scratch space for the unneeded depth value}
+end else begin
+ i:=char_info(f)(character(q));
+ w:=char_width(f)(i); h:=char_height(f)(height_depth(i))
+end;
+if h<>x then {the accent must be shifted up or down}
+ begin p:=hpack(p,natural); shift_amount(p):=x-h;
+ end;
+if is_native_font(f) and (a=0) then { special case for non-spacing marks }
+ delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s)
+else delta:=round((w-a)/float_constant(2)+h*t-x*s);
+@^real multiplication@>
+@^real addition@>
+r:=new_kern(delta); subtype(r):=acc_kern; link(tail):=r; link(r):=p;
+tail:=new_kern(-a-delta); subtype(tail):=acc_kern; link(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:init_align;
+hmode+valign:@<Cases of |main_control| for |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 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 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 push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
+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...@>=
+@t\4@>@<Declare subprocedures for |init_math|@>@;
+procedure init_math;
+label reswitch,found,not_found,done;
+var w:scaled; {new or partial |pre_display_size|}
+@!j:pointer; {prototype box for display}
+@!x:integer; {new |pre_display_direction|}
+@!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 j:=null; w:=-max_dimen;
+if head=tail then {`\.{\\noindent\$\$}' or `\.{\$\${ }\$\$}'}
+ @<Prepare for display after an empty paragraph@>
+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);
+LR_box:=j;
+if eTeX_ex then eq_word_define(int_base+pre_display_direction_code,x);
+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 build_page;
+end
+
+@ @<Calculate the natural width, |w|, by which...@>=
+@<Prepare for display after a non-empty paragraph@>;
+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:=link(p);
+ end;
+done:
+@<Finish the natural width computation@>
+
+@ @<Let |d| be the natural width of node |p|...@>=
+reswitch: if is_char_node(p) then
+ begin f:=font(p); d:=char_width(f)(char_info(f)(character(p)));
+ goto found;
+ end;
+case type(p) of
+hlist_node,vlist_node,rule_node: begin d:=width(p); goto found;
+ end;
+ligature_node:@<Make node |p| look like a |char_node|...@>;
+kern_node: d:=width(p);
+margin_kern_node: d:=width(p);
+@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
+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|, and |goto found| if ``visible''@>;
+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:=info(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:=mem[p-1].sc; l:=mem[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<number_math_families))
+
+@<Declare act...@>=
+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:=ho(math_code(cur_chr));
+ if is_active_math_char(c) 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:
+ if cur_chr = 2 then begin {\.{\\Umathchar}}
+ scan_math_class_int; c:=set_class_field(cur_val);
+ scan_math_fam_int; c:=c + set_family_field(cur_val);
+ scan_usv_num; c:=c + cur_val;
+ end else if cur_chr = 1 then begin {\.{\\Umathcharnum}}
+ scan_xetex_math_char_int; c:=cur_val;
+ end else begin scan_fifteen_bit_int;
+ c:=set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100);
+ end;
+math_given: begin
+ c:=set_class_field(cur_chr div @"1000) +
+ set_family_field((cur_chr mod @"1000) div @"100) +
+ (cur_chr mod @"100);
+ end;
+XeTeX_math_given: c:=cur_chr;
+delim_num: begin
+ if cur_chr=1 then begin {\.{\\Udelimiter <class> <fam> <usv>}}
+ scan_math_class_int; c:=set_class_field(cur_val);
+ scan_math_fam_int; c:=c + set_family_field(cur_val);
+ scan_usv_num; c:=c + cur_val;
+ end else begin {\.{\\delimiter <27-bit delcode>}}
+ scan_delimiter_int;
+ c:=cur_val div @'10000; {get the `small' delimiter field}
+ c:=set_class_field(c div @"1000) +
+ set_family_field((c mod @"1000) div @"100) +
+ (c mod @"100); {and convert it to a \XeTeX\ mathchar code}
+ end;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod @"10000);
+if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam
+else plane_and_fam_field(p):=(math_fam_field(c));
+plane_and_fam_field(p):=plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100;
+exit:end;
+
+@ An active character that is an |outer_call| is allowed here.
+
+@<Treat |cur_chr|...@>=
+begin cur_cs:=cur_chr+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(ho(math_code(cur_chr)));
+mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
+ set_math_char(ho(math_code(cur_chr)));
+ end;
+mmode+math_char_num: if cur_chr = 2 then begin {\.{\\Umathchar}}
+ scan_math_class_int; t:=set_class_field(cur_val);
+ scan_math_fam_int; t:=t + set_family_field(cur_val);
+ scan_usv_num; t:=t + cur_val;
+ set_math_char(t);
+ end else if cur_chr = 1 then begin {\.{\\Umathcharnum}}
+ scan_xetex_math_char_int; set_math_char(cur_val);
+ end else begin scan_fifteen_bit_int;
+ set_math_char(set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100));
+ end;
+mmode+math_given: begin
+ set_math_char(set_class_field(cur_chr div @"1000) +
+ set_family_field((cur_chr mod @"1000) div @"100) +
+ (cur_chr mod @"100));
+ end;
+mmode+XeTeX_math_given: set_math_char(cur_chr);
+mmode+delim_num: begin
+ if cur_chr=1 then begin {\.{\\Udelimiter}}
+ scan_math_class_int; t:=set_class_field(cur_val);
+ scan_math_fam_int; t:=t + set_family_field(cur_val);
+ scan_usv_num; t:=t + cur_val;
+ set_math_char(t);
+ end else begin
+ scan_delimiter_int;
+ cur_val:=cur_val div @'10000; {discard the large delimiter code}
+ set_math_char(set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100));
+ end;
+ 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}
+ ch: UnicodeScalar;
+begin if is_active_math_char(c) then
+ @<Treat |cur_chr|...@>
+else begin p:=new_noad; math_type(nucleus(p)):=math_char;
+ ch:=math_char_field(c);
+ character(nucleus(p)):=qi(ch mod @"10000);
+ plane_and_fam_field(nucleus(p)):=math_fam_field(c);
+ if is_var_family(c) then
+ begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam;
+ type(p):=ord_noad;
+ end
+ else type(p):=ord_noad+math_class_field(c);
+ plane_and_fam_field(nucleus(p)):=plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100;
+ link(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:boolean);
+begin
+ if r then begin
+ if cur_chr=1 then begin {\.{\\Uradical}}
+ cur_val1:=@"40000000; {extended delimiter code flag}
+ scan_math_fam_int; cur_val1:=cur_val1 + cur_val * @"200000;
+ scan_usv_num; cur_val:=cur_val1 + cur_val;
+ end else {radical}
+ scan_delimiter_int;
+ end
+else begin @<Get the next non-blank non-relax...@>;
+ case cur_cmd of
+ letter,other_char: begin
+ cur_val:=del_code(cur_chr);
+ end;
+ delim_num: if cur_chr=1 then begin {\.{\\Udelimiter}}
+ cur_val1:=@"40000000; {extended delimiter code flag}
+ scan_math_class_int; {discarded}
+ scan_math_fam_int; cur_val1:=cur_val1 + cur_val * @"200000;
+ scan_usv_num; cur_val:=cur_val1 + cur_val;
+ end else scan_delimiter_int; {normal delimiter}
+ othercases begin cur_val:=-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|@>;
+ end;
+if cur_val>=@"40000000 then begin {extended delimiter code, only one size}
+ small_plane_and_fam_field(p):=((cur_val mod @"200000) div @"10000) * @"100 {plane}
+ + (cur_val div @"200000) mod @"100; {family}
+ small_char_field(p):=qi(cur_val mod @"10000);
+ large_plane_and_fam_field(p):=0;
+ large_char_field(p):=0;
+end else begin {standard delimiter code, 4-bit families and 8-bit char codes}
+ small_plane_and_fam_field(p):=(cur_val div @'4000000) mod 16;
+ small_char_field(p):=qi((cur_val div @'10000) mod 256);
+ large_plane_and_fam_field(p):=(cur_val div 256) mod 16;
+ large_char_field(p):=qi(cur_val mod 256);
+end;
+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(get_node(radical_noad_size));
+type(tail):=radical_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail));
+end;
+
+@ @<Cases of |main_control| that build...@>=
+mmode+accent,mmode+math_accent:math_ac;
+
+@ @<Declare act...@>=
+procedure math_ac;
+var c: integer;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+mem[nucleus(tail)].hh:=empty_field;
+mem[subscr(tail)].hh:=empty_field;
+mem[supscr(tail)].hh:=empty_field;
+math_type(accent_chr(tail)):=math_char;
+if cur_chr=1 then begin
+ if scan_keyword("fixed") then
+ subtype(tail):=fixed_acc
+ else if scan_keyword("bottom") then begin
+ if scan_keyword("fixed") then
+ subtype(tail):=bottom_acc+fixed_acc
+ else
+ subtype(tail):=bottom_acc;
+ end;
+ scan_math_class_int; c:=set_class_field(cur_val);
+ scan_math_fam_int; c:=c + set_family_field(cur_val);
+ scan_usv_num; cur_val:=cur_val + c;
+end
+else begin
+ scan_fifteen_bit_int;
+ cur_val:=set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100);
+end;
+character(accent_chr(tail)):=qi(cur_val mod @"10000);
+if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam
+else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val);
+plane_and_fam_field(accent_chr(tail))
+ :=plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"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 end_graf; unsave; save_ptr:=save_ptr-2;
+ p:=vpack(link(head),saved(1),saved(0)); pop_nest;
+ tail_append(new_noad); type(tail):=vcenter_noad;
+ math_type(nucleus(tail)):=sub_box; info(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...@>=
+@t\4@>@<Declare the function called |fin_mlist|@>@t@>@;@/
+procedure build_choices;
+label exit;
+var p:pointer; {the current mlist}
+begin unsave; 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:=get_node(fraction_noad_size);
+ type(incompleat_noad):=fraction_noad;
+ subtype(incompleat_noad):=normal;
+ math_type(numerator(incompleat_noad)):=sub_mlist;
+ info(numerator(incompleat_noad)):=link(head);
+ mem[denominator(incompleat_noad)].hh:=empty_field;
+ mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
+ mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
+ link(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 link(tail):=p; q:=link(head);
+ end;
+pop_nest; fin_mlist:=q;
+end;
+
+@ @<Compleat...@>=
+begin math_type(denominator(incompleat_noad)):=sub_mlist;
+info(denominator(incompleat_noad)):=link(head);
+if p=null then q:=incompleat_noad
+else begin q:=info(numerator(incompleat_noad));
+ if (type(q)<>left_noad)or(delim_ptr=null) then confusion("right");
+@:this can't happen right}{\quad right@>
+ info(numerator(incompleat_noad)):=link(delim_ptr);
+ link(delim_ptr):=incompleat_noad; link(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 unsave; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+ if p<>null then if link(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 mem[saved(0)].hh:=mem[nucleus(p)].hh;
+ free_node(p,noad_size);
+ 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 link(q)<>tail do q:=link(q);
+link(q):=p; free_node(tail,noad_size); 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); unsave; {end of |math_left_group|}
+ end;
+ if t<>right_noad then
+ begin push_math(math_left_group); link(head):=q; tail:=p;
+ delim_ptr:=p;
+ end
+ else begin
+ tail_append(new_noad); type(tail):=inner_noad;
+ math_type(nucleus(tail)):=sub_mlist;
+ info(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...@>=
+@t\4@>@<Declare subprocedures for |after_math|@>@;
+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;
+@<Retrieve the prototype box@>;
+@<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(link(temp_head),natural);
+ set_box_lr(a)(dlist);
+ unsave; decr(save_ptr); {now |cur_group=math_shift_group|}
+ if saved(0)=1 then l:=true;
+ danger:=false;
+ @<Retrieve the prototype box@>;
+ @<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)
+ and (not is_new_mathfont(fam_fnt(2+text_size)))) or@|
+ ((font_params[fam_fnt(2+script_size)]<total_mathsy_params)
+ and (not is_new_mathfont(fam_fnt(2+script_size)))) or@|
+ ((font_params[fam_fnt(2+script_script_size)]<total_mathsy_params)
+ and (not is_new_mathfont(fam_fnt(2+script_script_size)))) 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)
+ and (not is_new_mathfont(fam_fnt(3+text_size)))) or@|
+ ((font_params[fam_fnt(3+script_size)]<total_mathex_params)
+ and (not is_new_mathfont(fam_fnt(3+script_size)))) or@|
+ ((font_params[fam_fnt(3+script_script_size)]<total_mathex_params)
+ and (not is_new_mathfont(fam_fnt(3+script_script_size)))) 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));
+cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist;
+link(tail):=link(temp_head);
+while link(tail)<>null do tail:=link(tail);
+tail_append(new_math(math_surround,after));
+space_factor:=1000; unsave;
+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:=link(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 pre_display_direction<0 then s:=-s-z;
+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@>;
+@<Flush the prototype box@>;
+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@>
+unsave; prev_graf:=prev_graf+3;
+push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
+prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
+ *@'200000+cur_lang;
+@<Scan an optional space@>;
+if nest_ptr=1 then build_page;
+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[fil]<>0)or(total_shrink[fill]<>0)or
+ (total_shrink[filll]<>0)) then
+ begin free_node(b,box_node_size);
+ b:=hpack(p,z-q,exactly);
+ end
+else begin e:=0;
+ if w>z then
+ begin free_node(b,box_node_size);
+ 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...@>=
+set_box_lr(b)(dlist);
+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 app_display(j,a,0);
+ 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 link(a):=r; link(r):=b; b:=a; d:=0;
+ end
+ else begin link(b):=r; link(r):=a;
+ end;
+ b:=hpack(b,natural);
+ end;
+app_display(j,b,d)
+
+@ @<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));
+ app_display(j,a,z-width(a));
+ g2:=0;
+ end;
+if t<>adjust_head then {migrating material comes after equation number}
+ begin link(tail):=link(adjust_head); tail:=t;
+ end;
+if pre_t<>pre_adjust_head then
+ begin link(tail):=link(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@>;
+flush_node_list(LR_box);
+pop_nest;
+tail_append(new_penalty(pre_display_penalty));
+tail_append(new_param_glue(above_display_skip_code));
+link(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_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(XeTeX_def_code),
+any_mode(def_family),
+any_mode(set_font),
+any_mode(def_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):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}
+@!k:font_index; {index into |font_info|}
+@!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 if eTeX_ex 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.");
+if eTeX_ex then help_line[0]:=@|
+ "I'll pretend you didn't say \long or \outer or \global or \protected.";
+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");
+ help1("I'll pretend you didn't say \long or \outer here.");
+ if eTeX_ex then
+ begin help_line[0]:=@|
+ "I'll pretend you didn't say \long or \outer or \protected here.";
+ print("' or `"); print_esc("protected");
+ end;
+ print("' with `");
+@.You can't use \\long...@>
+ print_cmd_chr(cur_cmd,cur_chr); print_char("'");
+ 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 word_define1(#)==if global then geq_word_define1(#)@+else eq_word_define1(#)
+
+@<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";
+@.inaccessible@>
+
+@ 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)
+ else if (cur_cmd=register)or(cur_cmd=toks_register) then
+ if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ add_sa_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 count_def_code=2 {|shorthand_def| for \.{\\countdef}}
+@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
+@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
+@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
+@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@d XeTeX_math_char_num_def_code=8
+@d XeTeX_math_char_def_code=9
+
+@<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("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/
+primitive("Umathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/
+@!@:U_math_char_num_def_}{\.{\\Umathcharnumdef} primitive@>
+primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/
+primitive("Umathchardef",shorthand_def,XeTeX_math_char_def_code);@/
+@!@:U_math_char_def_}{\.{\\Umathchardef} primitive@>
+primitive("countdef",shorthand_def,count_def_code);@/
+@!@:count_def_}{\.{\\countdef} 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");
+ XeTeX_math_char_def_code: print_esc("Umathchardef");
+ XeTeX_math_char_num_def_code: print_esc("Umathcharnumdef");
+ count_def_code: print_esc("countdef");
+ 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;
+XeTeX_math_given: begin print_esc("Umathchar");
+ print_hex(math_class_field(chr_code));
+ print_hex(math_fam_field(chr_code));
+ print_hex(math_char_field(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,256);
+ scan_optional_equals;
+ case n of
+ char_def_code: begin scan_usv_num; define(p,char_given,cur_val);
+ end;
+ math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
+ end;
+ XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int;
+ define(p, XeTeX_math_given, cur_val);
+ end;
+ XeTeX_math_char_def_code: begin
+ scan_math_class_int; n:=set_class_field(cur_val);
+ scan_math_fam_int; n:=n + set_family_field(cur_val);
+ scan_usv_num; n:=n + cur_val;
+ define(p, XeTeX_math_given, n);
+ end;
+ othercases begin scan_register_num;
+ if cur_val>255 then
+ begin j:=n-count_def_code; {|int_val..box_val|}
+ if j>mu_val then j:=tok_val; {|int_val..mu_val| or |tok_val|}
+ find_sa_element(j,cur_val,true); add_sa_ref(cur_ptr);
+ if j=tok_val then j:=toks_register@+else j:=register;
+ define(p,j,cur_ptr);
+ end
+ else
+ case n of
+ count_def_code: define(p,assign_int,count_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
+@.to@>
+ 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;
+ e:=false; {just in case, will be set |true| for sparse array elements}
+ if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(tok_val,cur_val,true);
+ cur_chr:=cur_ptr; e:=true;
+ end
+ else cur_chr:=toks_base+cur_val;
+ end
+ else e:=true
+ else if cur_chr=XeTeX_inter_char_loc then begin
+ scan_char_class_not_ignored; cur_ptr:=cur_val;
+ scan_char_class_not_ignored;
+ find_sa_element(inter_char_val, cur_ptr*char_class_limit + cur_val, true);
+ cur_chr:=cur_ptr; e:=true;
+ end;
+ 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 sa_define(p,null)(p,undefined_cs,null); free_avail(def_ref);
+ end
+ else begin if (p=output_routine_loc)and not e then {enclose in curlies}
+ begin link(q):=get_avail; 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;
+ sa_define(p,def_ref)(p,call,def_ref);
+ end;
+ end;
+
+@ @<If the right-hand side is a token parameter...@>=
+if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
+ begin if cur_cmd=toks_register then
+ if cur_chr=mem_bot then
+ begin scan_register_num;
+ if cur_val<256 then q:=equiv(toks_base+cur_val)
+ else begin find_sa_element(tok_val,cur_val,false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end;
+ end
+ else q:=sa_ptr(cur_chr)
+ else if cur_chr=XeTeX_inter_char_loc then begin
+ scan_char_class_not_ignored; cur_ptr:=cur_val;
+ scan_char_class_not_ignored;
+ find_sa_element(inter_char_val, cur_ptr*char_class_limit + cur_val, false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end else q:=equiv(cur_chr);
+ if q=null then sa_define(p,null)(p,undefined_cs,null)
+ else begin add_token_ref(q); sa_define(p,q)(p,call,q);
+ end;
+ goto done;
+ end
+
+@ Similar routines are used to assign values to the numeric parameters.
+
+@<Assignments@>=
+assign_int: begin p:=cur_chr; scan_optional_equals; scan_int;
+ word_define(p,cur_val);
+ 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("XeTeXmathcodenum",XeTeX_def_code,math_code_base);
+primitive("Umathcodenum",XeTeX_def_code,math_code_base);
+@!@:U_math_code_num_}{\.{\\Umathcodenum} primitive@>
+primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1);
+primitive("Umathcode",XeTeX_def_code,math_code_base+1);
+@!@:U_math_code_}{\.{\\Umathcode} 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("XeTeXcharclass",XeTeX_def_code,sf_code_base);
+@!@:XeTeX_char_class_}{\.{\\XeTeXcharclass} primitive@>
+primitive("delcode",def_code,del_code_base);
+@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base);
+primitive("Udelcodenum",XeTeX_def_code,del_code_base);
+@!@:U_del_code_num_}{\.{\\Udelcodenum} primitive@>
+primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1);
+primitive("Udelcode",XeTeX_def_code,del_code_base+1);
+@!@:U_del_code_}{\.{\\Udelcode} 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@>
+
+@ @<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");
+XeTeX_def_code:
+ if chr_code=sf_code_base then print_esc("XeTeXcharclass")
+ else if chr_code=math_code_base then print_esc("Umathcodenum")
+ else if chr_code=math_code_base+1 then print_esc("Umathcode")
+ else if chr_code=del_code_base then print_esc("Udelcodenum")
+ else print_esc("Udelcode");
+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.
+
+@<Assignments@>=
+XeTeX_def_code: begin
+ if cur_chr = sf_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ n:=sf_code(cur_val) mod @"10000;
+ scan_optional_equals;
+ scan_char_class;
+ define(p,data,cur_val*@"10000 + n);
+ end
+ else if cur_chr = math_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_xetex_math_char_int;
+ define(p,data,hi(cur_val));
+ end
+ else if cur_chr = math_code_base+1 then begin
+ p:=cur_chr-1; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_math_class_int; n:=set_class_field(cur_val);
+ scan_math_fam_int; n:=n + set_family_field(cur_val);
+ scan_usv_num; n:=n + cur_val;
+ define(p,data,hi(n));
+ end
+ else if cur_chr = del_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_int; {|scan_xetex_del_code_int|; !!FIXME!!}
+ word_define(p,hi(cur_val));
+ end else begin
+ p:=cur_chr-1; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ n:=@"40000000; {extended delimiter code flag}
+ scan_math_fam_int; n:=n + cur_val * @"200000; {extended delimiter code family}
+ scan_usv_num; n:=n + cur_val; {extended delimiter code USV}
+ word_define(p,hi(n));
+ end;
+ end;
+def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
+ p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals;
+ scan_int;
+ if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
+ begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+ if p<del_code_base 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;
+ if p<math_code_base then begin
+ if p>=sf_code_base then begin
+ n:=equiv(p) div @"10000;
+ define(p,data,n*@"10000 + cur_val);
+ end else
+ define(p,data,cur_val)
+ end else if p<del_code_base then begin
+ if cur_val=@"8000 then cur_val:=active_math_char
+ else cur_val:=set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100); {!!FIXME!! check how this is used}
+ define(p,data,hi(cur_val));
+ end
+ else word_define(p,cur_val);
+ end;
+
+@ @<Let |n| be the largest...@>=
+if cur_chr=cat_code_base then n:=max_char_code
+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_usv
+
+@ @<Assignments@>=
+def_family: begin p:=cur_chr; scan_math_fam_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}
+@!e:boolean; {does |l| refer to a sparse array element?}
+@!w:integer; {integer or dimen value of |l|}
+begin q:=cur_cmd;
+e:=false; {just in case, will be set |true| for sparse array elements}
+@<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}'}
+@.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.");
+ if p>=glue_val then delete_glue_ref(cur_val);
+ error; return;
+ end;
+if p<glue_val then sa_word_define(l,cur_val)
+else begin trap_zero_glue; sa_define(l,cur_val)(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 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;
+if (cur_chr<mem_bot)or(cur_chr>lo_mem_stat_max) then
+ begin l:=cur_chr; p:=sa_type(l); e:=true;
+ end
+else begin p:=cur_chr-mem_bot; scan_register_num;
+ if cur_val>255 then
+ begin find_sa_element(p,cur_val,true); l:=cur_ptr; e:=true;
+ end
+ else
+case p of
+int_val: l:=cur_val+count_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;
+end;
+found: if p<glue_val then@+if e then w:=sa_int(l)@+else w:=eqtb[l].int
+else if e then s:=sa_ptr(l)@+else s:=equiv(l)
+
+@ @<Compute result of |register| or |advance|...@>=
+if p<glue_val then
+ begin if p=int_val then scan_int@+else scan_normal_dimen;
+ if q=advance then cur_val:=cur_val+w;
+ 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:=s;
+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 then cur_val:=mult_integers(w,cur_val)
+ else cur_val:=nx_plus_y(w,cur_val,0)
+ else cur_val:=x_over_n(w,cur_val)
+else begin 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:pointer; {box register}
+begin c:=cur_chr; scan_register_num; fetch_box(b); scan_optional_equals;
+scan_normal_dimen;
+if b<>null then mem[b+c].sc:=cur_val;
+end;
+
+@ Paragraph shapes are set up in the obvious way.
+
+@<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:=get_node(2*n+1); info(p):=n;
+ n:=cur_val; mem[p+1].int:=n; {number of penalties}
+ for j:=p+2 to p+n+1 do
+ begin scan_int; mem[j].int:=cur_val; {penalty values}
+ end;
+ if not odd(n) then mem[p+n+2].int:=0; {unused}
+ end
+ else begin p:=get_node(2*n+1); info(p):=n;
+ for j:=1 to n do
+ begin scan_normal_dimen;
+ mem[p+2*j-1].sc:=cur_val; {indentation}
+ scan_normal_dimen;
+ mem[p+2*j].sc:=cur_val; {width}
+ end;
+ end;
+ define(q,shape_ref,p);
+ end;
+
+@ Here's something that isn't quite so obvious. It guarantees that
+|info(par_shape_ptr)| can hold any positive~|n| for which |get_node(2*n+1)|
+doesn't overflow the memory capacity.
+
+@<Check the ``constant''...@>=
+if 2*max_halfword<mem_top-mem_min then bad:=41;
+
+@ New hyphenation 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@>
+
+@ @<Cases of |print_cmd_chr|...@>=
+hyph_data: if chr_code=1 then print_esc("patterns")
+ else print_esc("hyphenation");
+
+@ @<Assignments@>=
+hyph_data: if cur_chr=1 then
+ begin @!init new_patterns; goto done;@;@+tini@/
+ print_err("Patterns can be loaded only by INITEX");
+@.Patterns can be...@>
+ help0; error;
+ repeat get_token; until cur_cmd=right_brace; {flush the patterns}
+ return;
+ end
+ else begin new_hyph_exceptions; 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: begin find_font_dimen(true); k:=cur_val;
+ scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
+ end;
+assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
+ if n < lp_code_base then begin
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ end else begin
+ if is_native_font(f) then
+ scan_glyph_number(f) {for native fonts, the value is a glyph id}
+ else scan_char_num; {for |tfm| fonts it's the same like pdftex}
+ p:=cur_val;
+ scan_optional_equals; scan_int;
+ case n of
+ lp_code_base: set_cp_code(f, p, left_side, cur_val);
+ rp_code_base: set_cp_code(f, p, right_side, cur_val);
+ endcases;
+ 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@>
+
+@ @<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");
+endcases;
+
+@ Here is where the information for a new font gets loaded.
+
+@<Assignments@>=
+def_font: new_font(a);
+
+@ @<Declare subprocedures for |prefixed_command|@>=
+procedure new_font(@!a:small_number);
+label common_ending;
+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}
+@!flushable_string:str_number; {string not yet referenced}
+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>=single_base then
+ if u=null_cs then t:="FONT"@+else t:=u-single_base
+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_file_name;
+@<Scan the font size specification@>;
+@<If this font has already been loaded, set |f| to the internal
+ font number and |goto common_ending|@>;
+f:=read_font_info(u,cur_name,cur_area,s);
+common_ending: define(u,set_font,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
+
+@ When the user gives a new identifier to a font that was previously loaded,
+the new name becomes the font identifier of record. Font names `\.{xyz}' and
+`\.{XYZ}' are considered to be different.
+
+@<If this font has already been loaded...@>=
+flushable_string:=str_ptr-1;
+for f:=font_base+1 to font_ptr do begin
+ if str_eq_str(font_name[f],cur_name) and
+ (((cur_area = "") and is_native_font(f)) or str_eq_str(font_area[f],cur_area)) then
+ begin if cur_name=flushable_string then
+ begin flush_string; cur_name:=font_name[f];
+ end;
+ if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end;
+ { could be a native font whose "name" ended up partly in area or extension }
+ append_str(cur_area); append_str(cur_name); append_str(cur_ext);
+ if str_eq_str(font_name[f], make_string) then begin
+ flush_string;
+ if is_native_font(f) then
+ begin if s>0 then
+ begin if s=font_size[f] then goto common_ending;
+ end
+ else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then
+ goto common_ending;
+ end
+ end
+ else flush_string;
+ end
+
+@ @<Cases of |print_cmd_chr|...@>=
+set_font:begin print("select font ");
+ font_name_str:=font_name[chr_code];
+ if is_native_font(chr_code) then begin
+ quote_char:="""";
+ for n:=0 to length(font_name_str) - 1 do
+ if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'";
+ print_char(quote_char);
+ slow_print(font_name_str);
+ print_char(quote_char);
+ end else
+ slow_print(font_name_str);
+ 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 u_close(read_file[n]); 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 a_open_in(read_file[n]) then read_open[n]:=just_open;
+ 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}
+@!c:0..1; {identifies \.{\\message} and \.{\\errmessage}}
+@!s:str_number; {the message}
+begin c:=cur_chr; link(garbage):=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:integer; {character code}
+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~256.
+@^data structure assumptions@>
+
+@<Change the case of the token in |p|, if a change is appropriate@>=
+t:=info(p);
+if t<cs_token_flag+single_base then
+ begin c:=t mod max_char_val;
+ if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
+ 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_code=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_code);
+@!@:show_lists_code_}{\.{\\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_code: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_code: 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; fetch_box(p); begin_diagnostic;
+print_nl("> \box"); print_int(cur_val); print_char("=");
+if p=null then print("void")@+else show_box(p);
+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_head);
+flush_list(link(temp_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 1982.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;
+
+@ @<Set init...@>=
+format_ident:=0;
+
+@ @<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,@!q: pointer; {all-purpose pointers}
+@!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 hyphenation tables@>;
+@<Dump a couple more things and the closing check word@>;
+@<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,@!q: pointer; {all-purpose pointers}
+@!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 hyphenation tables@>;
+@<Undump a couple more things and the closing check word@>;
+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|.
+System error messages should be suppressed when undumping.
+@^system dependencies@>
+
+@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 the \eTeX\ state@>@/
+dump_int(mem_bot);@/
+dump_int(mem_top);@/
+dump_int(eqtb_size);@/
+dump_int(hash_prime);@/
+dump_int(hyph_size)
+
+@ 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 the \eTeX\ state@>@/
+undump_int(x);
+if x<>mem_bot then goto bad_fmt;
+undump_int(x);
+if x<>mem_top then goto bad_fmt;
+undump_int(x);
+if x<>eqtb_size then goto bad_fmt;
+undump_int(x);
+if x<>hash_prime then goto bad_fmt;
+undump_int(x);
+if x<>hyph_size 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:=0 to str_ptr do dump_int(str_start[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); 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:=0 to str_ptr do undump(0)(pool_ptr)(str_start[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@>=
+sort_avail; var_used:=0;
+dump_int(lo_mem_max); dump_int(rover);
+if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]);
+p:=mem_bot; q:=rover; x:=0;
+repeat for k:=p to q+1 do dump_wd(mem[k]);
+x:=x+q+2-p; var_used:=var_used+q-p;
+p:=q+node_size(q); q:=rlink(q);
+until q=rover;
+var_used:=var_used+lo_mem_max-p; dyn_used:=mem_end+1-hi_mem_min;@/
+for k:=p to lo_mem_max do dump_wd(mem[k]);
+x:=x+lo_mem_max+1-p;
+dump_int(hi_mem_min); dump_int(avail);
+for k:=hi_mem_min to mem_end do dump_wd(mem[k]);
+x:=x+mem_end+1-hi_mem_min;
+p:=avail;
+while p<>null do
+ begin decr(dyn_used); p:=link(p);
+ end;
+dump_int(var_used); 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(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
+undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
+if eTeX_ex then for k:=int_val to inter_char_val do
+ undump(null)(lo_mem_max)(sa_root[k]);
+p:=mem_bot; q:=rover;
+repeat for k:=p to q+1 do undump_wd(mem[k]);
+p:=q+node_size(q);
+if (p>lo_mem_max)or((q>=rlink(q))and(rlink(q)<>rover)) then goto bad_fmt;
+q:=rlink(q);
+until q=rover;
+for k:=p to lo_mem_max do undump_wd(mem[k]);
+if mem_min<mem_bot-2 then {make more low memory available}
+ begin p:=llink(rover); q:=mem_min+1;
+ link(mem_min):=null; info(mem_min):=null; {we don't use the bottom word}
+ rlink(p):=q; llink(rover):=q;@/
+ rlink(q):=rover; llink(q):=p; link(q):=empty_flag;
+ node_size(q):=mem_bot-q;
+ end;
+undump(lo_mem_max+1)(hi_mem_stat_min)(hi_mem_min);
+undump(null)(mem_top)(avail); mem_end:=mem_top;
+for k:=hi_mem_min to mem_end do undump_wd(mem[k]);
+undump_int(var_used); 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 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 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]);
+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]);
+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(fmem_ptr);
+for k:=0 to fmem_ptr-1 do dump_wd(font_info[k]);
+dump_int(font_ptr);
+for k:=null_font to font_ptr do
+ @<Dump the array info for internal font number |k|@>;
+print_ln; print_int(fmem_ptr-7); print(" words of font info for ");
+print_int(font_ptr-font_base); print(" preloaded font");
+if font_ptr<>font_base+1 then print_char("s")
+
+@ @<Undump the font information@>=
+undump_size(7)(font_mem_size)('font mem size')(fmem_ptr);
+for k:=0 to fmem_ptr-1 do undump_wd(font_info[k]);
+undump_size(font_base)(font_max)('font max')(font_ptr);
+for k:=null_font to font_ptr do
+ @<Undump the array info for internal font number |k|@>
+
+@ @<Dump the array info for internal font number |k|@>=
+begin dump_qqqq(font_check[k]);
+dump_int(font_size[k]);
+dump_int(font_dsize[k]);
+dump_int(font_params[k]);@/
+dump_int(hyphen_char[k]);
+dump_int(skew_char[k]);@/
+dump_int(font_name[k]);
+dump_int(font_area[k]);@/
+dump_int(font_bc[k]);
+dump_int(font_ec[k]);@/
+dump_int(char_base[k]);
+dump_int(width_base[k]);
+dump_int(height_base[k]);@/
+dump_int(depth_base[k]);
+dump_int(italic_base[k]);
+dump_int(lig_kern_base[k]);@/
+dump_int(kern_base[k]);
+dump_int(exten_base[k]);
+dump_int(param_base[k]);@/
+dump_int(font_glue[k]);@/
+dump_int(bchar_label[k]);
+dump_int(font_bchar[k]);
+dump_int(font_false_bchar[k]);@/
+print_nl("\font"); print_esc(font_id_text(k)); print_char("=");
+print_file_name(font_name[k],font_area[k],"");
+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_qqqq(font_check[k]);@/
+undump_int(font_size[k]);
+undump_int(font_dsize[k]);
+undump(min_halfword)(max_halfword)(font_params[k]);@/
+undump_int(hyphen_char[k]);
+undump_int(skew_char[k]);@/
+undump(0)(str_ptr)(font_name[k]);
+undump(0)(str_ptr)(font_area[k]);@/
+undump(0)(255)(font_bc[k]);
+undump(0)(255)(font_ec[k]);@/
+undump_int(char_base[k]);
+undump_int(width_base[k]);
+undump_int(height_base[k]);@/
+undump_int(depth_base[k]);
+undump_int(italic_base[k]);
+undump_int(lig_kern_base[k]);@/
+undump_int(kern_base[k]);
+undump_int(exten_base[k]);
+undump_int(param_base[k]);@/
+undump(min_halfword)(lo_mem_max)(font_glue[k]);@/
+undump(0)(fmem_ptr-1)(bchar_label[k]);
+undump(min_quarterword)(non_char)(font_bchar[k]);
+undump(min_quarterword)(non_char)(font_false_bchar[k]);
+end
+
+@ @<Dump the hyphenation tables@>=
+dump_int(hyph_count);
+for k:=0 to hyph_size do if hyph_word[k]<>0 then
+ begin dump_int(k); dump_int(hyph_word[k]); dump_int(hyph_list[k]);
+ end;
+print_ln; print_int(hyph_count); print(" hyphenation exception");
+if hyph_count<>1 then print_char("s");
+if trie_not_ready then init_trie;
+dump_int(trie_max);
+dump_int(hyph_start);
+for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
+dump_int(trie_op_ptr);
+for k:=1 to trie_op_ptr do
+ begin dump_int(hyf_distance[k]);
+ dump_int(hyf_num[k]);
+ dump_int(hyf_next[k]);
+ end;
+print_nl("Hyphenation trie of length "); print_int(trie_max);
+@.Hyphenation trie...@>
+print(" has "); print_int(trie_op_ptr); print(" op");
+if trie_op_ptr<>1 then print_char("s");
+print(" out of "); print_int(trie_op_size);
+for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
+ begin print_nl(" "); print_int(qo(trie_used[k]));
+ print(" for language "); print_int(k);
+ dump_int(k); dump_int(qo(trie_used[k]));
+ end
+
+@ Only ``nonempty'' parts of |op_start| need to be restored.
+
+@<Undump the hyphenation tables@>=
+undump(0)(hyph_size)(hyph_count);
+for k:=1 to hyph_count do
+ begin undump(0)(hyph_size)(j);
+ undump(0)(str_ptr)(hyph_word[j]);
+ undump(min_halfword)(max_halfword)(hyph_list[j]);
+ end;
+undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
+undump(0)(j)(hyph_start);
+for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
+undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=biggest_lang+1;
+while j>0 do
+ begin undump(0)(k-1)(k); undump(1)(j)(x);@+init trie_used[k]:=qi(x);@+tini@;@/
+ j:=j-x; op_start[k]:=qo(j);
+ end;
+@!init trie_not_ready:=false @+tini
+
+@ 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(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_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(")");
+if interaction=batch_mode then selector:=log_only
+else selector:=term_and_log;
+str_room(1);
+format_ident:=make_string;
+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.
+
+@ 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@>
+
+If |final_cleanup| is bypassed, this program doesn't bother to close
+the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>; new_line_char:=-1;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if log_opened then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ slow_print(log_name); print_char(".");
+ end;
+ 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:1);@/
+ wlog_ln(' ',pool_ptr-init_pool_ptr:1,' string characters out of ',
+ pool_size-init_pool_ptr:1);@/
+ wlog_ln(' ',lo_mem_max-mem_min+mem_end-hi_mem_min+2:1,@|
+ ' words of memory out of ',mem_end+1-mem_min:1);@/
+ wlog_ln(' ',cs_count:1,' multiletter control sequences out of ',
+ hash_size:1);@/
+ wlog(' ',fmem_ptr:1,' words of font info for ',
+ font_ptr-font_base:1,' font');
+ if font_ptr<>font_base+1 then wlog('s');
+ wlog_ln(', out of ',font_mem_size:1,' for ',font_max-font_base:1);@/
+ wlog(' ',hyph_count:1,' hyphenation exception');
+ if hyph_count<>1 then wlog('s');
+ wlog_ln(' out of ',hyph_size:1);@/
+ 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}}
+begin c:=cur_chr; if c<>1 then new_line_char:=-1;
+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 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(")");
+ if eTeX_ex then 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:=link(cond_ptr); free_node(temp_ptr,if_node_size);
+ end;
+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 c:=top_mark_code to split_bot_mark_code do
+ if cur_mark[c]<>null then delete_token_ref(cur_mark[c]);
+ if sa_mark<>null then
+ if do_marks(destroy_marks,0,sa_mark) then sa_mark:=null;
+ for c:=last_box_code to vsplit_code do flush_node_list(disc_ptr[c]);
+ if last_glue<>max_halfword then delete_glue_ref(last_glue);
+ 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 eTeX_ex 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(cat_code(buffer[loc])<>escape) then start_input;
+ {\.{\\input} assumed}
+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 clear_terminal;
+ 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 declared 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: print_word(font_info[n]);
+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);
+11: check_mem(n>0); {check wellformedness; print new busy locations if |n>0|}
+12: search_mem(n); {look for pointers to |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;
+16: panicking:=not panicking;
+
+@* \[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}',
+`\.{\\special}', and `\.{\\setlanguage}' 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}, \.{\\special}, and
+\.{\\setlanguage}. 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 write_node_size=2 {number of words in a write/whatsit node}
+@d open_node_size=3 {number of words in an open/whatsit node}
+@d open_node=0 {|subtype| in whatsits that represent files to \.{\\openout}}
+@d write_node=1 {|subtype| in whatsits that represent things to \.{\\write}}
+@d close_node=2 {|subtype| in whatsits that represent streams to \.{\\closeout}}
+@d special_node=3 {|subtype| in whatsits that represent \.{\\special} things}
+@d language_node=4 {|subtype| in whatsits that change the current language}
+@d what_lang(#)==link(#+1) {language number, in the range |0..255|}
+@d what_lhm(#)==type(#+1) {minimum left fragment, in the range |1..63|}
+@d what_rhm(#)==subtype(#+1) {minimum right fragment, in the range |1..63|}
+@d write_tokens(#) == link(#+1) {reference count of token list to write}
+@d write_stream(#) == info(#+1) {stream number (0 to 17)}
+@d open_name(#) == link(#+1) {string number of file name to open}
+@d open_area(#) == info(#+2) {string number of file area for |open_name|}
+@d open_ext(#) == link(#+2) {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_open:array[0..17] of boolean;
+
+@ @<Set init...@>=
+for k:=0 to 17 do write_open[k]:=false;
+
+@ 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 set_language_code=5 {command modifier for \.{\\setlanguage}}
+
+@d pdftex_first_extension_code = 6
+@d pdf_save_pos_node == pdftex_first_extension_code + 15
+@d reset_timer_code == pdftex_first_extension_code + 25
+@d set_random_seed_code == pdftex_first_extension_code + 27
+
+@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use }
+@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} }
+@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} }
+
+@d XeTeX_input_encoding_extension_code=44
+@d XeTeX_default_encoding_extension_code=45
+@d XeTeX_linebreak_locale_extension_code=46
+
+@<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("setlanguage",extension,set_language_code);@/
+@!@:set_language_}{\.{\\setlanguage} primitive@>
+primitive("resettimer",extension,reset_timer_code);@/
+@!@:reset_timer_}{\.{\\resettimer} primitive@>
+primitive("setrandomseed",extension,set_random_seed_code);@/
+@!@:set_random_seed_code}{\.{\\setrandomseed} primitive@>
+
+@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode.
+
+@<Generate all \eTeX\ primitives@>=
+primitive("XeTeXpicfile",extension,pic_file_code);@/
+@!@:XeTeX_pic_file_}{\.{\\XeTeXpicfile} primitive@>
+primitive("XeTeXpdffile",extension,pdf_file_code);@/
+@!@:XeTeX_pdf_file_}{\.{\\XeTeXpdffile} primitive@>
+primitive("XeTeXglyph",extension,glyph_code);@/
+@!@:XeTeX_glyph_}{\.{\\XeTeXglyph} primitive@>
+primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/
+@!@:XeTeX_linebreak_locale_}{\.{\\XeTeXlinebreaklocale} primitive@>
+primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc);
+@!@:XeTeX_inter_char_toks_}{\.{\\XeTeXinterchartoks} primitive@>
+@#
+primitive("pdfsavepos",extension,pdf_save_pos_node);@/
+@!@:pdf_save_pos_}{\.{\\pdfsavepos} 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");
+ set_language_code:print_esc("setlanguage");
+ pdf_save_pos_node: print_esc("pdfsavepos");
+ reset_timer_code: print_esc("resettimer");
+ set_random_seed_code: print_esc("setrandomseed");
+ pic_file_code:print_esc("XeTeXpicfile");
+ pdf_file_code:print_esc("XeTeXpdffile");
+ glyph_code:print_esc("XeTeXglyph");
+ XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale");
+ XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding");
+ XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding");
+ 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}@>;
+ set_language_code:@<Implement \.{\\setlanguage}@>;
+ pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
+ reset_timer_code: @<Implement \.{\\resettimer}@>;
+ set_random_seed_code: @<Implement \.{\\setrandomseed}@>;
+ pic_file_code:@<Implement \.{\\XeTeXpicfile}@>;
+ pdf_file_code:@<Implement \.{\\XeTeXpdffile}@>;
+ glyph_code:@<Implement \.{\\XeTeXglyph}@>;
+ XeTeX_input_encoding_extension_code:@<Implement \.{\\XeTeXinputencoding}@>;
+ XeTeX_default_encoding_extension_code:@<Implement \.{\\XeTeXdefaultencoding}@>;
+ XeTeX_linebreak_locale_extension_code:@<Implement \.{\\XeTeXlinebreaklocale}@>;
+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;@!w:small_number);
+var p:pointer; {the new node}
+begin p:=get_node(w); type(p):=whatsit_node; subtype(p):=s;
+link(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,w);
+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_node_size); write_stream(tail):=null;
+p:=scan_toks(false,true); write_tokens(tail):=def_ref;
+end
+
+@ @d call_func(#) == begin if # <> 0 then do_nothing end
+@d flushable(#) == (# = str_ptr - 1)
+@d max_integer == @"7FFFFFFF {$2^{31}-1$}
+
+@p procedure flush_str(s: str_number); {flush a string if possible}
+begin
+ if flushable(s) then
+ flush_string;
+end;
+
+function tokens_to_string(p: pointer): str_number; {return a string from tokens
+list}
+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;
+ tokens_to_string:=make_string;
+end;
+
+procedure scan_pdf_ext_toks;
+begin
+ call_func(scan_toks(false, true)); {like \.{\\special}}
+end;
+
+procedure compare_strings; {to implement \.{\\strcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+ save_cur_cs: pointer;
+begin
+ save_cur_cs:=cur_cs; call_func(scan_toks(false, true));
+ s1:=tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ cur_cs:=save_cur_cs; call_func(scan_toks(false, true));
+ s2:=tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1:=str_start_macro(s1);
+ j1:=str_start_macro(s1 + 1);
+ i2:=str_start_macro(s2);
+ j2:=str_start_macro(s2 + 1);
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ cur_val:=-1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ cur_val:=1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ cur_val:=0
+ else if i1 < j1 then
+ cur_val:=1
+ else
+ cur_val:=-1;
+done:
+ flush_str(s2);
+ flush_str(s1);
+ cur_val_level:=int_val;
+end;
+
+@ @<Declare procedures that need to be declared forward for \pdfTeX@>=
+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;
+
+@ @<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 \.{\\setrandomseed}@>=
+begin
+ scan_int;
+ if cur_val<0 then negate(cur_val);
+ random_seed := cur_val;
+ init_randoms(random_seed);
+end
+
+@ @<Implement \.{\\resettimer}@>=
+begin
+ seconds_and_micros(epochseconds,microseconds);
+end
+
+@ 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;
+
+procedure print_native_word(@!p:pointer);
+var i,c,cc:integer;
+begin
+ for i:=0 to native_length(p) - 1 do begin
+ c:=get_native_char(p,i);
+ if (c >= @"D800) and (c <= @"DBFF) then begin
+ if i < native_length(p) - 1 then begin
+ cc:=get_native_char(p, i+1);
+ if (cc >= @"DC00) and (cc <= @"DFFF) then begin
+ c:=@"10000 + (c - @"D800) * @"400 + (cc - @"DC00);
+ print_char(c);
+ incr(i);
+ end else
+ print(".");
+ end else
+ print(".");
+ end else
+ print_char(c);
+ end
+end;
+
+@ @<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;
+language_node:begin print_esc("setlanguage");
+ print_int(what_lang(p)); print(" (hyphenmin ");
+ print_int(what_lhm(p)); print_char(",");
+ print_int(what_rhm(p)); print_char(")");
+ end;
+pdf_save_pos_node: print_esc("pdfsavepos");
+native_word_node, native_word_node_AT:begin print_esc(font_id_text(native_font(p)));
+ print_char(" ");
+ print_native_word(p);
+ end;
+glyph_node:begin print_esc(font_id_text(native_font(p)));
+ print(" glyph#");
+ print_int(native_glyph(p));
+ end;
+pic_node,pdf_node: begin
+ if subtype(p) = pic_node then print_esc("XeTeXpicfile")
+ else print_esc("XeTeXpdffile");
+ print(" """);
+ for i:=0 to pic_path_length(p)-1 do
+ print_visible_char(pic_path_byte(p, i));
+ print("""");
+ end;
+othercases print("whatsit?")
+endcases
+
+@ Picture nodes are tricky in that they are variable size.
+@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word))
+
+@<Make a partial copy of the whatsit...@>=
+case subtype(p) of
+open_node: begin r:=get_node(open_node_size); words:=open_node_size;
+ end;
+write_node,special_node: begin r:=get_node(write_node_size);
+ add_token_ref(write_tokens(p)); words:=write_node_size;
+ end;
+close_node,language_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+native_word_node, native_word_node_AT: begin words:=native_size(p);
+ r:=get_node(words);
+ while words > 0 do
+ begin decr(words); mem[r+words]:=mem[p+words]; end;
+ native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0;
+ copy_native_glyph_info(p, r);
+ end;
+glyph_node: begin r:=get_node(glyph_node_size);
+ words:=glyph_node_size;
+ end;
+pic_node,pdf_node: begin words:=total_pic_node_size(p);
+ r:=get_node(words);
+ end;
+pdf_save_pos_node:
+ r:=get_node(small_node_size);
+othercases confusion("ext2")
+@:this can't happen ext2}{\quad ext2@>
+endcases
+
+@ @<Wipe out the whatsit...@>=
+begin case subtype(p) of
+open_node: free_node(p,open_node_size);
+write_node,special_node: begin delete_token_ref(write_tokens(p));
+ free_node(p,write_node_size); goto done;
+ end;
+close_node,language_node: free_node(p,small_node_size);
+native_word_node, native_word_node_AT: begin free_native_glyph_info(p); free_node(p,native_size(p)); end;
+glyph_node: free_node(p,glyph_node_size);
+pic_node,pdf_node: free_node(p,total_pic_node_size(p));
+pdf_save_pos_node:
+ free_node(p, small_node_size);
+othercases confusion("ext3")
+@:this can't happen ext3}{\quad ext3@>
+endcases;@/
+goto done;
+end
+
+@ @<Incorporate a whatsit node into a vbox@>=
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ x:=x + d + height(p);
+ d:=depth(p);
+ if width(p) > w then w:=width(p);
+ end;
+end
+
+@ @<Incorporate a whatsit node into an hbox@>=
+begin
+ case subtype(p) of
+ native_word_node, native_word_node_AT: begin
+ { merge with any following word fragments in same font, discarding discretionary breaks }
+ if (q <> r+list_offset) and (type(q) = disc_node) then k:=replace_count(q) else k:=0;
+ while (link(q) <> p) do begin
+ decr(k);
+ q:=link(q); { bring q up in preparation for deletion of nodes starting at p }
+ if type(q) = disc_node then k:=replace_count(q);
+ end;
+ pp:=link(p);
+ restart:
+ if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin
+ if (type(pp) = whatsit_node)
+ and (is_native_word_subtype(pp))
+ and (native_font(pp) = native_font(p)) then begin
+ pp:=link(pp);
+ goto restart;
+ end
+ else if (type(pp) = disc_node) then begin
+ ppp:=link(pp);
+ if is_native_word_node(ppp) and (native_font(ppp) = native_font(p)) then begin
+ pp:=link(ppp);
+ goto restart;
+ end
+ end
+ end;
+
+ { now pp points to the non-|native_word| node that ended the chain, or null }
+
+ { we can just check type(p)=|whatsit_node| below, as we know that the chain
+ contains only discretionaries and |native_word| nodes, no other whatsits or |char_node|s }
+
+ if (pp <> link(p)) then begin
+ { found a chain of at least two pieces starting at p }
+ total_chars:=0;
+ p:=link(q); { the first fragment }
+ while (p <> pp) do begin
+ if (type(p) = whatsit_node) then
+ total_chars:=total_chars + native_length(p); { accumulate char count }
+ ppp:=p; { remember last node seen }
+ p:=link(p); { point to next fragment or discretionary or terminator }
+ end;
+
+ p:=link(q); { the first fragment again }
+ pp:=new_native_word_node(native_font(p), total_chars); { make new node for merged word }
+ subtype(pp):=subtype(p);
+ link(q):=pp; { link to preceding material }
+ link(pp):=link(ppp); { attach remainder of hlist to it }
+ link(ppp):=null; { and detach from the old fragments }
+
+ { copy the chars into new node }
+ total_chars:=0;
+ ppp:=p;
+ repeat
+ if (type(ppp) = whatsit_node) then
+ for k:=0 to native_length(ppp)-1 do begin
+ set_native_char(pp, total_chars, get_native_char(ppp, k));
+ incr(total_chars);
+ end;
+ ppp:=link(ppp);
+ until (ppp = null);
+
+ flush_node_list(p); { delete the fragments }
+ p:=link(q); { update p to point to the new node }
+ set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) }
+ end;
+
+ { now incorporate the |native_word| node measurements into the box we're packing }
+ if height(p) > h then
+ h:=height(p);
+ if depth(p) > d then
+ d:=depth(p);
+ x:=x + width(p);
+ end;
+ glyph_node, pic_node, pdf_node: begin
+ if height(p) > h then
+ h:=height(p);
+ if depth(p) > d then
+ d:=depth(p);
+ x:=x + width(p);
+ end;
+ othercases do_nothing
+ endcases;
+end
+
+@ @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>=
+if (is_native_word_subtype(p))
+or (subtype(p)=glyph_node)
+or (subtype(p)=pic_node)
+or (subtype(p)=pdf_node)
+then begin
+ d:=width(p);
+ goto found;
+end else
+ d:=0
+
+@ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then
+ begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
+ set_hyph_index;
+ end
+ else if (is_native_word_subtype(#))
+ or (subtype(#)=glyph_node)
+ or (subtype(#)=pic_node)
+ or (subtype(#)=pdf_node)
+ then
+ begin act_width:=act_width+width(#); end
+
+@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
+adv_past_linebreak(cur_p)
+
+@ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then
+ begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
+ set_hyph_index;
+ end
+
+@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
+adv_past_prehyph(s)
+
+@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ page_total:=page_total + page_depth + height(p);
+ page_depth:=depth(p);
+ end;
+ goto contribute;
+end
+
+@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ cur_height:=cur_height + prev_dp + height(p); prev_dp:=depth(p);
+ end;
+ goto not_found;
+end
+
+@ @<Output the whatsit node |p| in a vlist@>=
+begin
+ case subtype(p) of
+ glyph_node: begin
+ cur_v:=cur_v+height(p);
+ cur_h:=left_edge;
+ synch_h; synch_v; {Sync DVI state to TeX state}
+ f:=native_font(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ dvi_out(set_glyphs);
+ dvi_four(0); { width }
+ dvi_two(1); { glyph count }
+ dvi_four(0); { x-offset as fixed point }
+ dvi_four(0); { y-offset as fixed point }
+ dvi_two(native_glyph(p));
+ cur_v:=cur_v+depth(p);
+ cur_h:=left_edge;
+ end;
+ pic_node, pdf_node: begin
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=cur_v+height(p);
+ pic_out(p);
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end;
+ pdf_save_pos_node: @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+ othercases out_what(p)
+ endcases
+end
+
+@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
+begin
+ pdf_last_x_pos:=cur_h + 4736286;
+ pdf_last_y_pos:=cur_page_height - cur_v - 4736286;
+end
+
+@ @<Calculate page dimensions and margins@>=
+cur_h_offset:=h_offset + (unity * 7227) / 100;
+cur_v_offset:=v_offset + (unity * 7227) / 100;
+if pdf_page_width <> 0 then
+ cur_page_width:=pdf_page_width
+else
+ cur_page_width:=width(p) + 2*cur_h_offset;
+if pdf_page_height <> 0 then
+ cur_page_height:=pdf_page_height
+else
+ cur_page_height:=height(p) + depth(p) + 2*cur_v_offset
+
+@ @<Glob...@>=
+@!cur_page_width: scaled; {width of page being shipped}
+@!cur_page_height: scaled; {height of page being shipped}
+@!cur_h_offset: scaled; {horizontal offset of page being shipped}
+@!cur_v_offset: scaled; {vertical offset of page being shipped}
+
+@ @<Output the whatsit node |p| in an hlist@>=
+begin
+ case subtype(p) of
+ native_word_node, native_word_node_AT, glyph_node: begin
+ synch_h; synch_v; {Sync DVI state to TeX state}
+ f:=native_font(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+ if subtype(p) = glyph_node then begin
+ dvi_out(set_glyphs);
+ dvi_four(width(p));
+ dvi_two(1); { glyph count }
+ dvi_four(0); { x-offset as fixed point }
+ dvi_four(0); { y-offset as fixed point }
+ dvi_two(native_glyph(p));
+ cur_h:=cur_h + width(p);
+ end else begin
+ if subtype(p)=native_word_node_AT then begin
+ if (native_length(p) > 0) or (native_glyph_info_ptr(p) <> null_ptr) then begin
+ dvi_out(set_text_and_glyphs);
+ len:=native_length(p);
+ dvi_two(len);
+ for k:=0 to len-1 do begin
+ dvi_two(get_native_char(p, k));
+ end;
+ len:=make_xdv_glyph_array_data(p);
+ for k:=0 to len-1 do
+ dvi_out(xdv_buffer_byte(k));
+ end
+ end else begin
+ if native_glyph_info_ptr(p) <> null_ptr then begin
+ dvi_out(set_glyphs);
+ len:=make_xdv_glyph_array_data(p);
+ for k:=0 to len-1 do
+ dvi_out(xdv_buffer_byte(k));
+ end
+ end;
+ cur_h:=cur_h + width(p);
+ end;
+ dvi_h:=cur_h;
+ end;
+ pic_node, pdf_node: begin
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line;
+ edge:=cur_h+width(p);
+ pic_out(p);
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge; cur_v:=base_line;
+ end;
+ pdf_save_pos_node: @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+ othercases out_what(p)
+ endcases
+end
+
+@ 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;@/
+doing_special:=true;
+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}
+doing_special:=false;
+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}
+@!k:integer;
+@!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 pic_out(@!p:pointer);
+var old_setting:0..max_selector; {holds print |selector|}
+ i:integer;
+ k:pool_pointer; {index into |str_pool|}
+begin
+synch_h; synch_v;
+old_setting:=selector; selector:=new_string;
+print("pdf:image ");
+print("matrix ");
+print_scaled(pic_transform1(p)); print(" ");
+print_scaled(pic_transform2(p)); print(" ");
+print_scaled(pic_transform3(p)); print(" ");
+print_scaled(pic_transform4(p)); print(" ");
+print_scaled(pic_transform5(p)); print(" ");
+print_scaled(pic_transform6(p)); print(" ");
+print("page "); print_int(pic_page(p)); print(" ");
+case pic_pdf_box(p) of
+ pdfbox_crop: print("pagebox cropbox ");
+ pdfbox_media: print("pagebox mediabox ");
+ pdfbox_bleed: print("pagebox bleedbox ");
+ pdfbox_art: print("pagebox artbox ");
+ pdfbox_trim: print("pagebox trimbox ");
+ others: do_nothing;
+endcases;
+print("(");
+for i:=0 to pic_path_length(p)-1 do
+ print_visible_char(pic_path_byte(p, i));
+print(")");
+selector:=old_setting;
+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;
+
+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);
+language_node:do_nothing;
+othercases confusion("ext4")
+@:this can't happen ext4}{\quad ext4@>
+endcases;
+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 a_close(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 a_open_out(write_file[j]) do
+ prompt_file_name("output file name",".tex");
+ 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)and(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; link(p):=null;
+ end
+else back_input;
+end
+
+@ The \.{\\language} extension is somewhat different.
+We need a subroutine that comes into play when a character of
+a non-|clang| language is being appended to the current paragraph.
+
+@<Declare action...@>=
+procedure fix_language;
+var @!l:ASCII_code; {the new current language}
+begin if language<=0 then l:=0
+else if language>255 then l:=0
+else l:=language;
+if l<>clang then
+ begin new_whatsit(language_node,small_node_size);
+ what_lang(tail):=l; clang:=l;@/
+ what_lhm(tail):=norm_min(left_hyphen_min);
+ what_rhm(tail):=norm_min(right_hyphen_min);
+ end;
+end;
+
+@ @<Implement \.{\\setlanguage}@>=
+if abs(mode)<>hmode then report_illegal_case
+else begin new_whatsit(language_node,small_node_size);
+ scan_int;
+ if cur_val<=0 then clang:=0
+ else if cur_val>255 then clang:=0
+ else clang:=cur_val;
+ what_lang(tail):=clang;
+ what_lhm(tail):=norm_min(left_hyphen_min);
+ what_rhm(tail):=norm_min(right_hyphen_min);
+ end
+
+@ @<Finish the extensions@>=
+terminate_font_manager;
+for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+
+@ @<Implement \.{\\XeTeXpicfile}@>=
+if abs(mode)=mmode then report_illegal_case
+else load_picture(false)
+
+@ @<Implement \.{\\XeTeXpdffile}@>=
+if abs(mode)=mmode then report_illegal_case
+else load_picture(true)
+
+@ @<Implement \.{\\XeTeXglyph}@>=
+begin
+ if abs(mode)=vmode then begin
+ back_input;
+ new_graf(true);
+ end else if abs(mode)=mmode then report_illegal_case
+ else begin
+ if is_native_font(cur_font) then begin
+ new_whatsit(glyph_node,glyph_node_size);
+ scan_int;
+ if (cur_val<0)or(cur_val>65535) then
+ begin print_err("Bad glyph number");
+ help2("A glyph number must be between 0 and 65535.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+ native_font(tail):=cur_font;
+ native_glyph(tail):=cur_val;
+ set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics);
+ end else not_native_font_error(extension, glyph_code, cur_font);
+ end
+end
+
+@ Load a picture file and handle following keywords.
+
+@d calc_min_and_max==
+ begin
+ xmin:=1000000.0;
+ xmax:=-xmin;
+ ymin:=xmin;
+ ymax:=xmax;
+ for i:=0 to 3 do begin
+ if xCoord(corners[i]) < xmin then xmin:=xCoord(corners[i]);
+ if xCoord(corners[i]) > xmax then xmax:=xCoord(corners[i]);
+ if yCoord(corners[i]) < ymin then ymin:=yCoord(corners[i]);
+ if yCoord(corners[i]) > ymax then ymax:=yCoord(corners[i]);
+ end;
+ end
+
+@d update_corners==
+ for i:=0 to 3 do
+ transform_point(addressof(corners[i]), addressof(t2))
+
+@d do_size_requests==begin
+ { calculate current width and height }
+ calc_min_and_max;
+ if x_size_req = 0.0 then begin
+ make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin));
+ end else if y_size_req = 0.0 then begin
+ make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin));
+ end else begin
+ make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin));
+ end;
+ update_corners;
+ x_size_req:=0.0;
+ y_size_req:=0.0;
+ transform_concat(addressof(t), addressof(t2));
+end
+
+@<Declare procedures needed in |do_extension|@>=
+procedure load_picture(@!is_pdf:boolean);
+var
+ pic_path: ^char;
+ bounds: real_rect;
+ t, t2: transform;
+ corners: array[0..3] of real_point;
+ x_size_req,y_size_req: real;
+ check_keywords: boolean;
+ xmin,xmax,ymin,ymax: real;
+ i: small_number;
+ page: integer;
+ pdf_box_type: integer;
+ result: integer;
+begin
+ { scan the filename and pack into |name_of_file| }
+ scan_file_name;
+ pack_cur_name;
+
+ pdf_box_type:=0;
+ page:=0;
+ if is_pdf then begin
+ if scan_keyword("page") then begin
+ scan_int;
+ page:=cur_val;
+ end;
+ pdf_box_type:=pdfbox_none;
+ if scan_keyword("crop") then pdf_box_type:=pdfbox_crop
+ else if scan_keyword("media") then pdf_box_type:=pdfbox_media
+ else if scan_keyword("bleed") then pdf_box_type:=pdfbox_bleed
+ else if scan_keyword("trim") then pdf_box_type:=pdfbox_trim
+ else if scan_keyword("art") then pdf_box_type:=pdfbox_art;
+ end;
+
+ { access the picture file and check its size }
+ if pdf_box_type=pdfbox_none then
+ result:=find_pic_file(addressof(pic_path), addressof(bounds), pdfbox_crop, page)
+ else
+ result:=find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page);
+
+ setPoint(corners[0], xField(bounds), yField(bounds));
+ setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds));
+ setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1]));
+ setPoint(corners[3], xField(corners[2]), yField(corners[0]));
+
+ x_size_req:=0.0;
+ y_size_req:=0.0;
+
+ { look for any scaling requests for this picture }
+ make_identity(addressof(t));
+
+ check_keywords:=true;
+ while check_keywords do begin
+ if scan_keyword("scaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("xscaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("yscaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("width") then begin
+ scan_normal_dimen;
+ if cur_val <= 0 then begin
+ print_err("Improper image ");
+ print("size (");
+ print_scaled(cur_val);
+ print("pt) will be ignored");
+ help2("I can't scale images to zero or negative sizes,")@/
+ ("so I'm ignoring this.");
+ error;
+ end else
+ x_size_req:=Fix2D(cur_val);
+ end else if scan_keyword("height") then begin
+ scan_normal_dimen;
+ if cur_val <= 0 then begin
+ print_err("Improper image ");
+ print("size (");
+ print_scaled(cur_val);
+ print("pt) will be ignored");
+ help2("I can't scale images to zero or negative sizes,")@/
+ ("so I'm ignoring this.");
+ error;
+ end else
+ y_size_req:=Fix2D(cur_val);
+ end else if scan_keyword("rotated") then begin
+ scan_decimal;
+ if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
+ make_rotation(addressof(t2), Fix2D(cur_val) * 3.141592653589793 / 180.0);
+ update_corners;
+ calc_min_and_max;
+ setPoint(corners[0], xmin, ymin);
+ setPoint(corners[1], xmin, ymax);
+ setPoint(corners[2], xmax, ymax);
+ setPoint(corners[3], xmax, ymin);
+ transform_concat(addressof(t), addressof(t2));
+ end else
+ check_keywords:=false;
+ end;
+
+ if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
+
+ calc_min_and_max;
+ make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27);
+ transform_concat(addressof(t), addressof(t2));
+
+ if result = 0 then begin
+ new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word));
+ if is_pdf then begin
+ subtype(tail):=pdf_node;
+ end;
+ pic_path_length(tail):=strlen(pic_path);
+ pic_page(tail):=page;
+ pic_pdf_box(tail):=pdf_box_type;
+
+ width(tail):=D2Fix(xmax - xmin);
+ height(tail):=D2Fix(ymax - ymin);
+ depth(tail):=0;
+
+ pic_transform1(tail):=D2Fix(aField(t));
+ pic_transform2(tail):=D2Fix(bField(t));
+ pic_transform3(tail):=D2Fix(cField(t));
+ pic_transform4(tail):=D2Fix(dField(t));
+ pic_transform5(tail):=D2Fix(xField(t));
+ pic_transform6(tail):=D2Fix(yField(t));
+
+ memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path));
+ libc_free(pic_path);
+ end else begin
+ print_err("Unable to load picture or PDF file '");
+ print_file_name(cur_name,cur_area,cur_ext); print("'");
+ if result = -43 then begin { Mac OS file not found error }
+ help2("The requested image couldn't be read because")@/
+ ("the file was not found.");
+ end
+ else begin { otherwise assume GraphicImport failed }
+ help2("The requested image couldn't be read because")@/
+ ("it was not a recognized image format.");
+ end;
+ error;
+ end;
+end;
+
+@ @<Implement \.{\\XeTeXinputencoding}@>=
+begin
+ scan_and_pack_name; {scan a filename-like arg for the input encoding}
+
+ i:=get_encoding_mode_and_info(addressof(j)); {convert it to |mode| and |encoding| values}
+ if i = XeTeX_input_mode_auto then begin
+ print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding");
+ help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding.")@/
+ ("I'll ignore this and leave the current encoding unchanged.");@/
+ error;
+ end else set_input_file_encoding(input_file[in_open], i, j); {apply them to the current input file}
+end
+
+@ @<Implement \.{\\XeTeXdefaultencoding}@>=
+begin
+ scan_and_pack_name; {scan a filename-like arg for the input encoding}
+
+ i:=get_encoding_mode_and_info(addressof(j)); {convert it to |mode| and |encoding| values}
+ XeTeX_default_input_mode:=i; {store them as defaults for new input files}
+ XeTeX_default_input_encoding:=j;
+end
+
+@ @<Implement \.{\\XeTeXlinebreaklocale}@>=
+begin
+ scan_file_name; {scan a filename-like arg for the locale name}
+ if length(cur_name) = 0 then XeTeX_linebreak_locale:=0
+ else XeTeX_linebreak_locale:=cur_name; {we ignore the area and extension!}
+end
+
+@ @<Glob...@>=
+@!pdf_last_x_pos: integer;
+@!pdf_last_y_pos: integer;
+
+@ @<Implement \.{\\pdfsavepos}@>=
+begin
+ new_whatsit(pdf_save_pos_node, small_node_size);
+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 (buffer[loc]="*")and(format_ident=" (INITEX)") then
+ begin no_new_control_sequence:=false;
+ @<Generate all \eTeX\ primitives@>@;
+ incr(loc); eTeX_mode:=1; {enter extended mode}
+ @<Initialize variables for \eTeX\ extended mode@>@;
+ 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 eTeX_state_base=int_base+eTeX_state_code
+@d eTeX_state(#)==eqtb[eTeX_state_base+#].int {an \eTeX\ state variable}
+@#
+@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
+
+@<Generate all \eTeX...@>=
+primitive("lastnodetype",last_item,last_node_type_code);
+@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
+primitive("eTeXversion",last_item,eTeX_version_code);
+@!@:eTeX_version_}{\.{\\eTeXversion} primitive@>
+primitive("eTeXrevision",convert,eTeX_revision_code);@/
+@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+
+primitive("XeTeXversion",last_item,XeTeX_version_code);
+@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@>
+primitive("XeTeXrevision",convert,XeTeX_revision_code);@/
+@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@>
+
+primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code);
+
+primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code);
+primitive("XeTeXvariation",last_item,XeTeX_variation_code);
+primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code);
+primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code);
+primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code);
+primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code);
+
+primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code);
+primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code);
+primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code);
+primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code);
+primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code);
+primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code);
+primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code);
+primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code);
+
+primitive("XeTeXvariationname",convert,XeTeX_variation_name_code);
+primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code);
+primitive("XeTeXselectorname",convert,XeTeX_selector_name_code);
+
+primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code);
+primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code);
+primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code);
+primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code);
+primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code);
+primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code);
+
+primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code);
+primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code);
+primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code);
+
+primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code);
+
+primitive("XeTeXfonttype", last_item, XeTeX_font_type_code);
+
+primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code);
+primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code);
+
+primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code);
+
+@ @<Cases of |last_item| for |print_cmd_chr|@>=
+last_node_type_code: print_esc("lastnodetype");
+eTeX_version_code: print_esc("eTeXversion");
+XeTeX_version_code: print_esc("XeTeXversion");
+
+XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs");
+
+XeTeX_count_variations_code: print_esc("XeTeXcountvariations");
+XeTeX_variation_code: print_esc("XeTeXvariation");
+XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname");
+XeTeX_variation_min_code: print_esc("XeTeXvariationmin");
+XeTeX_variation_max_code: print_esc("XeTeXvariationmax");
+XeTeX_variation_default_code: print_esc("XeTeXvariationdefault");
+
+XeTeX_count_features_code: print_esc("XeTeXcountfeatures");
+XeTeX_feature_code_code: print_esc("XeTeXfeaturecode");
+XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname");
+XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature");
+XeTeX_count_selectors_code: print_esc("XeTeXcountselectors");
+XeTeX_selector_code_code: print_esc("XeTeXselectorcode");
+XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname");
+XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector");
+
+XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts");
+XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages");
+XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures");
+XeTeX_OT_script_code: print_esc("XeTeXOTscripttag");
+XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag");
+XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag");
+
+XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph");
+XeTeX_glyph_index_code: print_esc("XeTeXglyphindex");
+XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds");
+
+XeTeX_font_type_code: print_esc("XeTeXfonttype");
+
+XeTeX_first_char_code: print_esc("XeTeXfirstfontchar");
+XeTeX_last_char_code: print_esc("XeTeXlastfontchar");
+
+XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount");
+
+@ @<Cases for fetching an integer value@>=
+eTeX_version_code: cur_val:=eTeX_version;
+XeTeX_version_code: cur_val:=XeTeX_version;
+
+XeTeX_count_glyphs_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then
+ cur_val:=aat_font_get(m - XeTeX_int, font_layout_engine[n])
+ else if is_otgr_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else
+ cur_val:=0;
+ end;
+
+XeTeX_count_features_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then
+ cur_val:=aat_font_get(m - XeTeX_int, font_layout_engine[n])
+ else if is_gr_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else
+ cur_val:=0;
+ end;
+
+XeTeX_variation_code,
+XeTeX_variation_min_code,
+XeTeX_variation_max_code,
+XeTeX_variation_default_code,
+XeTeX_count_variations_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ cur_val:=0; {Deprecated}
+ end;
+
+XeTeX_feature_code_code,
+XeTeX_is_exclusive_feature_code,
+XeTeX_count_selectors_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then begin
+ scan_int; k:=cur_val;
+ cur_val:=aat_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val;
+ cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else begin
+ not_aat_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_selector_code_code,
+XeTeX_is_default_selector_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=aat_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else begin
+ not_aat_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_variation_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=aat_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else begin
+ not_aat_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_feature_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=aat_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else if is_gr_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else begin
+ not_aat_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_selector_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then begin
+ scan_int; k:=cur_val; scan_and_pack_name;
+ cur_val:=aat_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val; scan_and_pack_name;
+ cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else begin
+ not_aat_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_count_scripts_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else begin
+ cur_val:=0;
+ end;
+ end;
+
+XeTeX_OT_count_languages_code,
+XeTeX_OT_script_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int;
+ cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_count_features_code,
+XeTeX_OT_language_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_feature_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int;
+ cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_map_char_to_glyph_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n)
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+XeTeX_glyph_index_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_and_pack_name;
+ cur_val:=map_glyph_to_index(cur_font)
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+XeTeX_font_type_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_aat_font(n) then cur_val:=1
+ else if is_ot_font(n) then cur_val:=2
+ else if is_gr_font(n) then cur_val:=3
+ else cur_val:=0;
+ end;
+
+XeTeX_first_char_code,XeTeX_last_char_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_native_font(n) then
+ cur_val:=get_font_char_range(n, m = XeTeX_first_char_code)
+ else begin
+ if m = XeTeX_first_char_code then cur_val:=font_bc[n]
+ else cur_val:=font_ec[n];
+ end
+ end;
+
+ pdf_last_x_pos_code: cur_val:=pdf_last_x_pos;
+ pdf_last_y_pos_code: cur_val:=pdf_last_y_pos;
+
+XeTeX_pdf_page_count_code:
+ begin
+ scan_and_pack_name;
+ cur_val:=count_pdf_file_pages;
+ end;
+
+@ Slip in an extra procedure here and there....
+
+@<Error hand...@>=
+procedure scan_and_pack_name; forward;
+
+@ @<Declare procedures needed in |do_extension|@>=
+procedure scan_and_pack_name;
+begin
+ scan_file_name; pack_cur_name;
+end;
+
+@ @<Declare the procedure called |print_cmd_chr|@>=
+procedure not_aat_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an AAT font");
+ error;
+end;
+
+procedure not_aat_gr_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an AAT or Graphite font");
+ error;
+end;
+
+procedure not_ot_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an OpenType Layout font");
+ error;
+end;
+
+procedure not_native_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not a native platform font");
+ error;
+end;
+
+@ @<Cases for fetching a dimension value@>=
+XeTeX_glyph_bounds_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom }
+ if (n < 1) or (n > 4) then begin
+ print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;");
+ print_nl("I don't know anything about edge "); print_int(n);
+ error;
+ cur_val:=0;
+ end else begin
+ scan_int; { glyph number }
+ cur_val:=get_glyph_bounds(cur_font, n, cur_val);
+ end
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+XeTeX_revision_code: print_esc("XeTeXrevision");
+
+XeTeX_variation_name_code: print_esc("XeTeXvariationname");
+XeTeX_feature_name_code: print_esc("XeTeXfeaturename");
+XeTeX_selector_name_code: print_esc("XeTeXselectorname");
+XeTeX_glyph_name_code: print_esc("XeTeXglyphname");
+
+XeTeX_Uchar_code: print_esc("Uchar");
+XeTeX_Ucharcat_code: print_esc("Ucharcat");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+XeTeX_revision_code: do_nothing;
+
+XeTeX_variation_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_aat_font(fnt) then begin
+ scan_int; arg1:=cur_val; arg2:=0;
+ end else
+ not_aat_font_error(convert, c, fnt);
+ end;
+
+XeTeX_feature_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_aat_font(fnt) or is_gr_font(fnt) then begin
+ scan_int; arg1:=cur_val; arg2:=0;
+ end else
+ not_aat_gr_font_error(convert, c, fnt);
+ end;
+
+XeTeX_selector_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_aat_font(fnt) or is_gr_font(fnt) then begin
+ scan_int; arg1:=cur_val; scan_int; arg2:=cur_val;
+ end else
+ not_aat_gr_font_error(convert, c, fnt);
+ end;
+
+XeTeX_glyph_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_native_font(fnt) then begin
+ scan_int; arg1:=cur_val;
+ end else
+ not_native_font_error(convert, c, fnt);
+ end;
+
+@ @<Cases of `Print the result of command |c|'@>=
+XeTeX_revision_code: print(XeTeX_revision);
+
+XeTeX_variation_name_code:
+ if is_aat_font(fnt) then
+ aat_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
+
+XeTeX_feature_name_code,
+XeTeX_selector_name_code:
+ if is_aat_font(fnt) then
+ aat_print_font_name(c, font_layout_engine[fnt], arg1, arg2)
+ else if is_gr_font(fnt) then
+ gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
+
+XeTeX_glyph_name_code:
+ if is_native_font(fnt) then print_glyph_name(fnt, arg1);
+
+@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
+
+@<Glob...@>=
+@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
+
+@ @<Initialize table entries...@>=
+eTeX_mode:=0; {initially we are in compatibility mode}
+@<Initialize variables for \eTeX\ compatibility mode@>@;
+
+@ @<Dump the \eTeX\ state@>=
+dump_int(eTeX_mode);
+{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped }
+
+@ @<Undump the \eTeX\ state@>=
+undump(0)(1)(eTeX_mode);
+if eTeX_ex then
+ begin @<Initialize variables for \eTeX\ extended mode@>@;
+ end
+else begin @<Initialize variables for \eTeX\ compatibility mode@>@;
+ end;
+
+@ The |eTeX_enabled| function simply returns its first argument as
+result. This argument is |true| if an optional \eTeX\ feature is
+currently enabled; otherwise, if the argument is |false|, the function
+gives an error message.
+
+@<Declare \eTeX\ procedures for use...@>=
+function eTeX_enabled(@!b:boolean;@!j:quarterword;@!k:halfword):boolean;
+begin if not b then
+ begin print_err("Improper "); print_cmd_chr(j,k);
+ help1("Sorry, this optional e-TeX feature has been disabled."); error;
+ end;
+eTeX_enabled:=b;
+end;
+
+@ 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@>
+
+@ @d every_eof==equiv(every_eof_loc)
+
+@<Cases of |assign_toks| for |print_cmd_chr|@>=
+every_eof_loc: print_esc("everyeof");
+XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks");
+
+@ @<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");
+
+@ 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:=link(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("fontcharwd",last_item,font_char_wd_code);
+@!@:font_char_wd_}{\.{\\fontcharwd} primitive@>
+primitive("fontcharht",last_item,font_char_ht_code);
+@!@:font_char_ht_}{\.{\\fontcharht} primitive@>
+primitive("fontchardp",last_item,font_char_dp_code);
+@!@:font_char_dp_}{\.{\\fontchardp} primitive@>
+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_usv_num;
+ if is_native_font(q) then begin
+ case m of
+ font_char_wd_code: cur_val:=getnativecharwd(q, cur_val);
+ font_char_ht_code: cur_val:=getnativecharht(q, cur_val);
+ font_char_dp_code: cur_val:=getnativechardp(q, cur_val);
+ font_char_ic_code: cur_val:=getnativecharic(q, cur_val);
+ end; {there are no other cases}
+ end else begin
+ if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
+ end
+ 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>info(par_shape_ptr) then cur_val:=info(par_shape_ptr);
+ cur_val:=mem[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;
+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_head)| and ends at |cur_val|. (If |cur_val=temp_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;
+def_ref:=get_avail; token_ref_count(def_ref):=null; 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_head @+ else cur_val:=p;
+link(temp_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_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:=link(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:=subtype(p); l:=if_line_field(p); m:=type(p); p:=link(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")
+
+@ In constructions such as
+$$\vbox{\halign{\.{#}\hfil\cr
+{}\\hbox to \\hsize\{\cr
+\hskip 25pt \\hskip 0pt plus 0.0001fil\cr
+\hskip 25pt ...\cr
+\hskip 25pt \\hfil\\penalty-200\\hfilneg\cr
+\hskip 25pt ...\}\cr}}$$
+the stretch components of \.{\\hfil} and \.{\\hfilneg} compensate; they may,
+however, get modified in order to prevent arithmetic overflow during
+|hlist_out| when each of them is multiplied by a large |glue_set| value.
+
+Since this ``glue rounding'' depends on state variables |cur_g| and
+|cur_glue| and \TeXXeT\ is supposed to emulate the behaviour of \TeXeT\
+(plus a suitable postprocessor) as close as possible the glue rounding
+cannot be postponed until (segments of) an hlist has been reversed.
+
+The code below is invoked after the effective width, |rule_wd|, of a glue
+node has been computed. The glue node is either converted into a kern node
+or, for leaders, the glue specification is replaced by an equivalent rigid
+one; the subtype of the glue node remains unchanged.
+
+@<Handle a glue node for mixed...@>=
+if (((g_sign=stretching) and (stretch_order(g)=g_order)) or
+ ((g_sign=shrinking) and (shrink_order(g)=g_order))) then
+ begin fast_delete_glue_ref(g);
+ if subtype(p)<a_leaders then
+ begin type(p):=kern_node; width(p):=rule_wd;
+ end
+ else begin g:=get_node(glue_spec_size);@/
+ stretch_order(g):=filll+1; shrink_order(g):=filll+1; {will never match}
+ width(g):=rule_wd; stretch(g):=0; shrink(g):=0; glue_ptr(p):=g;
+ end;
+ end
+
+@ The optional |TeXXeT| feature of \eTeX\ contains the code for mixed
+left-to-right and right-to-left typesetting. This code is inspired by
+but different from \TeXeT\ as presented by Donald~E. Knuth and Pierre
+MacKay in {\sl TUGboat\/} {\bf 8}, 14--25, 1987.
+@^Knuth, Donald Ervin@>
+@^MacKay, Pierre@>
+
+In order to avoid confusion with \TeXeT\ the present implementation of
+mixed direction typesetting is called \TeXXeT. It differs from \TeXeT\
+in several important aspects: (1)~Right-to-left text is reversed
+explicitly by the |ship_out| routine and is written to a normal \.{DVI}
+file without any |begin_reflect| or |end_reflect| commands; (2)~a
+|math_node| is (ab)used instead of a |whatsit_node| to record the
+\.{\\beginL}, \.{\\endL}, \.{\\beginR}, and \.{\\endR} text direction
+primitives in order to keep the influence on the line breaking algorithm
+for pure left-to-right text as small as possible; (3)~right-to-left text
+interrupted by a displayed equation is automatically resumed after that
+equation; and (4)~the |valign| command code with a non-zero command
+modifier is (ab)used for the text direction primitives.
+
+Nevertheless there is a subtle difference between \TeX\ and \TeXXeT\
+that may influence the line breaking algorithm for pure left-to-right
+text. When a paragraph containing math mode material is broken into
+lines \TeX\ may generate lines where math mode material is not enclosed
+by properly nested \.{\\mathon} and \.{\\mathoff} nodes. Unboxing such
+lines as part of a new paragraph may have the effect that hyphenation is
+attempted for `words' originating from math mode or that hyphenation is
+inhibited for words originating from horizontal mode.
+
+In \TeXXeT\ additional \.{\\beginM}, resp.\ \.{\\endM} math nodes are
+supplied at the start, resp.\ end of lines such that math mode material
+inside a horizontal list always starts with either \.{\\mathon} or
+\.{\\beginM} and ends with \.{\\mathoff} or \.{\\endM}. These
+additional nodes are transparent to operations such as \.{\\unskip},
+\.{\\lastpenalty}, or \.{\\lastbox} but they do have the effect that
+hyphenation is never attempted for `words' originating from math mode
+and is never inhibited for words originating from horizontal mode.
+
+@d TeXXeT_state==eTeX_state(TeXXeT_code)
+@d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?}
+
+@d XeTeX_upwards_state==eTeX_state(XeTeX_upwards_code)
+@d XeTeX_upwards==(XeTeX_upwards_state>0)
+
+@d XeTeX_use_glyph_metrics_state==eTeX_state(XeTeX_use_glyph_metrics_code)
+@d XeTeX_use_glyph_metrics==(XeTeX_use_glyph_metrics_state>0)
+
+@d XeTeX_inter_char_tokens_state==eTeX_state(XeTeX_inter_char_tokens_code)
+@d XeTeX_inter_char_tokens_en==(XeTeX_inter_char_tokens_state>0)
+
+@d XeTeX_dash_break_state == eTeX_state(XeTeX_dash_break_code)
+@d XeTeX_dash_break_en == (XeTeX_dash_break_state>0)
+
+@d XeTeX_input_normalization_state == eTeX_state(XeTeX_input_normalization_code)
+@d XeTeX_tracing_fonts_state == eTeX_state(XeTeX_tracing_fonts_code)
+
+@d XeTeX_interword_space_shaping_state==eTeX_state(XeTeX_interword_space_shaping_code)
+
+@d XeTeX_generate_actual_text_state == eTeX_state(XeTeX_generate_actual_text_code)
+@d XeTeX_generate_actual_text_en == (XeTeX_generate_actual_text_state>0)
+
+@d XeTeX_default_input_mode == eTeX_state(XeTeX_default_input_mode_code)
+@d XeTeX_default_input_encoding == eTeX_state(XeTeX_default_input_encoding_code)
+
+@d XeTeX_hyphenatable_length == eTeX_state(XeTeX_hyphenatable_length_code)
+
+@<Cases for |print_param|@>=
+suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror");
+eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate");
+eTeX_state_code+XeTeX_upwards_code:print_esc("XeTeXupwardsmode");
+eTeX_state_code+XeTeX_use_glyph_metrics_code:print_esc("XeTeXuseglyphmetrics");
+eTeX_state_code+XeTeX_inter_char_tokens_code:print_esc("XeTeXinterchartokenstate");
+eTeX_state_code+XeTeX_dash_break_code:print_esc("XeTeXdashbreakstate");
+eTeX_state_code+XeTeX_input_normalization_code:print_esc("XeTeXinputnormalization");
+eTeX_state_code+XeTeX_tracing_fonts_code:print_esc("XeTeXtracingfonts");
+eTeX_state_code+XeTeX_interword_space_shaping_code:print_esc("XeTeXinterwordspaceshaping");
+eTeX_state_code+XeTeX_generate_actual_text_code:print_esc("XeTeXgenerateactualtext");
+eTeX_state_code+XeTeX_hyphenatable_length_code:print_esc("XeTeXhyphenatablelength");
+
+@ @<Generate all \eTeX...@>=
+primitive("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code);@/
+primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code);
+@!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@>
+primitive("XeTeXupwardsmode",assign_int,eTeX_state_base+XeTeX_upwards_code);
+@!@:XeTeX_upwards_mode_}{\.{\\XeTeXupwardsmode} primitive@>
+primitive("XeTeXuseglyphmetrics",assign_int,eTeX_state_base+XeTeX_use_glyph_metrics_code);
+@!@:XeTeX_use_glyph_metrics_}{\.{\\XeTeXuseglyphmetrics} primitive@>
+primitive("XeTeXinterchartokenstate",assign_int,eTeX_state_base+XeTeX_inter_char_tokens_code);
+@!@:XeTeX_use_inter_char_tokens_}{\.{\\XeTeXinterchartokenstate} primitive@>
+
+primitive("XeTeXdashbreakstate",assign_int,eTeX_state_base+XeTeX_dash_break_code);
+@!@:XeTeX_dash_break_state_}{\.{\\XeTeXdashbreakstate} primitive@>
+
+primitive("XeTeXinputnormalization",assign_int,eTeX_state_base+XeTeX_input_normalization_code);
+@!@:XeTeX_input_normalization_}{\.{\\XeTeXinputnormalization} primitive@>
+
+primitive("XeTeXtracingfonts",assign_int,eTeX_state_base+XeTeX_tracing_fonts_code);
+
+primitive("XeTeXinterwordspaceshaping",assign_int,eTeX_state_base+XeTeX_interword_space_shaping_code);
+@!@:XeTeX_interword_space_shaping_}{\.{\\XeTeXinterwordspaceshaping} primitive@>
+
+primitive("XeTeXgenerateactualtext",assign_int,eTeX_state_base+XeTeX_generate_actual_text_code);
+@!@:XeTeX_generate_actual_text_}{\.{\\XeTeXgenerateactualtext} primitive@>
+
+primitive("XeTeXhyphenatablelength",assign_int,eTeX_state_base+XeTeX_hyphenatable_length_code);
+@!@:XeTeX_hyphenatable_length_}{\.{\\XeTeXhyphenatablelength} primitive@>
+
+primitive("XeTeXinputencoding",extension,XeTeX_input_encoding_extension_code);
+primitive("XeTeXdefaultencoding",extension,XeTeX_default_encoding_extension_code);
+primitive("beginL",valign,begin_L_code);
+@!@:beginL_}{\.{\\beginL} primitive@>
+primitive("endL",valign,end_L_code);
+@!@:endL_}{\.{\\endL} primitive@>
+primitive("beginR",valign,begin_R_code);
+@!@:beginR_}{\.{\\beginR} primitive@>
+primitive("endR",valign,end_R_code);
+@!@:endR_}{\.{\\endR} primitive@>
+
+@ @<Cases of |valign| for |print_cmd_chr|@>=
+else case chr_code of
+ begin_L_code: print_esc("beginL");
+ end_L_code: print_esc("endL");
+ begin_R_code: print_esc("beginR");
+ othercases print_esc("endR")
+ endcases
+
+@ @<Cases of |main_control| for |hmode+valign|@>=
+if cur_chr>0 then
+ begin if eTeX_enabled(TeXXeT_en,cur_cmd,cur_chr) then
+@.Improper \\beginL@>
+@.Improper \\endL@>
+@.Improper \\beginR@>
+@.Improper \\endR@>
+ tail_append(new_math(0,cur_chr));
+ end
+else
+
+@ An hbox with subtype dlist will never be reversed, even when embedded
+in right-to-left text.
+
+@<Display if this box is never to be reversed@>=
+if (type(p)=hlist_node)and(box_lr(p)=dlist) then print(", display")
+
+@ A number of routines are based on a stack of one-word nodes whose
+|info| fields contain |end_M_code|, |end_L_code|, or |end_R_code|. The
+top of the stack is pointed to by |LR_ptr|.
+
+When the stack manipulation macros of this section are used below,
+variable |LR_ptr| might be the global variable declared here for |hpack|
+and |ship_out|, or might be local to |post_line_break|.
+
+@d put_LR(#)==begin temp_ptr:=get_avail; info(temp_ptr):=#;
+ link(temp_ptr):=LR_ptr; LR_ptr:=temp_ptr;
+ end
+@#
+@d push_LR(#)==put_LR(end_LR_type(#))
+@#
+@d pop_LR==begin temp_ptr:=LR_ptr; LR_ptr:=link(temp_ptr);
+ free_avail(temp_ptr);
+ end
+
+@<Glob...@>=
+@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
+@!LR_problems:integer; {counts missing begins and ends}
+@!cur_dir:small_number; {current text direction}
+
+@ @<Set init...@>=
+LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right;
+
+@ @<Insert LR nodes at the beg...@>=
+begin q:=link(temp_head);
+if LR_ptr<>null then
+ begin temp_ptr:=LR_ptr; r:=q;
+ repeat s:=new_math(0,begin_LR_type(info(temp_ptr))); link(s):=r; r:=s;
+ temp_ptr:=link(temp_ptr);
+ until temp_ptr=null;
+ link(temp_head):=r;
+ end;
+while q<>cur_break(cur_p) do
+ begin if not is_char_node(q) then
+ if type(q)=math_node then @<Adjust \(t)the LR stack for the |p...@>;
+ q:=link(q);
+ end;
+end
+
+@ @<Adjust \(t)the LR stack for the |p...@>=
+if end_LR(q) then
+ begin if LR_ptr<>null then if info(LR_ptr)=end_LR_type(q) then pop_LR;
+ end
+else push_LR(q)
+
+@ We use the fact that |q| now points to the node with \.{\\rightskip} glue.
+
+@<Insert LR nodes at the end...@>=
+if LR_ptr<>null then
+ begin s:=temp_head; r:=link(s);
+ while r<>q do
+ begin s:=r; r:=link(s);
+ end;
+ r:=LR_ptr;
+ while r<>null do
+ begin temp_ptr:=new_math(0,info(r));
+ link(s):=temp_ptr; s:=temp_ptr; r:=link(r);
+ end;
+ link(s):=q;
+ end
+
+@ @<Initialize the LR stack@>=
+put_LR(before) {this will never match}
+
+@ @<Adjust \(t)the LR stack for the |hp...@>=
+if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin incr(LR_problems); type(p):=kern_node; subtype(p):=explicit;
+ end
+else push_LR(p)
+
+@ @<Check for LR anomalies at the end of |hp...@>=
+begin if info(LR_ptr)<>before then
+ begin while link(q)<>null do q:=link(q);
+ repeat temp_ptr:=q; q:=new_math(0,info(LR_ptr)); link(temp_ptr):=q;
+ LR_problems:=LR_problems+10000; pop_LR;
+ until info(LR_ptr)=before;
+ end;
+if LR_problems>0 then
+ begin @<Report LR problems@>; goto common_ending;
+ end;
+pop_LR;
+if LR_ptr<>null then confusion("LR1");
+@:this can't happen LR1}{\quad LR1@>
+end
+
+@ @<Report LR problems@>=
+begin print_ln; print_nl("\endL or \endR problem (");@/
+print_int(LR_problems div 10000); print(" missing, ");@/
+print_int(LR_problems mod 10000); print(" extra");@/
+LR_problems:=0;
+end
+
+@ @<Initialize |hlist_out| for mixed...@>=
+if eTeX_ex then
+ begin @<Initialize the LR stack@>;
+ if box_lr(this_box)=dlist then
+ if cur_dir=right_to_left then
+ begin cur_dir:=left_to_right; cur_h:=cur_h-width(this_box);
+ end
+ else set_box_lr(this_box)(0);
+ if (cur_dir=right_to_left)and(box_lr(this_box)<>reversed) then
+ @<Reverse the complete hlist and set the subtype to |reversed|@>;
+ end
+
+@ @<Finish |hlist_out| for mixed...@>=
+if eTeX_ex then
+ begin @<Check for LR anomalies at the end of |hlist_out|@>;
+ if box_lr(this_box)=dlist then cur_dir:=right_to_left;
+ end
+
+@ @<Handle a math node in |hlist_out|@>=
+begin if eTeX_ex then
+ @<Adjust \(t)the LR stack for the |hlist_out| routine; if necessary
+ reverse an hlist segment and |goto reswitch|@>;
+ cur_h:=cur_h+width(p);
+ end
+
+@ Breaking a paragraph into lines while \TeXXeT\ is disabled may result
+in lines whith unpaired math nodes. Such hlists are silently accepted
+in the absence of text direction directives.
+
+@d LR_dir(#)==(subtype(#) div R_code) {text direction of a `math node'}
+
+@<Adjust \(t)the LR stack for the |hl...@>=
+begin if end_LR(p) then
+ if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else begin if subtype(p)>L_code then incr(LR_problems);
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ @<Reverse an hlist segment and |goto reswitch|@>;
+ end;
+type(p):=kern_node;
+end
+
+@ @<Check for LR anomalies at the end of |hl...@>=
+begin while info(LR_ptr)<>before do
+ begin if info(LR_ptr)>L_code then LR_problems:=LR_problems+10000;
+ pop_LR;
+ end;
+pop_LR;
+end
+
+@ @d edge_node=style_node {a |style_node| does not occur in hlists}
+@d edge_node_size=style_node_size {number of words in an edge node}
+@d edge_dist(#)==depth(#) {new |left_edge| position relative to |cur_h|
+ (after |width| has been taken into account)}
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function new_edge(@!s:small_number;@!w:scaled):pointer;
+ {create an edge node}
+var p:pointer; {the new node}
+begin p:=get_node(edge_node_size); type(p):=edge_node; subtype(p):=s;
+width(p):=w; edge_dist(p):=0; {the |edge_dist| field will be set later}
+new_edge:=p;
+end;
+
+@ @<Cases of |hlist_out| that arise...@>=
+edge_node: begin cur_h:=cur_h+width(p);
+ left_edge:=cur_h+edge_dist(p); cur_dir:=subtype(p);
+ end;
+
+@ We detach the hlist, start a new one consisting of just one kern node,
+append the reversed list, and set the width of the kern node.
+
+@<Reverse the complete hlist...@>=
+begin save_h:=cur_h; temp_ptr:=p; p:=new_kern(0); link(prev_p):=p;
+cur_h:=0; link(p):=reverse(this_box,null,cur_g,cur_glue); width(p):=-cur_h;
+cur_h:=save_h; set_box_lr(this_box)(reversed);
+end
+
+@ We detach the remainder of the hlist, replace the math node by
+an edge node, and append the reversed hlist segment to it; the tail of
+the reversed segment is another edge node and the remainder of the
+original list is attached to it.
+
+@<Reverse an hlist segment...@>=
+begin save_h:=cur_h; temp_ptr:=link(p); rule_wd:=width(p);
+free_node(p,small_node_size);
+cur_dir:=reflected; p:=new_edge(cur_dir,rule_wd); link(prev_p):=p;
+cur_h:=cur_h-left_edge+rule_wd;
+link(p):=reverse(this_box,new_edge(reflected,0),cur_g,cur_glue);
+edge_dist(p):=cur_h; cur_dir:=reflected; cur_h:=save_h;
+goto reswitch;
+end
+
+@ The |reverse| function defined here is responsible to reverse the
+nodes of an hlist (segment). The first parameter |this_box| is the enclosing
+hlist node, the second parameter |t| is to become the tail of the reversed
+list, and the global variable |temp_ptr| is the head of the list to be
+reversed. Finally |cur_g| and |cur_glue| are the current glue rounding state
+variables, to be updated by this function. We remove nodes from the original
+list and add them to the head of the new one.
+
+@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+function reverse(@!this_box,@!t:pointer; var cur_g:scaled;
+ var cur_glue:real):pointer;
+label reswitch,next_p,done;
+var l:pointer; {the new list}
+@!p:pointer; {the current node}
+@!q:pointer; {the next node}
+@!g_order: glue_ord; {applicable order of infinity for glue}
+@!g_sign: normal..shrinking; {selects type of glue}
+@!glue_temp:real; {glue value before rounding}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
+l:=t; p:=temp_ptr; m:=min_halfword; n:=min_halfword;
+loop@+ begin while p<>null do
+ @<Move node |p| to the new list and go to the next node;
+ or |goto done| if the end of the reflected segment has been reached@>;
+ if (t=null)and(m=min_halfword)and(n=min_halfword) then goto done;
+ p:=new_math(0,info(LR_ptr)); LR_problems:=LR_problems+10000;
+ {manufacture one missing math node}
+ end;
+done:reverse:=l;
+end;
+
+@ @<Move node |p| to the new list...@>=
+reswitch: if is_char_node(p) then
+ repeat f:=font(p); c:=character(p);
+ cur_h:=cur_h+char_width(f)(char_info(f)(c));
+ q:=link(p); link(p):=l; l:=p; p:=q;
+ until not is_char_node(p)
+else @<Move the non-|char_node| |p| to the new list@>
+
+@ @<Move the non-|char_node| |p| to the new list@>=
+begin q:=link(p);
+case type(p) of
+hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p);
+@t\4@>@<Cases of |reverse| that need special treatment@>@;
+edge_node: confusion("LR2");
+@:this can't happen LR2}{\quad LR2@>
+othercases goto next_p
+endcases;@/
+cur_h:=cur_h+rule_wd;
+next_p: link(p):=l;
+if type(p)=kern_node then if (rule_wd=0)or(l=null) then
+ begin free_node(p,small_node_size); p:=l;
+ end;
+l:=p; p:=q;
+end
+
+@ Need to measure |native_word| and picture nodes when reversing!
+@<Cases of |reverse|...@>=
+whatsit_node:
+ if (is_native_word_subtype(p))
+ or (subtype(p)=glyph_node)
+ or (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then
+ rule_wd:=width(p)
+ else
+ goto next_p;
+
+@ Here we compute the effective width of a glue node as in |hlist_out|.
+
+@<Cases of |reverse|...@>=
+glue_node: begin round_glue;
+ @<Handle a glue node for mixed...@>;
+ end;
+
+@ A ligature node is replaced by a char node.
+
+@<Cases of |reverse|...@>=
+ligature_node: begin flush_node_list(lig_ptr(p));
+ temp_ptr:=p; p:=get_avail; mem[p]:=mem[lig_char(temp_ptr)]; link(p):=q;
+ free_node(temp_ptr,small_node_size); goto reswitch;
+ end;
+
+@ Math nodes in an inner reflected segment are modified, those at the
+outer level are changed into kern nodes.
+
+@<Cases of |reverse|...@>=
+math_node: begin rule_wd:=width(p);
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin type(p):=kern_node;
+ if m>min_halfword then decr(m)
+ else @<Finish the reversed hlist segment and |goto done|@>;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end;
+end;
+
+@ Finally we have found the end of the hlist segment to be reversed; the
+final math node is released and the remaining list attached to the
+edge node terminating the reversed segment.
+
+@<Finish the reversed...@>=
+begin free_node(p,small_node_size);
+link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done;
+end
+
+@ @<Check for LR anomalies at the end of |s...@>=
+begin if LR_problems>0 then
+ begin @<Report LR problems@>; print_char(")"); print_ln;
+ end;
+if (LR_ptr<>null)or(cur_dir<>left_to_right) then confusion("LR3");
+@:this can't happen LR3}{\quad LR3@>
+end
+
+@ Some special actions are required for displayed equation in paragraphs
+with mixed direction texts. First of all we have to set the text
+direction preceding the display.
+
+@<Set the value of |x| to the text direction before the display@>=
+if LR_save=null then x:=0
+else if info(LR_save)>=R_code then x:=-1@+else x:=1
+
+@ @<Prepare for display after an empty...@>=
+begin pop_nest; @<Set the value of |x|...@>;
+end
+
+@ When calculating the natural width, |w|, of the final line preceding
+the display, we may have to copy all or part of its hlist. We copy,
+however, only those parts of the original list that are relevant for the
+computation of |pre_display_size|.
+@^data structure assumptions@>
+
+@<Declare subprocedures for |init_math|@>=
+procedure just_copy(@!p,@!h,@!t:pointer);
+label found,not_found;
+var @!r:pointer; {current node being fabricated for new list}
+@!words:0..5; {number of words remaining to be copied}
+begin while p<>null do
+ begin words:=1; {this setting occurs in more branches than any other}
+ if is_char_node(p) then r:=get_avail
+ else case type(p) of
+ hlist_node,vlist_node: begin r:=get_node(box_node_size);
+ mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
+ words:=5; list_ptr(r):=null; {this affects |mem[r+5]|}
+ end;
+ rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size;
+ end;
+ ligature_node: begin r:=get_avail; {only |font| and |character| are needed}
+ mem[r]:=mem[lig_char(p)]; goto found;
+ end;
+ kern_node,math_node: begin r:=get_node(small_node_size);
+ words:=small_node_size;
+ end;
+ glue_node: begin r:=get_node(small_node_size); add_glue_ref(glue_ptr(p));
+ glue_ptr(r):=glue_ptr(p); leader_ptr(r):=null;
+ end;
+ whatsit_node:@<Make a partial copy of the whatsit...@>;
+ othercases goto not_found
+ endcases;
+ while words>0 do
+ begin decr(words); mem[r+words]:=mem[p+words];
+ end;
+ found: link(h):=r; h:=r;
+ not_found: p:=link(p);
+ end;
+link(h):=t;
+end;
+
+@ When the final line ends with R-text, the value |w| refers to the line
+reflected with respect to the left edge of the enclosing vertical list.
+
+@<Prepare for display after a non-empty...@>=
+if eTeX_ex then @<Let |j| be the prototype box for the display@>;
+v:=shift_amount(just_box);
+@<Set the value of |x|...@>;
+if x>=0 then
+ begin p:=list_ptr(just_box); link(temp_head):=null;
+ end
+else begin v:=-v-width(just_box);
+ p:=new_math(0,begin_L_code); link(temp_head):=p;
+ just_copy(list_ptr(just_box),p,new_math(0,end_L_code));
+ cur_dir:=right_to_left;
+ end;
+v:=v+2*quad(cur_font);
+if TeXXeT_en then @<Initialize the LR stack@>
+
+@ @<Finish the natural width computation@>=
+if TeXXeT_en then
+ begin while LR_ptr<>null do pop_LR;
+ if LR_problems<>0 then
+ begin w:=max_dimen; LR_problems:=0;
+ end;
+ end;
+cur_dir:=left_to_right; flush_node_list(link(temp_head))
+
+@ In the presence of text direction directives we assume that any LR
+problems have been fixed by the |hpack| routine. If the final line
+contains, however, text direction directives while \TeXXeT\ is disabled,
+then we set |w:=max_dimen|.
+
+@<Cases of `Let |d| be the natural...@>=
+math_node: begin d:=width(p);
+ if TeXXeT_en then @<Adjust \(t)the LR stack for the |init_math| routine@>
+ else if subtype(p)>=L_code then
+ begin w:=max_dimen; goto done;
+ end;
+ end;
+edge_node: begin d:=width(p); cur_dir:=subtype(p);
+ end;
+
+@ @<Adjust \(t)the LR stack for the |i...@>=
+if end_LR(p) then
+ begin if info(LR_ptr)=end_LR_type(p) then pop_LR
+ else if subtype(p)>L_code then
+ begin w:=max_dimen; goto done;
+ end
+ end
+else begin push_LR(p);
+ if LR_dir(p)<>cur_dir then
+ begin just_reverse(p); p:=temp_head;
+ end;
+ end
+
+@ @<Declare subprocedures for |init_math|@>=
+procedure just_reverse(@!p:pointer);
+label found,done;
+var l:pointer; {the new list}
+@!t:pointer; {tail of reversed segment}
+@!q:pointer; {the next node}
+@!m,@!n:halfword; {count of unmatched math nodes}
+begin m:=min_halfword; n:=min_halfword;
+if link(temp_head)=null then
+ begin just_copy(link(p),temp_head,null); q:=link(temp_head);
+ end
+else begin q:=link(p); link(p):=null; flush_node_list(link(temp_head));
+ end;
+t:=new_edge(cur_dir,0); l:=t; cur_dir:=reflected;
+while q<>null do
+ if is_char_node(q) then
+ repeat p:=q; q:=link(p); link(p):=l; l:=p;
+ until not is_char_node(q)
+ else begin p:=q; q:=link(p);
+ if type(p)=math_node then
+ @<Adjust \(t)the LR stack for the |just_reverse| routine@>;
+ link(p):=l; l:=p;
+ end;
+goto done;
+found:width(t):=width(p); link(t):=q; free_node(p,small_node_size);
+done:link(temp_head):=l;
+end;
+
+@ @<Adjust \(t)the LR stack for the |j...@>=
+if end_LR(p) then
+ if info(LR_ptr)<>end_LR_type(p) then
+ begin type(p):=kern_node; incr(LR_problems);
+ end
+ else begin pop_LR;
+ if n>min_halfword then
+ begin decr(n); decr(subtype(p)); {change |after| into |before|}
+ end
+ else begin if m>min_halfword then decr(m)@+else goto found;
+ type(p):=kern_node;
+ end;
+ end
+else begin push_LR(p);
+ if (n>min_halfword)or(LR_dir(p)<>cur_dir) then
+ begin incr(n); incr(subtype(p)); {change |before| into |after|}
+ end
+ else begin type(p):=kern_node; incr(m);
+ end;
+ end
+
+@ The prototype box is an hlist node with the width, glue set, and shift
+amount of |just_box|, i.e., the last line preceding the display. Its
+hlist reflects the current \.{\\leftskip} and \.{\\rightskip}.
+
+@<Let |j| be the prototype box for the display@>=
+begin if right_skip=zero_glue then j:=new_kern(0)
+else j:=new_param_glue(right_skip_code);
+if left_skip=zero_glue then p:=new_kern(0)
+else p:=new_param_glue(left_skip_code);
+link(p):=j; j:=new_null_box; width(j):=width(just_box);
+shift_amount(j):=shift_amount(just_box); list_ptr(j):=p;
+glue_order(j):=glue_order(just_box); glue_sign(j):=glue_sign(just_box);
+glue_set(j):=glue_set(just_box);
+end
+
+@ At the end of a displayed equation we retrieve the prototype box.
+
+@<Local variables for finishing...@>=
+@!j:pointer; {prototype box}
+
+@ @<Retrieve the prototype box@>=
+if mode=mmode then j:=LR_box
+
+@ @<Flush the prototype box@>=
+flush_node_list(j)
+
+@ The |app_display| procedure used to append the displayed equation
+and\slash or equation number to the current vertical list has three
+parameters: the prototype box, the hbox to be appended, and the
+displacement of the hbox in the display line.
+
+@<Declare subprocedures for |after_math|@>=
+procedure app_display(@!j,@!b:pointer;@!d:scaled);
+var z:scaled; {width of the line}
+@!s:scaled; {move the line right this much}
+@!e:scaled; {distance from right edge of box to end of line}
+@!x:integer; {|pre_display_direction|}
+@!p,@!q,@!r,@!t,@!u:pointer; {for list manipulation}
+begin s:=display_indent; x:=pre_display_direction;
+if x=0 then shift_amount(b):=s+d
+else begin z:=display_width; p:=b;
+ @<Set up the hlist for the display line@>;
+ @<Package the display line@>;
+ end;
+append_to_vlist(b);
+end;
+
+@ Here we construct the hlist for the display, starting with node |p|
+and ending with node |q|. We also set |d| and |e| to the amount of
+kerning to be added before and after the hlist (adjusted for the
+prototype box).
+
+@<Set up the hlist for the display line@>=
+if x>0 then e:=z-d-width(p)
+else begin e:=d; d:=z-e-width(p);
+ end;
+if j<>null then
+ begin b:=copy_node_list(j); height(b):=height(p); depth(b):=depth(p);
+ s:=s-shift_amount(b); d:=d+s; e:=e+width(b)-z-s;
+ end;
+if box_lr(p)=dlist then q:=p {display or equation number}
+else begin {display and equation number}
+ r:=list_ptr(p); free_node(p,box_node_size);
+ if r=null then confusion("LR4");
+ if x>0 then
+ begin p:=r;
+ repeat q:=r; r:=link(r); {find tail of list}
+ until r=null;
+ end
+ else begin p:=null; q:=r;
+ repeat t:=link(r); link(r):=p; p:=r; r:=t; {reverse list}
+ until r=null;
+ end;
+ end
+
+@ In the presence of a prototype box we use its shift amount and width
+to adjust the values of kerning and add these values to the glue nodes
+inserted to cancel the \.{\\leftskip} and \.{\\rightskip}. If there is
+no prototype box (because the display is preceded by an empty
+paragraph), or if the skip parameters are zero, we just add kerns.
+
+The |cancel_glue| macro creates and links a glue node that is, together
+with another glue node, equivalent to a given amount of kerning. We can
+use |j| as temporary pointer, since all we need is |j<>null|.
+
+@d cancel_glue(#)==j:=new_skip_param(#); cancel_glue_cont
+@d cancel_glue_cont(#)==link(#):=j; cancel_glue_cont_cont
+@d cancel_glue_cont_cont(#)==link(j):=#; cancel_glue_end
+@d cancel_glue_end(#)==j:=glue_ptr(#); cancel_glue_end_end
+@d cancel_glue_end_end(#)==
+stretch_order(temp_ptr):=stretch_order(j);
+shrink_order(temp_ptr):=shrink_order(j); width(temp_ptr):=#-width(j);
+stretch(temp_ptr):=-stretch(j); shrink(temp_ptr):=-shrink(j)
+
+@<Package the display line@>=
+if j=null then
+ begin r:=new_kern(0); t:=new_kern(0); {the widths will be set later}
+ end
+else begin r:=list_ptr(b); t:=link(r);
+ end;
+u:=new_math(0,end_M_code);
+if type(t)=glue_node then {|t| is \.{\\rightskip} glue}
+ begin cancel_glue(right_skip_code)(q)(u)(t)(e); link(u):=t;
+ end
+else begin width(t):=e; link(t):=u; link(q):=t;
+ end;
+u:=new_math(0,begin_M_code);
+if type(r)=glue_node then {|r| is \.{\\leftskip} glue}
+ begin cancel_glue(left_skip_code)(u)(p)(r)(d); link(r):=u;
+ end
+else begin width(r):=d; link(r):=p; link(u):=r;
+ if j=null then
+ begin b:=hpack(u,natural); shift_amount(b):=s;
+ end
+ else list_ptr(b):=u;
+ end
+
+@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens}
+primitive.
+
+@<Generate all \eTeX...@>=
+primitive("scantokens",input,2);
+@!@:scan_tokens_}{\.{\\scantokens} primitive@>
+
+@ @<Cases of |input| for |print_cmd_chr|@>=
+else if chr_code=2 then print_esc("scantokens")
+
+@ @<Cases for |input|@>=
+else if cur_chr=2 then pseudo_start
+
+@ The global variable |pseudo_files| is used to maintain a stack of
+pseudo files. The |info| field of each pseudo file points to a linked
+list of variable size nodes representing lines not yet processed: the
+|info| field of the first word 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}
+@!l,@!m:pool_pointer; {indices into |str_pool|}
+@!p,@!q,@!r:pointer; {for list construction}
+@!w: four_quarters; {four ASCII codes}
+@!nl,@!sz:integer;
+begin scan_general_text;
+old_setting:=selector; selector:=new_string;
+token_show(temp_head); selector:=old_setting;
+flush_list(link(temp_head));
+str_room(1); s:=make_string;
+@<Convert string |s| into a new pseudo file@>;
+flush_string;
+@<Initiate input from new pseudo file@>;
+end;
+
+@ @<Convert string |s| into a new pseudo file@>=
+str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s);
+nl:=si(new_line_char);
+p:=get_avail; q:=p;
+while l<pool_ptr do
+ begin m:=l;
+ while (l<pool_ptr)and(str_pool[l]<>nl) do incr(l);
+ sz:=(l-m+7)div 4;
+ if sz=1 then sz:=2;
+ r:=get_node(sz); link(q):=r; q:=r; info(q):=hi(sz);
+ while sz>2 do
+ begin decr(sz); incr(r);
+ w.b0:=qi(so(str_pool[m])); w.b1:=qi(so(str_pool[m+1]));
+ w.b2:=qi(so(str_pool[m+2])); w.b3:=qi(so(str_pool[m+3]));
+ mem[r].qqqq:=w; m:=m+4;
+ end;
+ w.b0:=qi(" "); w.b1:=qi(" "); w.b2:=qi(" "); w.b3:=qi(" ");
+ if l>m then
+ begin w.b0:=qi(so(str_pool[m]));
+ if l>m+1 then
+ begin w.b1:=qi(so(str_pool[m+1]));
+ if l>m+2 then
+ begin w.b2:=qi(so(str_pool[m+2]));
+ if l>m+3 then w.b3:=qi(so(str_pool[m+3]));
+ end;
+ end;
+ end;
+ mem[r+1].qqqq:=w;
+ if str_pool[l]=nl then incr(l);
+ end;
+info(p):=link(p); link(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:=19; print("( "); incr(open_parens); update_terminal;
+ end
+else name:=18
+
+@ Here we read a line from the current pseudo file into |buffer|.
+
+@<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:=info(pseudo_files);
+if p=null then pseudo_input:=false
+else begin info(pseudo_files):=link(p); sz:=ho(info(p));
+ if 4*sz-3>=buf_size-last then
+ @<Report overflow of the input buffer, and abort@>;
+ last:=first;
+ for r:=p+1 to p+sz-1 do
+ begin w:=mem[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);
+ free_node(p,sz);
+ 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:=link(pseudo_files); q:=info(pseudo_files);
+free_avail(pseudo_files); pseudo_files:=p;
+while q<>null do
+ begin p:=q; q:=link(p); free_node(p,ho(info(p)));
+ end;
+end;
+
+@ @<Dump the \eTeX\ state@>=
+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}' }
+
+@<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@>
+
+@ @<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");
+
+@ 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_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}
+ e:=is_in_csname; 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}@>;
+ @<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);
+ is_in_csname:=e;
+ 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+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p);
+ end;
+if m>first+1 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}
+else cur_cs:=single_base+buffer[first] {the list has length one}
+
+@ The conditional \.{\\iffontchar} tests the existence of a character in
+a font.
+
+@<Cases for |conditional|@>=
+if_in_csname_code: b:=is_in_csname;
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
+ if is_native_font(n) then
+ b:=(map_char_to_glyph(n, cur_val) > 0)
+ else begin
+ if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
+ 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]:=link(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:=subtype(cond_ptr);
+ if_limit:=type(cond_ptr); cond_ptr:=link(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;
+incr(expand_depth_count);
+if expand_depth_count>=expand_depth then overflow("expansion depth",expand_depth);
+@<Scan and evaluate an expression |e| of type |l|@>;
+decr(expand_depth_count);
+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 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 two 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_size=4 {number of words in stack entry for subexpressions}
+@d expr_e_field(#)==mem[#+1].int {saved expression so far}
+@d expr_t_field(#)==mem[#+2].int {saved term so far}
+@d expr_n_field(#)==mem[#+3].int {saved numerator}
+
+@<Push the expression...@>=
+begin q:=get_node(expr_node_size); link(q):=p; type(q):=l;
+subtype(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:=subtype(q) div 4; r:=subtype(q) mod 4;
+l:=type(q); p:=link(q); free_node(q,expr_node_size);
+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(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 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 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 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;
+
+@ \eTeX\ (in extended mode) supports 32768 (i.e., $2^{15}$) count,
+dimen, skip, muskip, box, and token registers. As in \TeX\ the first
+256 registers of each kind are realized as arrays in the table of
+equivalents; the additional registers are realized as tree structures
+built from variable-size nodes with individual registers existing only
+when needed. Default values are used for nonexistent registers: zero
+for count and dimen values, |zero_glue| for glue (skip and muskip)
+values, void for boxes, and |null| for token lists (and current marks
+discussed below).
+
+Similarly there are 32768 mark classes; the command \.{\\marks}|n|
+creates a mark node for a given mark class |0<=n<=32767| (where
+\.{\\marks0} is synonymous to \.{\\mark}). The page builder (actually
+the |fire_up| routine) and the |vsplit| routine maintain the current
+values of |top_mark|, |first_mark|, |bot_mark|, |split_first_mark|, and
+|split_bot_mark| for each mark class. They are accessed as
+\.{\\topmarks}|n| etc., and \.{\\topmarks0} is again synonymous to
+\.{\\topmark}. As in \TeX\ the five current marks for mark class zero
+are realized as |cur_mark| array. The additional current marks are
+again realized as tree structure with individual mark classes existing
+only when needed.
+
+@<Generate all \eTeX...@>=
+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@>
+
+@ The |scan_register_num| procedure scans a register number that must
+not exceed 255 in compatibility mode resp.\ 32767 in extended mode.
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure@?scan_register_num; forward;@t\2@>
+
+@ @<Declare procedures that scan restricted classes of integers@>=
+procedure scan_register_num;
+begin scan_int;
+if (cur_val<0)or(cur_val>max_reg_num) then
+ begin print_err("Bad register code");
+@.Bad register code@>
+ help2(max_reg_help_line)("I changed this one to zero.");
+ int_error(cur_val); cur_val:=0;
+ end;
+end;
+
+@ @<Initialize variables for \eTeX\ comp...@>=
+max_reg_num:=255;
+max_reg_help_line:="A register number must be between 0 and 255.";
+
+@ @<Initialize variables for \eTeX\ ext...@>=
+max_reg_num:=32767;
+max_reg_help_line:="A register number must be between 0 and 32767.";
+
+@ @<Glob...@>=
+@!max_reg_num: halfword; {largest allowed register number}
+@!max_reg_help_line: str_number; {first line of help message}
+
+@ There are eight almost identical doubly linked trees, one for the
+sparse array of the up to 32512 additional registers of each kind,
+one for inter-character token lists at specified class transitions, and
+one for the sparse array of the up to 32767 additional mark classes.
+The root of each such tree, if it exists, is an index node containing 64
+pointers to subtrees for $64^4$ consecutive array elements. Similar index
+nodes are the starting points for all nonempty subtrees for $64^3$, $64^2$,
+and 64 consecutive array elements. These four levels of index nodes are
+followed by a fifth level with nodes for the individual array elements.
+
+Each index node is 33 words long. The pointers to the 64 possible
+subtrees or nodes are kept in the |info| and |link| fields of the last 32
+words. (It would be both elegant and efficient to declare them as
+array, unfortunately \PASCAL\ doesn't allow this.)
+
+The fields in the first word of each index node and in the nodes for the
+array elements are closely related. The |link| field points to the next
+lower index node and the |sa_index| field contains four bits (one
+hexadecimal digit) of the register number or mark class. For the lowest
+index node the |link| field is |null| and the |sa_index| field indicates
+the type of quantity (|int_val|, |dimen_val|, |glue_val|, |mu_val|,
+|box_val|, |tok_val|, |inter_char_val| or |mark_val|). The |sa_used| field in the index
+nodes counts how many of the 64 pointers are non-null.
+
+The |sa_index| field in the nodes for array elements contains the six
+bits plus 64 times the type. Therefore such a node represents a count
+or dimen register if and only if |sa_index<dimen_val_limit|; it
+represents a skip or muskip register if and only if
+|dimen_val_limit<=sa_index<mu_val_limit|; it represents a box register
+if and only if |mu_val_limit<=sa_index<box_val_limit|; it represents a
+token list register if and only if
+|box_val_limit<=sa_index<tok_val_limit|; finally it represents a mark
+class if and only if |tok_val_limit<=sa_index|.
+
+The |new_index| procedure creates an index node (returned in |cur_ptr|)
+having given contents of the |sa_index| and |link| fields.
+
+@d box_val==4 {the additional box registers}
+@d mark_val=7 {the additional mark classes}
+@#
+@d dimen_val_limit=@"80 {$2^6\cdot(|dimen_val|+1)$}
+@d mu_val_limit=@"100 {$2^6\cdot(|mu_val|+1)$}
+@d box_val_limit=@"140 {$2^6\cdot(|box_val|+1)$}
+@d tok_val_limit=@"180 {$2^6\cdot(|tok_val|+1)$}
+@#
+@d index_node_size=33 {size of an index node}
+@d sa_index==type {a four-bit address or a type or both}
+@d sa_used==subtype {count of non-null pointers}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure new_index(@!i:quarterword; @!q:pointer);
+var k:small_number; {loop index}
+begin cur_ptr:=get_node(index_node_size); sa_index(cur_ptr):=i;
+sa_used(cur_ptr):=0; link(cur_ptr):=q;
+for k:=1 to index_node_size-1 do {clear all 64 pointers}
+ mem[cur_ptr+k]:=sa_null;
+end;
+
+@ The roots of the eight trees for the additional registers and mark
+classes are kept in the |sa_root| array. The first seven locations must
+be dumped and undumped; the last one is also known as |sa_mark|.
+
+@d sa_mark==sa_root[mark_val] {root for mark classes}
+
+@<Glob...@>=
+@!sa_root:array[int_val..mark_val] of pointer; {roots of sparse arrays}
+@!cur_ptr:pointer; {value returned by |new_index| and |find_sa_element|}
+@!sa_null:memory_word; {two |null| pointers}
+
+@ @<Set init...@>=
+sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
+
+@ @<Initialize table...@>=
+for i:=int_val to inter_char_val do sa_root[i]:=null;
+
+@ Given a type |t| and a twenty-four-bit number |n|, the |find_sa_element|
+procedure returns (in |cur_ptr|) a pointer to the node for the
+corresponding array element, or |null| when no such element exists. The
+third parameter |w| is set |true| if the element must exist, e.g.,
+because it is about to be modified. The procedure has two main
+branches: one follows the existing tree structure, the other (only used
+when |w| is |true|) creates the missing nodes.
+
+We use macros to extract the six-bit pieces from a twenty-four-bit register
+number or mark class and to fetch or store one of the 64 pointers from
+an index node. (Note that the |hex_dig| macros are mis-named since the conversion
+from 4-bit to 6-bit fields for \XeTeX!)
+
+@d if_cur_ptr_is_null_then_return_or_goto(#)== {some tree element is missing}
+ begin if cur_ptr=null then
+ if w then goto #@+else return;
+ end
+@#
+@d hex_dig1(#)==# div @"40000 {the fourth lowest 6-bit field}
+@d hex_dig2(#)==(# div @"1000) mod @"40 {the third lowest 6-bit field}
+@d hex_dig3(#)==(# div @"40) mod @"40 {the second lowest 6-bit field}
+@d hex_dig4(#)==# mod @"40 {the lowest 6-bit field}
+@#
+@d get_sa_ptr==if odd(i) then cur_ptr:=link(q+(i div 2)+1)
+ else cur_ptr:=info(q+(i div 2)+1)
+ {set |cur_ptr| to the pointer indexed by |i| from index node |q|}
+@d put_sa_ptr(#)==if odd(i) then link(q+(i div 2)+1):=#
+ else info(q+(i div 2)+1):=#
+ {store the pointer indexed by |i| in index node |q|}
+@d add_sa_ptr==begin put_sa_ptr(cur_ptr); incr(sa_used(q));
+ end {add |cur_ptr| as the pointer indexed by |i| in index node |q|}
+@d delete_sa_ptr==begin put_sa_ptr(null); decr(sa_used(q));
+ end {delete the pointer indexed by |i| in index node |q|}
+
+@<Declare \eTeX\ procedures for ex...@>=
+procedure find_sa_element(@!t:small_number;@!n:halfword;@!w:boolean);
+ {sets |cur_val| to sparse array element location or |null|}
+label not_found,not_found1,not_found2,not_found3,not_found4,exit;
+var q:pointer; {for list manipulations}
+@!i:small_number; {a six bit index}
+begin cur_ptr:=sa_root[t];
+if_cur_ptr_is_null_then_return_or_goto(not_found);@/
+q:=cur_ptr; i:=hex_dig1(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found1);@/
+q:=cur_ptr; i:=hex_dig2(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found2);@/
+q:=cur_ptr; i:=hex_dig3(n); get_sa_ptr;
+if_cur_ptr_is_null_then_return_or_goto(not_found3);@/
+q:=cur_ptr; i:=hex_dig4(n); get_sa_ptr;
+if (cur_ptr=null)and w then goto not_found4;
+return;
+not_found: new_index(t,null); {create first level index node}
+sa_root[t]:=cur_ptr; q:=cur_ptr; i:=hex_dig1(n);
+not_found1: new_index(i,q); {create second level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig2(n);
+not_found2: new_index(i,q); {create third level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig3(n);
+not_found3: new_index(i,q); {create fourth level index node}
+add_sa_ptr; q:=cur_ptr; i:=hex_dig4(n);
+not_found4: @<Create a new array element of type |t| with index |i|@>;
+link(cur_ptr):=q; add_sa_ptr;
+exit:end;
+
+@ The array elements for registers are subject to grouping and have an
+|sa_lev| field (quite analogous to |eq_level|) instead of |sa_used|.
+Since saved values as well as shorthand definitions (created by e.g.,
+\.{\\countdef}) refer to the location of the respective array element,
+we need a reference count that is kept in the |sa_ref| field. An array
+element can be deleted (together with all references to it) when its
+|sa_ref| value is |null| and its value is the default value.
+@^reference counts@>
+
+Skip, muskip, box, and token registers use two word nodes, their values
+are stored in the |sa_ptr| field.
+Count and dimen registers use three word nodes, their
+values are stored in the |sa_int| resp.\ |sa_dim| field in the third
+word; the |sa_ptr| field is used under the name |sa_num| to store
+the register number. Mark classes use four word nodes. The last three
+words contain the five types of current marks
+
+@d sa_lev==sa_used {grouping level for the current value}
+@d pointer_node_size=2 {size of an element with a pointer value}
+@d sa_type(#)==(sa_index(#) div 64) {type part of combined type/index}
+@d sa_ref(#)==info(#+1) {reference count of a sparse array element}
+@d sa_ptr(#)==link(#+1) {a pointer value}
+@#
+@d word_node_size=3 {size of an element with a word value}
+@d sa_num==sa_ptr {the register number}
+@d sa_int(#)==mem[#+2].int {an integer}
+@d sa_dim(#)==mem[#+2].sc {a dimension (a somewhat esotheric distinction)}
+@#
+@d mark_class_node_size=4 {size of an element for a mark class}
+@#
+@d fetch_box(#)== {fetch |box(cur_val)|}
+ if cur_val<256 then #:=box(cur_val)
+ else begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr=null then #:=null@+else #:=sa_ptr(cur_ptr);
+ end
+
+@<Create a new array element...@>=
+if t=mark_val then {a mark class}
+ begin cur_ptr:=get_node(mark_class_node_size);
+ mem[cur_ptr+1]:=sa_null; mem[cur_ptr+2]:=sa_null; mem[cur_ptr+3]:=sa_null;
+ end
+else begin if t<=dimen_val then {a count or dimen register}
+ begin cur_ptr:=get_node(word_node_size); sa_int(cur_ptr):=0;
+ sa_num(cur_ptr):=n;
+ end
+ else begin cur_ptr:=get_node(pointer_node_size);
+ if t<=mu_val then {a skip or muskip register}
+ begin sa_ptr(cur_ptr):=zero_glue; add_glue_ref(zero_glue);
+ end
+ else sa_ptr(cur_ptr):=null; {a box or token list register}
+ end;
+ sa_ref(cur_ptr):=null; {all registers have a reference count}
+ end;
+sa_index(cur_ptr):=64*t+i; sa_lev(cur_ptr):=level_one
+
+@ The |delete_sa_ref| procedure is called when a pointer to an array
+element representing a register is being removed; this means that the
+reference count should be decreased by one. If the reduced reference
+count is |null| and the register has been (globally) assigned its
+default value the array element should disappear, possibly together with
+some index nodes. This procedure will never be used for mark class
+nodes.
+@^reference counts@>
+
+@d add_sa_ref(#)==incr(sa_ref(#)) {increase reference count}
+@#
+@d change_box(#)== {change |box(cur_val)|, the |eq_level| stays the same}
+ if cur_val<256 then box(cur_val):=#@+else set_sa_box(#)
+@#
+@d set_sa_box(#)==begin find_sa_element(box_val,cur_val,false);
+ if cur_ptr<>null then
+ begin sa_ptr(cur_ptr):=#; add_sa_ref(cur_ptr); delete_sa_ref(cur_ptr);
+ end;
+ end
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure delete_sa_ref(@!q:pointer); {reduce reference count}
+label exit;
+var p:pointer; {for list manipulations}
+@!i:small_number; {a four bit index}
+@!s:small_number; {size of a node}
+begin decr(sa_ref(q));
+if sa_ref(q)<>null then return;
+if sa_index(q)<dimen_val_limit then
+ if sa_int(q)=0 then s:=word_node_size
+ else return
+else begin if sa_index(q)<mu_val_limit then
+ if sa_ptr(q)=zero_glue then delete_glue_ref(zero_glue)
+ else return
+ else if sa_ptr(q)<>null then return;
+ s:=pointer_node_size;
+ end;
+repeat i:=hex_dig4(sa_index(q)); p:=q; q:=link(p); free_node(p,s);
+if q=null then {the whole tree has been freed}
+ begin sa_root[i]:=null; return;
+ end;
+delete_sa_ptr; s:=index_node_size; {node |q| is an index node}
+until sa_used(q)>0;
+exit:end;
+
+@ The |print_sa_num| procedure prints the register number corresponding
+to an array element.
+
+@<Basic print...@>=
+procedure print_sa_num(@!q:pointer); {print register number}
+var @!n:halfword; {the register number}
+begin if sa_index(q)<dimen_val_limit then n:=sa_num(q) {the easy case}
+else begin n:=hex_dig4(sa_index(q)); q:=link(q); n:=n+64*sa_index(q);
+ q:=link(q); n:=n+64*64*(sa_index(q)+64*sa_index(link(q)));
+ end;
+print_int(n);
+end;
+
+@ Here is a procedure that displays the contents of an array element
+symbolically. It is used under similar circumstances as is
+|restore_trace| (together with |show_eqtb|) for the quantities kept in
+the |eqtb| array.
+
+@<Declare \eTeX\ procedures for tr...@>=
+@!stat procedure show_sa(@!p:pointer;@!s:str_number);
+var t:small_number; {the type of element}
+begin begin_diagnostic; print_char("{"); print(s); print_char(" ");
+if p=null then print_char("?") {this can't happen}
+else begin t:=sa_type(p);
+ if t<box_val then print_cmd_chr(register,p)
+ else if t=box_val then
+ begin print_esc("box"); print_sa_num(p);
+ end
+ else if t=tok_val then print_cmd_chr(toks_register,p)
+ else print_char("?"); {this can't happen either}
+ print_char("=");
+ if t=int_val then print_int(sa_int(p))
+ else if t=dimen_val then
+ begin print_scaled(sa_dim(p)); print("pt");
+ end
+ else begin p:=sa_ptr(p);
+ if t=glue_val then print_spec(p,"pt")
+ else if t=mu_val then print_spec(p,"mu")
+ else if t=box_val then
+ if p=null then print("void")
+ else begin depth_threshold:=0; breadth_max:=1; show_node_list(p);
+ end
+ else if t=tok_val then
+ begin if p<>null then show_token_list(link(p),null,32);
+ end
+ else print_char("?"); {this can't happen either}
+ end;
+ end;
+print_char("}"); end_diagnostic(false);
+end;
+tats
+
+@ Here we compute the pointer to the current mark of type |t| and mark
+class |cur_val|.
+
+@<Compute the mark pointer...@>=
+begin find_sa_element(mark_val,cur_val,false);
+if cur_ptr<>null then
+ if odd(t) then cur_ptr:=link(cur_ptr+(t div 2)+1)
+ else cur_ptr:=info(cur_ptr+(t div 2)+1);
+end
+
+@ The current marks for all mark classes are maintained by the |vsplit|
+and |fire_up| routines and are finally destroyed (for \.{INITEX} only)
+@.INITEX@>
+by the |final_cleanup| routine. Apart from updating the current marks
+when mark nodes are encountered, these routines perform certain actions
+on all existing mark classes. The recursive |do_marks| procedure walks
+through the whole tree or a subtree of existing mark class nodes and
+preforms certain actions indicted by its first parameter |a|, the action
+code. The second parameter |l| indicates the level of recursion (at
+most four); the third parameter points to a nonempty tree or subtree.
+The result is |true| if the complete tree or subtree has been deleted.
+
+@d vsplit_init==0 {action code for |vsplit| initialization}
+@d fire_up_init==1 {action code for |fire_up| initialization}
+@d fire_up_done==2 {action code for |fire_up| completion}
+@d destroy_marks==3 {action code for |final_cleanup|}
+@#
+@d sa_top_mark(#)==info(#+1) {\.{\\topmarks}|n|}
+@d sa_first_mark(#)==link(#+1) {\.{\\firstmarks}|n|}
+@d sa_bot_mark(#)==info(#+2) {\.{\\botmarks}|n|}
+@d sa_split_first_mark(#)==link(#+2) {\.{\\splitfirstmarks}|n|}
+@d sa_split_bot_mark(#)==info(#+3) {\.{\\splitbotmarks}|n|}
+
+@<Declare the function called |do_marks|@>=
+function do_marks(@!a,@!l:small_number;@!q:pointer):boolean;
+var i:small_number; {a four bit index}
+begin if l<4 then {|q| is an index node}
+ begin for i:=0 to 15 do
+ begin get_sa_ptr;
+ if cur_ptr<>null then if do_marks(a,l+1,cur_ptr) then delete_sa_ptr;
+ end;
+ if sa_used(q)=0 then
+ begin free_node(q,index_node_size); q:=null;
+ end;
+ end
+else {|q| is the node for a mark class}
+ begin case a of
+ @<Cases for |do_marks|@>@;
+ end; {there are no other cases}
+ if sa_bot_mark(q)=null then if sa_split_bot_mark(q)=null then
+ begin free_node(q,mark_class_node_size); q:=null;
+ end;
+ end;
+do_marks:=(q=null);
+end;
+
+@ At the start of the |vsplit| routine the existing |split_fist_mark|
+and |split_bot_mark| are discarded.
+
+@<Cases for |do_marks|@>=
+vsplit_init: if sa_split_first_mark(q)<>null then
+ begin delete_token_ref(sa_split_first_mark(q)); sa_split_first_mark(q):=null;
+ delete_token_ref(sa_split_bot_mark(q)); sa_split_bot_mark(q):=null;
+ end;
+
+@ We use again the fact that |split_first_mark=null| if and only if
+|split_bot_mark=null|.
+
+@<Update the current marks for |vsplit|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_split_first_mark(cur_ptr)=null then
+ begin sa_split_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end
+else delete_token_ref(sa_split_bot_mark(cur_ptr));
+sa_split_bot_mark(cur_ptr):=mark_ptr(p);
+add_token_ref(mark_ptr(p));
+end
+
+@ At the start of the |fire_up| routine the old |top_mark| and
+|first_mark| are discarded, whereas the old |bot_mark| becomes the new
+|top_mark|. An empty new |top_mark| token list is, however, discarded
+as well in order that mark class nodes can eventually be released. We
+use again the fact that |bot_mark<>null| implies |first_mark<>null|; it
+also knows that |bot_mark=null| implies |top_mark=first_mark=null|.
+
+@<Cases for |do_marks|@>=
+fire_up_init: if sa_bot_mark(q)<>null then
+ begin if sa_top_mark(q)<>null then delete_token_ref(sa_top_mark(q));
+ delete_token_ref(sa_first_mark(q)); sa_first_mark(q):=null;
+ if link(sa_bot_mark(q))=null then {an empty token list}
+ begin delete_token_ref(sa_bot_mark(q)); sa_bot_mark(q):=null;
+ end
+ else add_token_ref(sa_bot_mark(q));
+ sa_top_mark(q):=sa_bot_mark(q);
+ end;
+
+@ @<Cases for |do_marks|@>=
+fire_up_done: if (sa_top_mark(q)<>null)and(sa_first_mark(q)=null) then
+ begin sa_first_mark(q):=sa_top_mark(q); add_token_ref(sa_top_mark(q));
+ end;
+
+@ @<Update the current marks for |fire_up|@>=
+begin find_sa_element(mark_val,mark_class(p),true);
+if sa_first_mark(cur_ptr)=null then
+ begin sa_first_mark(cur_ptr):=mark_ptr(p);
+ add_token_ref(mark_ptr(p));
+ end;
+if sa_bot_mark(cur_ptr)<>null then delete_token_ref(sa_bot_mark(cur_ptr));
+sa_bot_mark(cur_ptr):=mark_ptr(p); add_token_ref(mark_ptr(p));
+end
+
+@ Here we use the fact that the five current mark pointers in a mark
+class node occupy the same locations as the the first five pointers of
+an index node. For systems using a run-time switch to distinguish
+between \.{VIRTEX} and \.{INITEX}, the codewords `$|init|\ldots|tini|$'
+surrounding the following piece of code should be removed.
+@.INITEX@>
+@^system dependencies@>
+
+@<Cases for |do_marks|@>=
+@!init destroy_marks: for i:=top_mark_code to split_bot_mark_code do
+ begin get_sa_ptr;
+ if cur_ptr<>null then
+ begin delete_token_ref(cur_ptr); put_sa_ptr(null);
+ end;
+ end;
+tini
+
+@ The command code |register| is used for `\.{\\count}', `\.{\\dimen}',
+etc., as well as for references to sparse array elements defined by
+`\.{\\countdef}', etc.
+
+@<Cases of |register| for |print_cmd_chr|@>=
+begin if (chr_code<mem_bot)or(chr_code>lo_mem_stat_max) then
+ cmd:=sa_type(chr_code)
+else begin cmd:=chr_code-mem_bot; chr_code:=null;
+ end;
+if cmd=int_val then print_esc("count")
+else if cmd=dimen_val then print_esc("dimen")
+else if cmd=glue_val then print_esc("skip")
+else print_esc("muskip");
+if chr_code<>null then print_sa_num(chr_code);
+end
+
+@ Similarly the command code |toks_register| is used for `\.{\\toks}' as
+well as for references to sparse array elements defined by
+`\.{\\toksdef}'.
+
+@<Cases of |toks_register| for |print_cmd_chr|@>=
+begin print_esc("toks");
+if chr_code<>mem_bot then print_sa_num(chr_code);
+end
+
+@ When a shorthand definition for an element of one of the sparse arrays
+is destroyed, we must reduce the reference count.
+
+@<Cases for |eq_destroy|@>=
+toks_register,register:
+ if (equiv_field(w)<mem_bot)or(equiv_field(w)>lo_mem_stat_max) then
+ delete_sa_ref(equiv_field(w));
+
+@ The task to maintain (change, save, and restore) register values is
+essentially the same when the register is realized as sparse array
+element or entry in |eqtb|. The global variable |sa_chain| is the head
+of a linked list of entries saved at the topmost level |sa_level|; the
+lists for lowel levels are kept in special save stack entries.
+
+@<Glob...@>=
+@!sa_chain: pointer; {chain of saved sparse array entries}
+@!sa_level: quarterword; {group level for |sa_chain|}
+
+@ @<Set init...@>=
+sa_chain:=null; sa_level:=level_zero;
+
+@ The individual saved items are kept in pointer or word nodes similar
+to those used for the array elements: a word node with value zero is,
+however, saved as pointer node with the otherwise impossible |sa_index|
+value |tok_val_limit|.
+
+@d sa_loc==sa_ref {location of saved item}
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_save(@!p:pointer); {saves value of |p|}
+var q:pointer; {the new save node}
+@!i:quarterword; {index field of node}
+begin if cur_level<>sa_level then
+ begin check_full_save_stack; save_type(save_ptr):=restore_sa;
+ save_level(save_ptr):=sa_level; save_index(save_ptr):=sa_chain;
+ incr(save_ptr); sa_chain:=null; sa_level:=cur_level;
+ end;
+i:=sa_index(p);
+if i<dimen_val_limit then
+ begin if sa_int(p)=0 then
+ begin q:=get_node(pointer_node_size); i:=tok_val_limit;
+ end
+ else begin q:=get_node(word_node_size); sa_int(q):=sa_int(p);
+ end;
+ sa_ptr(q):=null;
+ end
+else begin q:=get_node(pointer_node_size); sa_ptr(q):=sa_ptr(p);
+ end;
+sa_loc(q):=p; sa_index(q):=i; sa_lev(q):=sa_lev(p);
+link(q):=sa_chain; sa_chain:=q; add_sa_ref(p);
+end;
+
+@ @<Declare \eTeX\ procedures for tr...@>=
+procedure sa_destroy(@!p:pointer); {destroy value of |p|}
+begin if sa_index(p)<mu_val_limit then delete_glue_ref(sa_ptr(p))
+else if sa_ptr(p)<>null then
+ if sa_index(p)<box_val_limit then flush_node_list(sa_ptr(p))
+ else delete_token_ref(sa_ptr(p));
+end;
+
+@ The procedure |sa_def| assigns a new value to sparse array elements,
+and saves the former value if appropriate. This procedure is used only
+for skip, muskip, box, and token list registers. The counterpart of
+|sa_def| for count and dimen registers is called |sa_w_def|.
+
+@d sa_define(#)==if e then
+ if global then gsa_def(#)@+else sa_def(#)
+ else define
+@#
+@d sa_def_box== {assign |cur_box| to |box(cur_val)|}
+ begin find_sa_element(box_val,cur_val,true);
+ if global then gsa_def(cur_ptr,cur_box)@+else sa_def(cur_ptr,cur_box);
+ end
+@#
+@d sa_word_define(#)==if e then
+ if global then gsa_w_def(#)@+else sa_w_def(#)
+ else word_define(#)
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_def(@!p:pointer;@!e:halfword);
+ {new data for sparse array elements}
+begin add_sa_ref(p);
+if sa_ptr(p)=e then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ sa_destroy(p);
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)=cur_level then sa_destroy(p)@+else sa_save(p);
+ sa_lev(p):=cur_level; sa_ptr(p):=e;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+@#
+procedure sa_w_def(@!p:pointer;@!w:integer);
+begin add_sa_ref(p);
+if sa_int(p)=w then
+ begin @!stat if tracing_assigns>0 then show_sa(p,"reassigning");@+tats@;@/
+ end
+else begin @!stat if tracing_assigns>0 then show_sa(p,"changing");@+tats@;@/
+ if sa_lev(p)<>cur_level then sa_save(p);
+ sa_lev(p):=cur_level; sa_int(p):=w;
+ @!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+ end;
+delete_sa_ref(p);
+end;
+
+@ The |sa_def| and |sa_w_def| 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|.
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure gsa_def(@!p:pointer;@!e:halfword); {global |sa_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_destroy(p); sa_lev(p):=level_one; sa_ptr(p):=e;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+@#
+procedure gsa_w_def(@!p:pointer;@!w:integer); {global |sa_w_def|}
+begin add_sa_ref(p);
+@!stat if tracing_assigns>0 then show_sa(p,"globally changing");@+tats@;@/
+sa_lev(p):=level_one; sa_int(p):=w;
+@!stat if tracing_assigns>0 then show_sa(p,"into");@+tats@;@/
+delete_sa_ref(p);
+end;
+
+@ The |sa_restore| procedure restores the sparse array entries pointed
+at by |sa_chain|
+
+@<Declare \eTeX\ procedures for tr...@>=
+procedure sa_restore;
+var p:pointer; {sparse array element}
+begin repeat p:=sa_loc(sa_chain);
+if sa_lev(p)=level_one then
+ begin if sa_index(p)>=dimen_val_limit then sa_destroy(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/
+ end
+else begin if sa_index(p)<dimen_val_limit then
+ if sa_index(sa_chain)<dimen_val_limit then sa_int(p):=sa_int(sa_chain)
+ else sa_int(p):=0
+ else begin sa_destroy(p); sa_ptr(p):=sa_ptr(sa_chain);
+ end;
+ sa_lev(p):=sa_lev(sa_chain);
+ @!stat if tracing_restores>0 then show_sa(p,"restoring");@+tats@;@/
+ end;
+delete_sa_ref(p);
+p:=sa_chain; sa_chain:=link(p);
+if sa_index(p)<dimen_val_limit then free_node(p,word_node_size)
+else free_node(p,pointer_node_size);
+until sa_chain=null;
+end;
+
+@ When the value of |last_line_fit| is positive, the last line of a
+(partial) paragraph is treated in a special way and we need additional
+fields in the active nodes.
+
+@d active_node_size_extended=5 {number of words in extended active nodes}
+@d active_short(#)==mem[#+3].sc {|shortfall| of this line}
+@d active_glue(#)==mem[#+4].sc {corresponding glue stretch or shrink}
+
+@<Glob...@>=
+@!last_line_fill:pointer; {the |par_fill_skip| glue node of the new paragraph}
+@!do_last_line_fit:boolean; {special algorithm for last line of paragraph?}
+@!active_node_size:small_number; {number of words in active nodes}
+@!fill_width:array[0..2] of scaled; {infinite stretch components of
+ |par_fill_skip|}
+@!best_pl_short:array[very_loose_fit..tight_fit] of scaled; {|shortfall|
+ corresponding to |minimal_demerits|}
+@!best_pl_glue:array[very_loose_fit..tight_fit] of scaled; {corresponding
+ glue stretch or shrink}
+
+@ The new algorithm for the last line requires that the stretchability of
+|par_fill_skip| is infinite and the stretchability of |left_skip| plus
+|right_skip| is finite.
+
+@<Check for special...@>=
+do_last_line_fit:=false; active_node_size:=active_node_size_normal;
+ {just in case}
+if last_line_fit>0 then
+ begin q:=glue_ptr(last_line_fill);
+ if (stretch(q)>0)and(stretch_order(q)>normal) then
+ if (background[3]=0)and(background[4]=0)and(background[5]=0) then
+ begin do_last_line_fit:=true;
+ active_node_size:=active_node_size_extended;
+ fill_width[0]:=0; fill_width[1]:=0; fill_width[2]:=0;
+ fill_width[stretch_order(q)-1]:=stretch(q);
+ end;
+ end
+
+@ @<Other local variables for |try_break|@>=
+@!g:scaled; {glue stretch or shrink of test line, adjustment for last line}
+
+@ Here we initialize the additional fields of the first active node
+representing the beginning of the paragraph.
+
+@<Initialize additional fields of the first active node@>=
+begin active_short(q):=0; active_glue(q):=0;
+end
+
+@ 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|.
+
+@<Perform computations for last line and |goto found|@>=
+begin if (active_short(r)=0)or(active_glue(r)<=0) then goto not_found;
+ {previous line was neither stretched nor shrunk, or was infinitely bad}
+if (cur_active_width[3]<>fill_width[0])or@|
+ (cur_active_width[4]<>fill_width[1])or@|
+ (cur_active_width[5]<>fill_width[2]) then goto not_found;
+ {infinite stretch of this line not entirely due to |par_fill_skip|}
+if active_short(r)>0 then g:=cur_active_width[2]
+else g:=cur_active_width[6];
+if g<=0 then goto not_found; {no finite stretch resp.\ no shrink}
+arith_error:=false; g:=fract(g,active_short(r),active_glue(r),max_dimen);
+if last_line_fit<1000 then g:=fract(g,last_line_fit,1000,max_dimen);
+if arith_error then
+ if active_short(r)>0 then g:=max_dimen@+else g:=-max_dimen;
+if g>0 then
+ @<Set the value of |b| to the badness of the last line for stretching,
+ compute the corresponding |fit_class|, and |goto found|@>
+else if g<0 then
+ @<Set the value of |b| to the badness of the last line for shrinking,
+ compute the corresponding |fit_class|, and |goto found|@>;
+not_found:end
+
+@ These badness computations are rather similar to those of the standard
+algorithm, with the adjustment amount |g| replacing the |shortfall|.
+
+@<Set the value of |b| to the badness of the last line for str...@>=
+begin if g>shortfall then g:=shortfall;
+if g>7230584 then if cur_active_width[2]<1663497 then
+ begin b:=inf_bad; fit_class:=very_loose_fit; goto found;
+ end;
+b:=badness(g,cur_active_width[2]);
+if b>12 then
+ if b>99 then fit_class:=very_loose_fit
+ else fit_class:=loose_fit
+else fit_class:=decent_fit;
+goto found;
+end
+
+@ @<Set the value of |b| to the badness of the last line for shr...@>=
+begin if -g>cur_active_width[6] then g:=-cur_active_width[6];
+b:=badness(-g,cur_active_width[6]);
+if b>12 then fit_class:=tight_fit@+else fit_class:=decent_fit;
+goto found;
+end
+
+@ Vanishing values of |shortfall| and |g| indicate that the last line is
+not adjusted.
+
+@<Adjust \(t)the additional data for last line@>=
+begin if cur_p=null then shortfall:=0;
+if shortfall>0 then g:=cur_active_width[2]
+else if shortfall<0 then g:=cur_active_width[6]
+else g:=0;
+end
+
+@ For each feasible break we record the shortfall and glue stretch or
+shrink (or adjustment).
+
+@<Store \(a)additional data for this feasible break@>=
+begin best_pl_short[fit_class]:=shortfall; best_pl_glue[fit_class]:=g;
+end
+
+@ Here we save these data in the active node representing a potential
+line break.
+
+@<Store \(a)additional data in the new active node@>=
+begin active_short(q):=best_pl_short[fit_class];
+active_glue(q):=best_pl_glue[fit_class];
+end
+
+@ @<Print additional data in the new active node@>=
+begin print(" s="); print_scaled(active_short(q));
+if cur_p=null then print(" a=")@+else print(" g=");
+print_scaled(active_glue(q));
+end
+
+@ Here we either reset |do_last_line_fit| or adjust the |par_fill_skip|
+glue.
+
+@<Adjust \(t)the final line of the paragraph@>=
+if active_short(best_bet)=0 then do_last_line_fit:=false
+else begin q:=new_spec(glue_ptr(last_line_fill));
+ delete_glue_ref(glue_ptr(last_line_fill));
+ width(q):=width(q)+active_short(best_bet)-active_glue(best_bet);
+ stretch(q):=0; glue_ptr(last_line_fill):=q;
+ end
+
+@ When reading \.{\\patterns} while \.{\\savinghyphcodes} is positive
+the current |lc_code| values are stored together with the hyphenation
+patterns for the current language. They will later be used instead of
+the |lc_code| values for hyphenation purposes.
+
+The |lc_code| values are stored in the linked trie analogous to patterns
+$p_1$ of length~1, with |hyph_root=trie_r[0]| replacing |trie_root| and
+|lc_code(p_1)| replacing the |trie_op| code. This allows to compress
+and pack them together with the patterns with minimal changes to the
+existing code.
+
+@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
+
+@<Initialize table entries...@>=
+XeTeX_hyphenatable_length:=63; {for backward compatibility with standard TeX by default}
+
+@ @<Store hyphenation codes for current language@>=
+begin c:=cur_lang; first_child:=false; p:=0;
+repeat q:=p; p:=trie_r[q];
+until (p=0)or(c<=so(trie_c[p]));
+if (p=0)or(c<so(trie_c[p])) then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>;
+q:=p; {now node |q| represents |cur_lang|}
+@<Store all current |lc_code| values@>;
+end
+
+@ We store all nonzero |lc_code| values, overwriting any previously
+stored values (and possibly wasting a few trie nodes that were used
+previously and are not needed now). We always store at least one
+|lc_code| value such that |hyph_index| (defined below) will not be zero.
+
+@<Store all current |lc_code| values@>=
+p:=trie_l[q]; first_child:=true;
+for c:=0 to 255 do
+ if (lc_code(c)>0)or((c=255)and first_child) then
+ begin if p=0 then
+ @<Insert a new trie node between |q| and |p|, and
+ make |p| point to it@>
+ else trie_c[p]:=si(c);
+ trie_o[p]:=qi(lc_code(c));
+ q:=p; p:=trie_r[q]; first_child:=false;
+ end;
+if first_child then trie_l[q]:=0@+else trie_r[q]:=0
+
+@ We must avoid to ``take'' location~1, in order to distinguish between
+|lc_code| values and patterns.
+
+@<Pack all stored |hyph_codes|@>=
+begin if trie_root=0 then for p:=0 to 255 do trie_min[p]:=p+2;
+first_fit(hyph_root); trie_pack(hyph_root);
+hyph_start:=trie_ref[hyph_root];
+end
+
+@ The global variable |hyph_index| will point to the hyphenation codes
+for the current language.
+
+@d set_hyph_index== {set |hyph_index| for current language}
+ if trie_char(hyph_start+cur_lang)<>qi(cur_lang)
+ then hyph_index:=0 {no hyphenation codes for |cur_lang|}
+ else hyph_index:=trie_link(hyph_start+cur_lang)
+@#
+@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
+ if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#)
+ else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
+ else hc[0]:=qo(trie_op(hyph_index+#))
+
+@<Glob...@>=
+@!hyph_start:trie_pointer; {root of the packed trie for |hyph_codes|}
+@!hyph_index:trie_pointer; {pointer to hyphenation codes for |cur_lang|}
+
+@ 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 link(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
+
+@* \[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/xetexdir/xetex_version.h b/Build/source/texk/web2c/xetexdir/xetex_version.h
new file mode 100644
index 00000000000..b6e15475462
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetex_version.h
@@ -0,0 +1 @@
+#define XETEX_VERSION "0.999993"
diff --git a/Build/source/texk/web2c/xetexdir/xetexextra.c b/Build/source/texk/web2c/xetexdir/xetexextra.c
new file mode 100644
index 00000000000..4b4900a911b
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetexextra.c
@@ -0,0 +1,12 @@
+/* xetexextra.c: Hand-coded routines for XeTeX.
+
+ This file is public domain. */
+
+#define EXTERN /* Instantiate data from xetexd.h here. */
+#define DLLPROC dllxetexmain
+
+/* This file defines TeX and XeTeX. */
+#include <xetexd.h>
+
+/* Hand-coded routines for TeX or Metafont in C. */
+#include <lib/texmfmp.c>
diff --git a/Build/source/texk/web2c/xetexdir/xetexextra.h b/Build/source/texk/web2c/xetexdir/xetexextra.h
new file mode 100644
index 00000000000..a6a521b1fc4
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xetexextra.h
@@ -0,0 +1,70 @@
+/****************************************************************************\
+ xetexextra.h: banner etc. for XeTeX.
+
+ This is included by XeTeX, from xetexextra.c.
+
+ Part of the XeTeX typesetting system
+ Copyright (c) 1994-2008 by SIL International
+ Copyright (c) 2009-2021 by Jonathan Kew
+
+ SIL Author(s): Jonathan Kew
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
+FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
+CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Except as contained in this notice, the name of the copyright holders
+shall not be used in advertising or otherwise to promote the sale,
+use or other dealings in this Software without prior written
+authorization from the copyright holders.
+\****************************************************************************/
+
+/*
+Copyright (C) 1995, 96 Karl Berry.
+Copyright (C) 2004 Olaf Weber.
+Copyright (C) 2004 Jonathan Kew/SIL International.
+
+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, or (at your option)
+any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <xetexdir/etex_version.h> /* for ETEX_VERSION */
+#include <xetexdir/xetex_version.h> /* for XETEX_VERSION */
+
+#define BANNER "This is XeTeX, Version 3.141592653-" ETEX_VERSION "-" XETEX_VERSION
+#define COPYRIGHT_HOLDER "SIL International, Jonathan Kew and Khaled Hosny"
+#define AUTHOR "Jonathan Kew"
+#define PROGRAM_HELP XETEXHELP
+#define BUG_ADDRESS "xetex@tug.org"
+#define DUMP_VAR TEXformatdefault
+#define DUMP_LENGTH_VAR formatdefaultlength
+#define DUMP_OPTION "fmt"
+#define DUMP_EXT ".fmt"
+#define INPUT_FORMAT kpse_tex_format
+#define INI_PROGRAM "xeinitex"
+#define VIR_PROGRAM "xevirtex"
diff --git a/Build/source/texk/web2c/xetexdir/xewebmac.tex b/Build/source/texk/web2c/xetexdir/xewebmac.tex
new file mode 100644
index 00000000000..3770b4bafbb
--- /dev/null
+++ b/Build/source/texk/web2c/xetexdir/xewebmac.tex
@@ -0,0 +1,106 @@
+% standard macros for WEB listings (in addition to PLAIN.TEX)
+%
+% pdfTeX adjustments mainained by Han The Thanh <hanthethanh@gmx.net>.
+% XeTeX adjustments mainited by Khaled Hosny <khaledhosny@eglug.org>
+%
+
+\ifdefined\botofcontents\else\input webmac.tex\fi
+
+% Some changes for xetex
+\def\note#1#2.{\Y\noindent{\hangindent2em\baselineskip10pt\eightrm#1~\pdfnote#2..\par}}
+
+\def\linkcolor#1{\special{color push rgb 0.4 0.6 1.0}#1\special{color pop}}
+\def\link#1#2{\special{pdf:bann<</Type/Annot/Subtype/Link/Border[0 0 0]/A<</S/GoTo/D(#1)>>>>}\linkcolor{#2}\special{pdf:eann}}
+
+\newtoks\toksA
+\newtoks\toksB
+\newtoks\toksC
+\newtoks\toksD
+\newcount\countA
+\countA=0
+\def\pdfnote#1.{\setbox0=\hbox{\toksA={#1.}\toksB={}\maketoks}\the\toksA}
+\def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks}
+\def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks}
+\def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}}
+\def\maketoks{%
+ \expandafter\poptoks\the\toksA|ENDTOKS|
+ \ifx\first0\adn0
+ \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3
+ \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6
+ \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9
+ \else
+ \ifnum0=\countA\else\makenote\fi
+ \ifx\first.\let\next=\done\else
+ \let\next=\maketoks
+ \addtokens{\toksB}{\the\toksD}
+ \ifx\first,\addtokens{\toksB}{\space}\fi
+ \fi
+ \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
+ \next
+}
+\def\n#1{\link{#1}{#1}}
+\def\makenote{\addtokens{\toksB}%
+ {\noexpand\n{\the\toksC}}\toksC={}\global\countA=0}
+\def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
+
+\def\startsection{\Q{\let\*=\empty\special{pdf:dest (\modstar) [@thispage /XYZ @xpos @ypos null]}}%
+ \noindent{\let\*=\lapstar\bf\modstar.\quad}}
+
+\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi % section name
+ \XX$\langle\,$#2{\eightrm\kern.5em\pdfnote#1.}$\,\rangle$\XX}
+\def\inx{\par\vskip6pt plus 1fil % we are beginning the index
+ \write\cont{} % ensure that the contents file isn't empty
+ \closeout\cont % the contents information has been fully gathered
+ \output{\ifpagesaved\normaloutput{\box\sbox}\lheader\rheader\fi
+ \global\setbox\sbox=\page \global\pagesavedtrue}
+ \pagesavedfalse \eject % eject the page-so-far and predecessors
+ \setbox\sbox\vbox{\unvbox\sbox} % take it out of its box
+ \vsize=\pageheight \advance\vsize by -\ht\sbox % the remaining height
+ \hsize=.5\pagewidth \advance\hsize by -10pt
+ % column width for the index (20pt between cols)
+ \parfillskip 0pt plus .6\hsize % try to avoid almost empty lines
+ \def\lr{L} % this tells whether the left or right column is next
+ \output{\if L\lr\global\setbox\lbox=\page \gdef\lr{R}
+ \else\normaloutput{\vbox to\pageheight{\box\sbox\vss
+ \hbox to\pagewidth{\box\lbox\hfil\page}}}\lheader\rheader
+ \global\vsize\pageheight\gdef\lr{L}\global\pagesavedfalse\fi}
+ \message{Index:}
+ \parskip 0pt plus .5pt
+ \outer\def\:##1, {\par\hangindent2em\noindent##1:\kern1em\pdfnote} % index entry
+ \let\ttentry=\. \def\.##1{\ttentry{##1\kern.2em}} % give \tt a little room
+ \def\[##1]{$\underline{##1}$} % underlined index item
+ \rm \rightskip0pt plus 2.5em \tolerance 10000 \let\*=\lapstar
+ \hyphenpenalty 10000 \parindent0pt}
+\def\fin{\par\vfill\eject % this is done when we are ending the index
+ \ifpagesaved\null\vfill\eject\fi % output a null index column
+ \if L\lr\else\null\vfill\eject\fi % finish the current page
+ \parfillskip 0pt plus 1fil
+ \def\rhead{NAMES OF THE SECTIONS}
+ \message{Section names:}
+ \output{\normaloutput\page\lheader\rheader}
+ \setpage
+ \def\note##1##2.{\hfil\penalty-1\hfilneg\quad{\eightrm##1~\pdfnote##2..}}
+ \linepenalty=10 % try to conserve lines
+ \def\U{\note{Used in section}} % crossref for use of a section
+ \def\Us{\note{Used in sections}} % crossref for uses of a section
+ \def\:{\par\hangindent 2em}\let\*=*\let\.=\ttentry}
+\def\con{\par\vfill\eject % finish the section names
+ \rightskip 0pt \hyphenpenalty 50 \tolerance 200
+ \setpage
+ \output{\normaloutput\page\lheader\rheader}
+ \titletrue % prepare to output the table of contents
+ \pageno=\contentspagenumber \def\rhead{TABLE OF CONTENTS}
+ \message{Table of contents:}
+ \topofcontents
+ \line{\hfil Section\hbox to3em{\hss Page}}
+ \def\Z##1##2##3{\line{\link{##2}{\ignorespaces##1
+ \leaders\hbox to .5em{.\hfil}\hfil\ ##2}
+ \hbox to3em{\hss##3}}}
+ \readcontents\relax % read the contents info
+ \botofcontents \makeoutlines\end} % print the contents page(s) and terminate
+
+\newcount\countB
+\def\makeoutlines{%
+ \def\?##1]{}\def\Z##1##2##3{\special{pdf:out 1 <</Title(##1)/A<</S/GoTo/D(##2)>>>>}}
+ \input CONTENTS\relax}
+\endinput